program ESMF_AppMainEx
#include "ESMF.h"
! ! The ESMF Framework module
use ESMF
use ESMF_TestMod
! ! User supplied modules, using only the public registration routine.
use PHYS_Mod, only: PHYS_SetServices
use DYNM_Mod, only: DYNM_SetServices
use CPLR_Mod, only: CPLR_SetServices
implicit none
! ! Local variables
integer :: rc
logical :: finished
type(ESMF_Clock) :: tclock
type(ESMF_Calendar) :: gregorianCalendar
type(ESMF_TimeInterval) :: timeStep
type(ESMF_Time) :: startTime, stopTime
character(ESMF_MAXSTR) :: cname, cname1, cname2
type(ESMF_VM) :: vm
type(ESMF_State) :: states(2)
type(ESMF_GridComp) :: top
type(ESMF_GridComp) :: gcomp1, gcomp2
type(ESMF_CplComp) :: cpl
!EOC
integer :: finalrc, result
character(ESMF_MAXSTR) :: testname
character(ESMF_MAXSTR) :: failMsg
!-------------------------------------------------------------------------
!-------------------------------------------------------------------------
write(failMsg, *) "Example failure"
write(testname, *) "Example ESMF_AppMainEx"
! ------------------------------------------------------------------------------
! ------------------------------------------------------------------------------
! !Set finalrc to success
finalrc = ESMF_SUCCESS
!BOC
!-------------------------------------------------------------------------
! ! Initialize the Framework, and get the default VM
call ESMF_Initialize(vm=vm, defaultlogfilename="AppMainEx.Log", &
logkindflag=ESMF_LOGKIND_MULTI, rc=rc)
if (rc .ne. ESMF_SUCCESS) then
print *, "Unable to initialize ESMF Framework"
print *, "FAIL: ESMF_AppMainEx.F90"
call ESMF_Finalize(endflag=ESMF_END_ABORT)
endif
!-------------------------------------------------------------------------
! !
! ! Create, Init, Run, Finalize, Destroy Components.
print *, "Application Example 1:"
! Create the top level application component
cname = "Top Level Atmosphere Model Component"
top = ESMF_GridCompCreate(name=cname, configFile="setup.rc", rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
cname1 = "Atmosphere Physics"
gcomp1 = ESMF_GridCompCreate(name=cname1, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! This single user-supplied subroutine must be a public entry point
! and can renamed with the 'use localname => modulename' syntax if
! the name is not unique.
call ESMF_GridCompSetServices(gcomp1, userRoutine=PHYS_SetServices, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! (see below for what the SetServices routine will need to do.)
print *, "Comp Create returned, name = ", trim(cname1)
cname2 = "Atmosphere Dynamics"
gcomp2 = ESMF_GridCompCreate(name=cname2, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! This single user-supplied subroutine must be a public entry point.
call ESMF_GridCompSetServices(gcomp2, userRoutine=DYNM_SetServices, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
print *, "Comp Create returned, name = ", trim(cname2)
cname = "Atmosphere Coupler"
cpl = ESMF_CplCompCreate(name=cname, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! This single user-supplied subroutine must be a public entry point.
call ESMF_CplCompSetServices(cpl, userRoutine=CPLR_SetServices, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
print *, "Comp Create returned, name = ", trim(cname)
! Create the necessary import and export states used to pass data
! between components.
states(1) = ESMF_StateCreate(name=cname1, &
stateintent=ESMF_STATEINTENT_EXPORT, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
states(2) = ESMF_StateCreate(name=cname2, &
stateintent=ESMF_STATEINTENT_IMPORT, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! See the TimeMgr document for the details on the actual code needed
! to set up a clock.
! initialize calendar to be Gregorian type
gregorianCalendar = ESMF_CalendarCreate(ESMF_CALKIND_GREGORIAN, name="Gregorian", rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! initialize time interval to 6 hours
call ESMF_TimeIntervalSet(timeStep, h=6, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! initialize start time to 5/1/2003
call ESMF_TimeSet(startTime, yy=2003, mm=5, dd=1, &
calendar=gregorianCalendar, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! initialize stop time to 5/2/2003
call ESMF_TimeSet(stopTime, yy=2003, mm=5, dd=2, &
calendar=gregorianCalendar, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! initialize the clock with the above values
tclock = ESMF_ClockCreate(timeStep, startTime, stopTime=stopTime, &
name="top clock", rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
! Call each Init routine in turn. There is an optional index number
! for those components which have multiple entry points.
call ESMF_GridCompInitialize(gcomp1, exportState=states(1), clock=tclock, &
rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_GridCompInitialize(gcomp2, importState=states(2), clock=tclock, &
rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_CplCompInitialize(cpl, importState=states(1), &
exportState=states(2), clock=tclock, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
print *, "Comp Initialize complete"
! Main run loop.
finished = .false.
do while (.not. finished)
call ESMF_GridCompRun(gcomp1, exportState=states(1), clock=tclock, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_CplCompRun(cpl, importState=states(1), &
exportState=states(2), clock=tclock, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_GridCompRun(gcomp2, importState=states(2), clock=tclock, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_ClockAdvance(tclock, timeStep=timestep)
! query clock for current time
if (ESMF_ClockIsStopTime(tclock)) finished = .true.
enddo
print *, "Comp Run complete"
! Give each component a chance to write out final results, clean up.
! Call each Finalize routine in turn. There is an optional index number
! for those components which have multiple entry points.
call ESMF_GridCompFinalize(gcomp1, exportState=states(1), clock=tclock, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_GridCompFinalize(gcomp2, importState=states(2), clock=tclock, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_CplCompFinalize(cpl, importState=states(1), &
exportState=states(2), clock=tclock, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
print *, "Comp Finalize complete"
! Destroy objects
call ESMF_StateDestroy(states(1), rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_StateDestroy(states(2), rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_ClockDestroy(tclock, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_CalendarDestroy(gregorianCalendar, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_GridCompDestroy(gcomp1, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_GridCompDestroy(gcomp2, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_CplCompDestroy(cpl, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
call ESMF_GridCompDestroy(top, rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
!BOC
print *, "Comp Destroy returned"
print *, "Application Example 1 finished"
!EOC
! 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)
!BOC
call ESMF_Finalize(rc=rc)
!EOC
if (rc.NE.ESMF_SUCCESS) finalrc = ESMF_FAILURE
if (finalrc.EQ.ESMF_SUCCESS) then
print *, "PASS: ESMF_AppMainEx.F90"
else
print *, "FAIL: ESMF_AppMainEx.F90"
end if
!BOC
end program ESMF_AppMainEx