program ESMF_InternalStateEx
!-------------------------------------------------------------------------
#include "ESMF.h"
! !USES:
!BOC
! ESMF Framework module
use ESMF
use ESMF_TestMod
implicit none
type(ESMF_GridComp) :: comp
integer :: rc, finalrc, i
! Internal State Variables
type testData
sequence
integer :: testValue
real :: testScaling
end type
type dataWrapper
sequence
type(testData), pointer :: p
end type
type(dataWrapper) :: wrap
character(len=:), allocatable :: labelList(:)
!EOC
integer :: result
character(ESMF_MAXSTR) :: testname
character(ESMF_MAXSTR) :: failMsg
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
write(failMsg, *) "Example failure"
write(testname, *) "Example ESMF_InternalStateEx"
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
finalrc = ESMF_SUCCESS
!BOC
!-------------------------------------------------------------------------
call ESMF_Initialize(defaultlogfilename="InternalStateEx.Log", &
logkindflag=ESMF_LOGKIND_MULTI, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
!-------------------------------------------------------------------------
! Creation of a Component
comp = ESMF_GridCompCreate(name="test", rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
!EOC
#ifndef ESMF_NO_F2018ASSUMEDTYPE
! The InternalState API is only available with compilers that support the
! Fortran 2018 assumed-type dummy argument feature.
!BOE
! This could be called, for example, during a Component's initialize phase.
!EOE
!BOC
! Allocate private data
allocate(wrap%p)
! Initialize private data block
wrap%p%testValue = 4567
wrap%p%testScaling = 0.5
! Add Internal State to Component
call ESMF_InternalStateAdd(comp, internalState=wrap, rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
! "Forget" the local reference to the private data block, do demonstrate that
! it can be correctly retrieved below.
wrap%p => null()
!EOC
!BOE
! This could be called, for example, during a Component's run phase.
!EOE
!BOC
! Get Internal State
call ESMF_InternalStateGet(comp, internalState=wrap, rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
! Access private data block and verify data
if ((wrap%p%testValue .ne. 4567) .or. &
(wrap%p%testScaling - 0.5 > tiny(wrap%p%testScaling))) then
print *, "private data validation NOT successful"
finalrc = ESMF_FAILURE
else
print *, "private data validation successful"
endif
! Deallocate the private data block
deallocate(wrap%p)
!EOC
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
!BOE
!\subsubsection{Add and Get Internal State with label}
!
! InternalState information added to a component can be associated with a
! string label. Multiple such named internal states can be added to the same
! component object.
!
!EOE
!BOC
! Allocate another private data block
allocate(wrap%p)
! Initialize private data block
wrap%p%testValue = 1234
wrap%p%testScaling = 0.8
! Add Internal State to the Component with label
call ESMF_InternalStateAdd(comp, internalState=wrap, &
label="first named data block", rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
! And allocate another private data block
allocate(wrap%p)
! Initialize private data block
wrap%p%testValue = 4321
wrap%p%testScaling = 0.1
! Add Internal State to the Component with label
call ESMF_InternalStateAdd(comp, internalState=wrap, &
label="second named data block", rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
! A list of InternalState labels can be queried from the component object.
call ESMF_InternalStateGet(comp, labelList=labelList, rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
! write the labelList to log
do i=1, size(labelList)
call ESMF_LogWrite("InternalState label: "//labelList(i), &
ESMF_LOGMSG_INFO, rc=rc)
if (rc /= ESMF_SUCCESS) call ESMF_Finalize(endflag=ESMF_END_ABORT)
enddo
!EOC
!BOE
! The last internal state added under a specific label can be retrieved using
! the {\tt ESMF\_InternalStateGet()} method with the {\tt lable} argument.
!EOE
!BOC
! Get Internal State
call ESMF_InternalStateGet(comp, internalState=wrap, &
label="first named data block", rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
! Deallocate the private data block
deallocate(wrap%p)
! Get Internal State
call ESMF_InternalStateGet(comp, internalState=wrap, &
label="second named data block", rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
! Deallocate the private data block
deallocate(wrap%p)
!EOC
#endif
call ESMF_GridCompDestroy(comp, rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
! IMPORTANT: ESMF_STest() prints the PASS string and the # of processors in the log
! file that the scripts grep for.
call ESMF_STest((finalrc.eq.ESMF_SUCCESS), testname, failMsg, result, ESMF_SRCLINE)
call ESMF_Finalize(rc=rc)
if (rc .ne. ESMF_SUCCESS) finalrc = ESMF_FAILURE
if (finalrc .eq. ESMF_SUCCESS) then
print *, "PASS: ESMF_InternalStateEx.F90"
else
print *, "FAIL: ESMF_InternalStateEx.F90"
end if
end program ESMF_InternalStateEx