Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | lstring | |||
character(len=*), | intent(in) | :: | lcharL | |||
character(len=*), | intent(in) | :: | lcharR | |||
integer, | optional | :: | rc |
logical function pattern_match(lstring, lcharL, lcharR, rc) !--------------------------------------------------------------------------- ! function checks the input string and determines if there are matching ! pairs of the enclosing symbols ( lcharL, lcharR) and that they are in the ! proper order. !--------------------------------------------------------------------------- ! arguments character(len=*), intent(in ) :: lstring character(len=*), intent(in ) :: lcharL, lcharR integer, optional :: rc ! local variables integer, allocatable :: locL(:), locR(:) integer :: k, ntestL, ntestR integer :: allocRcToTest logical :: flag ! initialize variables flag = .true. !--------------------------------------------------------------------------- ! check that the patterns mach up !--------------------------------------------------------------------------- ntestL = pattern_query(lstring,trim(adjustL(lcharL)) ) ntestR = pattern_query(lstring,trim(adjustL(lcharR)) ) if( ntestL == ntestR ) then !------------------------------------------------------------------------ ! the numbers match, so now check that the order is left to right !------------------------------------------------------------------------ allocate( locL(ntestL), stat=allocRcToTest ) if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array "// & "locL in pattern_match", rcToReturn=rc)) then endif allocate( locR(ntestR), stat=allocRcToTest ) if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array "// & "locR in pattern_match", rcToReturn=rc)) then endif call pattern_locate(lstring,trim(adjustL(lcharL)), ntestL, locL ) call pattern_locate(lstring,trim(adjustL(lcharR)), ntestR, locR ) !------------------------------------------------------------------------ ! are any of the symbols out of order !------------------------------------------------------------------------ do k=1, ntestL if( locL(k) > locR(k) ) flag = .false. enddo if( flag ) then ! order correct pattern_match = .true. else ! order wrong pattern_match = .false. endif ! flag deallocate( locL, locR ) else ! numbers of symbols don't pair pattern_match = .false. endif !--------------------------------------------------------------------------- end function pattern_match