memory_separate Subroutine

public subroutine memory_separate(lstring, iRank, lmem, localrc)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: lstring
integer, intent(in) :: iRank
type(character_array), intent(out) :: lmem(:)
integer, intent(out) :: localrc

Source Code

    subroutine memory_separate(lstring, iRank, lmem,  localrc)
    !---------------------------------------------------------------------------
    ! For a structured block of memory, return the memory rank (iRank) as 
    ! specified by the descriptor string, and separate each the string
    ! corresponding to each memory dimension into a separate element of a
    ! character array ( lmem(1:iRank) ). Finely separate any specification of
    ! stagger into the last (iRank+1) element of the character array lmem.
    !---------------------------------------------------------------------------

    ! arguments
    character(*), intent(in   ) :: lstring
    integer,                intent(in   ) :: iRank
    type(character_array),  intent(  out) :: lmem(:)
    integer,                intent(  out) :: localrc

    ! local variables
    character(len=1) :: pattern
    integer :: k, nMem, nEnd, iBeg, iEnd
    integer :: EndPos(1)
    integer, allocatable :: MemPos(:)
    integer :: allocRcToTest

    ! initialize variables
    localrc = ESMF_RC_NOT_IMPL

    ! initialize variables

    !---------------------------------------------------------------------------
    ! The structured memory is delineated by square brackets. To determine
    ! how this memory is specified, it is first necessary to determne 
    ! the existence of two matching pairs of square brackets.
    !---------------------------------------------------------------------------
    pattern = ';'
    nMem = pattern_query(lstring, pattern)
    nEnd = pattern_query(lstring, ']')

    if( nMem+1 /=  iRank .and. nEnd /= 1 ) then
       call ESMF_LogSetError(ESMF_FAILURE, msg="asserted memory rank does not"  &
                // " agree with actual memory rank", rcToReturn=localrc)
       return
    else
       !------------------------------------------------------------------------
       !------------------------------------------------------------------------
       allocate( MemPos(nMem), stat=allocRcToTest  )
       if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer array "//        &
          "MemPos in memory_separate", rcToReturn=localrc)) then
       endif

       call pattern_locate(lstring, pattern, nMem, MemPos)
       call pattern_locate(lstring, ']', nEnd, EndPos)

       !------------------------------------------------------------------------
       ! extract first memory location - not enclosed by ";" on front side
       !------------------------------------------------------------------------
       iBeg = 2
       iEnd = MemPos(1)-1
       lmem(1)%string = lstring(iBeg:iEnd)

       !------------------------------------------------------------------------
       ! extract remaining memory locations
       !------------------------------------------------------------------------
       do k=2,nMem
          iBeg = MemPos(k-1) +1
          iEnd = MemPos(k) -1
          lmem(k)%string = lstring(iBeg:iEnd)
       enddo

       !------------------------------------------------------------------------
       ! extract last memory location - not enclosed by ";" on back side
       !------------------------------------------------------------------------
       iBeg = MemPos(nMeM) +1
       iEnd = EndPos(1) -1
       lmem(nMem+1)%string = lstring(iBeg:iEnd)

       !------------------------------------------------------------------------
       ! extract stagger location if included
       !------------------------------------------------------------------------
       iBeg = EndPos(1)
       iEnd = len(trim(lstring)) 
       if( iEnd > iBeg ) then
          lmem(nMem+2)%string = lstring(iBeg:iEnd)
       else
          lmem(nMem+2)%string = ' '
       endif

       deallocate( MemPos )
    endif
     
    !---------------------------------------------------------------------------
    ! if I've gotten this far without an error, then the routine has succeeded.
    !---------------------------------------------------------------------------
    localrc = ESMF_SUCCESS

    !---------------------------------------------------------------------------
    end subroutine memory_separate