This function returns .true. if the string matches the given pattern which will normally include wild-card characters ? and/or , otherwise .false.
LOGICAL FUNCTION match_wild (pattern, string) ! compare given string for match to pattern which may ! contain wildcard characters: ! "?" matching any one character, and ! "*" matching any zero or more characters. ! Both strings may have trailing spaces which are ignored. ! Authors: Clive Page, userid: cgp domain: le.ac.uk, 2003 (original code) ! Rolf Sander, 2005 (bug fixes and pattern preprocessing) ! Minor bug fixed by Clive Page, 2005 Nov 29, bad comment fixed 2005 Dec 2. ! Serious bug fixed by Robert H McClanahan, 2011 April 11th ! This program is free software; you can redistribute it and/or modify ! it under the terms of the GNU General Public License as published by ! the Free Software Foundation; either version 2 of the License, or ! (at your option) any later version. ! ! This program is distributed in the hope that it will be useful, ! but WITHOUT ANY WARRANTY; without even the implied warranty of ! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! GNU General Public License for more details. ! ! You should have received a copy of the GNU General Public License ! along with this program; if not, write to the Free Software ! Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA ! 02110-1301 USA ! IMPLICIT NONE CHARACTER(LEN=*), INTENT(IN) :: pattern ! pattern may contain * and ? CHARACTER(LEN=*), INTENT(IN) :: string ! string to be compared INTEGER :: lenp, lenp2, lens, n, p2, p, s INTEGER :: n_question, n_asterisk LOGICAL :: found CHARACTER(LEN=LEN(pattern)) :: pattern2 lens = LEN_TRIM(string) lenp = LEN_TRIM(pattern) ! If the pattern is empty, always return true IF (lenp == 0) THEN match_wild = .TRUE. RETURN ENDIF ! The pattern must be preprocessed. All consecutive occurrences of ! one or more question marks ('?') and asterisks ('*') are sorted and ! compressed. The result is stored in pattern2. pattern2(:)='' p = 1 ! current position in pattern p2 = 1 ! current position in pattern2 DO IF ((pattern(p:p) == '?').OR.(pattern(p:p) == '*')) THEN ! a special character was found in the pattern n_question = 0 n_asterisk = 0 DO WHILE (p <= lenp) ! count the consecutive question marks and asterisks IF ((pattern(p:p) /= '?').AND.(pattern(p:p) /= '*')) EXIT IF (pattern(p:p) == '?') n_question = n_question + 1 IF (pattern(p:p) == '*') n_asterisk = n_asterisk + 1 p = p + 1 ENDDO IF (n_question>0) THEN ! first, all the question marks pattern2(p2:p2+n_question-1) = REPEAT('?',n_question) p2 = p2 + n_question ENDIF IF (n_asterisk>0) THEN ! next, the asterisk (only one!) pattern2(p2:p2) = '*' p2 = p2 + 1 ENDIF ELSE ! just a normal character pattern2(p2:p2) = pattern(p:p) p2 = p2 + 1 p = p + 1 ENDIF IF (p > lenp) EXIT ENDDO !! lenp2 = p2 - 1 lenp2 = len_trim(pattern2) ! The modified wildcard in pattern2 is compared to the string: p2 = 1 s = 1 match_wild = .FALSE. DO IF (pattern2(p2:p2) == '?') THEN ! accept any char in string p2 = p2 + 1 s = s + 1 ELSEIF (pattern2(p2:p2) == "*") THEN p2 = p2 + 1 IF (p2 > lenp2) THEN ! anything goes in rest of string match_wild = .TRUE. EXIT ! .TRUE. ELSE ! search string for char at p2 n = INDEX(string(s:), pattern2(p2:p2)) IF (n == 0) EXIT ! .FALSE. s = n + s - 1 ENDIF ELSEIF (pattern2(p2:p2) == string(s:s)) THEN ! single char match p2 = p2 + 1 s = s + 1 ELSE ! non-match ! EXIT ! .FALSE. ! Previous line buggy because failure to match one character in the pattern ! does not mean that a match won't be found later. Back up through pattern string ! until first wildcard character is found and start over with the exact character ! match. If the end of the string is reached, then return .FALSE. ! 04/11/2011 Robert McClanahan Robert.McClanahan <<at>> AECC.COM ! found = .FALSE. DO WHILE (p2 > 0 .AND. .NOT. found) p2 = p2 - 1 IF (p2 == 0) EXIT ! .FALSE. IF (pattern(p2:p2) == '*' .OR. pattern(p2:p2) == '?') found = .TRUE. END DO s = s + 1 ENDIF IF (p2 > lenp2 .AND. s > lens) THEN ! end of both pattern2 and string match_wild = .TRUE. EXIT ! .TRUE. ENDIF IF (s > lens .AND. p2 == lenp) THEN IF(pattern2(p2:p2) == "*") THEN ! "*" at end of pattern2 represents an empty string match_wild = .TRUE. EXIT ENDIF ENDIF IF (p2 > lenp2 .OR. s > lens) THEN ! end of either pattern2 or string EXIT ! .FALSE. ENDIF ENDDO END FUNCTION match_wild
Author: Clive Page with other contributions (see comments near top).
License: GPL license