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


Calls

proc~~pattern_match~~CallsGraph proc~pattern_match pattern_match proc~esmf_logfoundallocerror ESMF_LogFoundAllocError proc~pattern_match->proc~esmf_logfoundallocerror proc~pattern_locate pattern_locate proc~pattern_match->proc~pattern_locate proc~pattern_query pattern_query proc~pattern_match->proc~pattern_query esmf_breakpoint esmf_breakpoint proc~esmf_logfoundallocerror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfoundallocerror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfoundallocerror->proc~esmf_logwrite c_esmc_loggeterrormsg c_esmc_loggeterrormsg proc~esmf_logrc2msg->c_esmc_loggeterrormsg c_esmc_vmwtime c_esmc_vmwtime proc~esmf_logwrite->c_esmc_vmwtime proc~esmf_logclose ESMF_LogClose proc~esmf_logwrite->proc~esmf_logclose proc~esmf_logflush ESMF_LogFlush proc~esmf_logwrite->proc~esmf_logflush proc~esmf_logopenfile ESMF_LogOpenFile proc~esmf_logwrite->proc~esmf_logopenfile proc~esmf_utiliounitflush ESMF_UtilIOUnitFlush proc~esmf_logwrite->proc~esmf_utiliounitflush proc~esmf_utilstring2array ESMF_UtilString2Array proc~esmf_logwrite->proc~esmf_utilstring2array proc~esmf_logclose->proc~esmf_logflush proc~esmf_logflush->proc~esmf_utiliounitflush proc~esmf_utilarray2string ESMF_UtilArray2String proc~esmf_logflush->proc~esmf_utilarray2string proc~esmf_logopenfile->proc~esmf_utiliounitflush proc~esmf_utiliounitget ESMF_UtilIOUnitGet proc~esmf_logopenfile->proc~esmf_utiliounitget

Called by

proc~~pattern_match~~CalledByGraph proc~pattern_match pattern_match proc~memory_topology memory_topology proc~memory_topology->proc~pattern_match proc~parse_descriptor_string parse_descriptor_string proc~parse_descriptor_string->proc~memory_topology proc~read_testharness_specifier Read_TestHarness_Specifier proc~read_testharness_specifier->proc~parse_descriptor_string program~esmf_test_harness esmf_test_harness program~esmf_test_harness->proc~read_testharness_specifier

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