pattern_match Function

public function pattern_match(lstring, lcharL, lcharR, rc)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: lstring
character(len=*), intent(in) :: lcharL
character(len=*), intent(in) :: lcharR
integer, optional :: rc

Return Value logical


Source Code

    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