代码如下,将输出所有 string 数组是否分别匹配 pattern 数组。
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. 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 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 End If ! The pattern must be preprocessed. All consecutive occurences 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 End Do If (n_question>0) Then ! first, all the question marks pattern2(p2:p2+n_question-1) = repeat('?', n_question) p2 = p2 + n_question End If If (n_asterisk>0) Then ! next, the asterisk (only one!) pattern2(p2:p2) = '*' p2 = p2 + 1 End If Else ! just a normal character pattern2(p2:p2) = pattern(p:p) p2 = p2 + 1 p = p + 1 End If If (p>lenp) Exit End Do !! 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 Else If (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 End If Else If (pattern2(p2:p2)==string(s:s)) Then ! single char match p2 = p2 + 1 s = s + 1 Else ! non-match Exit ! .FALSE. End If If (p2>lenp2 .And. s>lens) Then ! end of both pattern2 and string match_wild = .True. Exit ! .TRUE. End If !! IF (s > lens .AND. (pattern2(p2:p2) == "*") .AND. p2 == lenp2) THEN !! above line buggy since p2 can be beyond end of string pattern2 by this point. CGP If (s>lens .And. p2==lenp) Then If (pattern2(p2:p2)=='*') Then ! "*" at end of pattern2 represents an empty string match_wild = .True. Exit End If End If If (p2>lenp2 .Or. s>lens) Then ! end of either pattern2 or string Exit ! .FALSE. End If End Do End Function match_wild Program www_fcode_cn Implicit None Integer, Parameter :: np = 20, ns = 5 Character :: pattern(np)*8, string(ns)*12 Integer :: s, p Logical :: match_wild External match_wild string = (/ 'a.f90 ', 'a1.f90 ', 'a12.f90 ', 'a.f ', & 'fcode.cn ' /) pattern = (/ 'a*.f90 ', 'a?*.f90 ', 'a*?.f90 ', 'a?*?.f90', 'a*.f90 ', & 'a***.f ', 'a*?*?*? ', 'a**b**c*', 'a*?*b???', '??? ', '* ', & '? ', ' ', '**?** ', '?* ', '*?* ', '*.f90 ', & '*? ', 'a*??.f90', '????? ' /) Write (*, '(t17, 100a9)') string Do p = 1, np Write (*, '(a, 100L9)') pattern(p), (match_wild(pattern(p),string(s)), s=1 & , ns) End Do End Program www_fcode_cn