ESMFL_StateFreePointers Subroutine

public subroutine ESMFL_StateFreePointers(STATE, RC)

Arguments

Type IntentOptional Attributes Name
type(ESMF_State), intent(inout) :: STATE
integer, intent(out), optional :: RC

Calls

proc~~esmfl_statefreepointers~~CallsGraph proc~esmfl_statefreepointers ESMFL_StateFreePointers ESMF_AttributeGet ESMF_AttributeGet proc~esmfl_statefreepointers->ESMF_AttributeGet esmf_arrayget esmf_arrayget proc~esmfl_statefreepointers->esmf_arrayget esmf_fieldget esmf_fieldget proc~esmfl_statefreepointers->esmf_fieldget esmf_localarrayget esmf_localarrayget proc~esmfl_statefreepointers->esmf_localarrayget esmf_stateget esmf_stateget proc~esmfl_statefreepointers->esmf_stateget interface~mapl_assert MAPL_Assert proc~esmfl_statefreepointers->interface~mapl_assert proc~mapl_return MAPL_Return proc~esmfl_statefreepointers->proc~mapl_return proc~mapl_verify MAPL_Verify proc~esmfl_statefreepointers->proc~mapl_verify at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception

Source Code

 subroutine ESMFL_StateFreePointers(STATE, RC)
   type(ESMF_State),  intent(INOUT) :: STATE
   integer, optional, intent(  OUT) :: RC

   integer                          :: STATUS

   type(ESMF_Array)                 :: ARRAY
   type(ESMF_Field)                 :: FIELD
   integer                          :: RANK
   integer                          :: I
   integer                          :: ITEMCOUNT
   real, pointer                    :: PTR1(:)
   real, pointer                    :: PTR2(:,:)
   real, pointer                    :: PTR3(:,:,:)
   real, pointer                    :: PTR4(:,:,:,:)
   logical                          :: NEEDED

   character (len=ESMF_MAXSTR), pointer :: ITEMNAMELIST(:)
   type(ESMF_StateItem_Flag)  , pointer :: ITEMTYPELIST(:)

   type (ESMF_LocalArray), target  :: larrayList(1)
   type (ESMF_LocalArray), pointer :: larray
   integer        :: localDeCount

   logical :: isPresent

! Get information from state
!---------------------------

   call ESMF_StateGet(STATE,ITEMCOUNT=ITEMCOUNT,RC=STATUS)
   _VERIFY(STATUS)

   if(ITEMCOUNT==0) then
      _RETURN(ESMF_SUCCESS)
   end if

   allocate(ITEMNAMELIST(ITEMCOUNT),STAT=STATUS)
   _VERIFY(STATUS)
   allocate(ITEMTYPELIST(ITEMCOUNT),STAT=STATUS)
   _VERIFY(STATUS)

   call ESMF_StateGet(STATE,ITEMNAMELIST=ITEMNAMELIST,ITEMTYPELIST=ITEMTYPELIST,RC=STATUS)
   _VERIFY(STATUS)

   do I=1,ITEMCOUNT
      if(ITEMTYPELIST(I)==ESMF_STATEITEM_FIELD) then
         call ESMF_StateGet(STATE, trim(ITEMNAMELIST(I)), FIELD, RC=STATUS)
         _VERIFY(STATUS)

         call ESMF_AttributeGet  (FIELD, NAME="Needed", isPresent=isPresent, RC=STATUS)
         _VERIFY(STATUS)
         if(isPresent) then
            call ESMF_AttributeGet  (FIELD, NAME="Needed",VALUE=NEEDED, RC=STATUS)
            _VERIFY(STATUS)
         else
            NEEDED = .false.
         end if

         if( NEEDED .eqv. .false. ) then
            call ESMF_FieldGet(FIELD, Array=ARRAY, RC=STATUS)
            _VERIFY(STATUS)
            call ESMF_ArrayGet     (ARRAY, rank=RANK,   RC=STATUS)
            _VERIFY(STATUS)

            call ESMF_ArrayGet(array, localDeCount=localDeCount, rc=status)
            _VERIFY(STATUS)
            _ASSERT(localDeCount == 1, 'MAPL does not currently support multiple DEs per PET')
            call ESMF_ArrayGet(array, localarrayList=larrayList, rc=status)
            _VERIFY(STATUS)
            larray => lArrayList(1) ! alias

            select case (rank)
            case (1)
               call ESMF_LocalArrayGet(larray, PTR1, RC=status)
               _VERIFY(STATUS)
               if(associated(PTR1)) deallocate(PTR1)
            case (2)
               call ESMF_LocalArrayGet(larray, PTR2, RC=status)
               _VERIFY(STATUS)
               if(associated(PTR2)) deallocate(PTR2)
            case (3)
               call ESMF_LocalArrayGet(larray, PTR3, RC=status)
               _VERIFY(STATUS)
               if(associated(PTR3)) deallocate(PTR3)
            case (4)
               call ESMF_LocalArrayGet(larray, PTR4, RC=status)
               _VERIFY(STATUS)
               if(associated(PTR4)) deallocate(PTR4)
            end select
         end if
      end if
   end do

   deallocate(itemNameList,STAT=STATUS)
   _VERIFY(STATUS)
   deallocate(itemtypeList,STAT=STATUS)
   _VERIFY(STATUS)

   _RETURN(ESMF_SUCCESS)

 end subroutine ESMFL_StateFreePointers