Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
character(len=*), | intent(in) | :: | lstring | |||
integer, | intent(in) | :: | iRank | |||
type(character_array), | intent(out) | :: | lmem(:) | |||
integer, | intent(out) | :: | localrc |
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