Fortran Wiki
match_wild (changes)

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

!Above cannot work for instance: match_wild(’2’,‘ABCDE2’)

LOGICAL FUNCTION Wildcmp(pattern, candidate)
 CHARACTER(LEN=*), INTENT(IN) :: pattern ! pattern may contain * and ?
 CHARACTER(LEN=*), INTENT(IN) :: candidate ! string to be compared
Character(:),allocatable::pattStr,CandStr,tempstr 
integer::lenp,lenc,istar1,istar2,iquest,i,j
i=scan(pattern,char(0))-1; j=scan(candidate,char(0))-1
if(i==-1)i=len(pattern); if(j==-1)j=len(candidate)
pattStr=trim(adjustl(pattern(:i))); CandStr=trim(adjustl(candidate(:j))); tempstr=CandStr
lenp=len(pattStr); lenc=len(CandStr); i=1
do while(pattStr(i:i)/='*')
 if(pattStr(i:i)/=CandStr(i:i).and.pattStr(i:i)/='?')then
 wildcmp=.false.; return; 
 end if
 i=i+1; if(i>=min(lenp,lenc))exit
end do; wildcmp=(i==lenp).and.(lenp==lenc)
j=i
do while(j<=lenc)
 if(i<=lenp)then
 if(pattStr(i:i)=='*')then
 wildcmp=lenp==i; if(lenp==i)return
 i=i+1; !j=j+1
 elseif(i<=lenp.and.j<=lenc)then
 if(pattStr(i:i)==CandStr(j:j).or.pattStr(i:i)=='?')then
 i=i+1; j=j+1; !wildcmp=.true.
 else
 j=j+1; if(j>lenc)exit
 end if
 else
 j=j+1; 
 if(i>lenp.or.j>lenc)then
 wildcmp=.false.; return;
 end if 
 end if
 end if
end do 
wildcmp=(i-1==lenp)
if(i>lenp)return
 do while(pattStr(i:i)=='*')
 i=i+1
 end do; 
 if(i<=lenp)wildcmp=(pattStr(i:i)=='*')
END FUNCTION Wildcmp

Author: KunWing? with other c language contribution (by Jack Handy -

).