program ESMF_RouteHandleAdvancedUTest
!------------------------------------------------------------------------------
#include "ESMF.h"
#include "ESMF_Macros.inc"
!==============================================================================
!BOP
! !PROGRAM: ESMF_RouteHandleAdvancedUTest
! - This unit test file verifies Route methods.
!
! !DESCRIPTION:
!
! The code in this file drives F90 Route unit tests.
! The companion file ESMF\_Route.F90 contains the definitions for the
! Route methods.
!
!-----------------------------------------------------------------------------
! !USES:
use ESMF_TestMod ! test methods
use ESMF
use compAmod, only: ssA => SetServices
use compBmod, only: ssB => SetServices
#ifndef ESMF_NO_DYNMASKOVERLOAD
use dynMaskmod
#endif
implicit none
!------------------------------------------------------------------------------
! The following line turns the CVS identifier string into a printable variable.
character(*), parameter :: version = &
'$Id$'
!------------------------------------------------------------------------------
! cumulative result: count failures; no failures equals "all pass"
integer :: result = 0
! individual test result code
integer :: rc, urc
type(ESMF_VM) :: vm
integer :: i
integer :: petCount, petCountR, petCountA, petCountB1
integer, allocatable :: petListA(:), petListB1(:), petListB2(:)
integer, allocatable :: originPetList(:), targetPetList(:)
type(ESMF_State) :: stateAB1, stateAB2
type(ESMF_GridComp) :: compA, compB1, compB2
type(ESMF_Field) :: fieldA, fieldB1, fieldB2
type(ESMF_RouteHandle) :: rh1, rh2
logical :: isCreated
type(ESMF_DynamicMask) :: dynamicMask
! individual test failure message
character(ESMF_MAXSTR) :: failMsg
character(ESMF_MAXSTR) :: name
call ESMF_TestStart(ESMF_SRCLINE, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_VMGetGlobal(vm, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
stateAB1 = ESMF_StateCreate(rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
stateAB2 = ESMF_StateCreate(rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_VMGet(vm, petCount=petCount, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
petCountA = petCount/2 ! component A gets half the PETs
allocate(petListA(petCountA))
do i=1, petCountA
petListA(i) = i-1 ! PETs are base 0
enddo
! split the remaining PETs evenly between component B + C
petCountR = petCount - petCountA
petCountB1 = petCountR / 2
allocate(petListB1(petCountB1))
do i=1, petCountB1
petListB1(i) = petCountA + i-1 ! PETs are base 0
enddo
allocate(petListB2(petCountR-petCountB1))
do i=1, petCountR-petCountB1
petListB2(i) = petCountA + petCountB1 + i-1 ! PETs are base 0
enddo
compA = ESMF_GridCompCreate(petList=petListA, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
compB1 = ESMF_GridCompCreate(petList=petListB1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
compB2 = ESMF_GridCompCreate(petList=petListB2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompSetServices(compA, ssA, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompSetServices(compB1, ssB, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompSetServices(compB2, ssB, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompInitialize(compA, exportState=stateAB1, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompInitialize(compB1, importState=stateAB1, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompInitialize(compB2, importState=stateAB2, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_StateReconcile(stateAB1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_StateReconcile(stateAB2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_StateGet(stateAB1, field=fieldA, itemName="fieldA", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_StateGet(stateAB1, field=fieldB1, itemName="fieldB", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_StateGet(stateAB2, field=fieldB2, itemName="fieldB", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create RouteHandle for the original petList"
write(failMsg, *) "RouteHandleCreate failed"
call ESMF_FieldRedistStore(srcField=fieldA, dstField=fieldB1, &
routehandle=rh1, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleIsCreated()"
write(failMsg, *) "Did not return ESMF_SUCCESS"
isCreated = ESMF_RouteHandleIsCreated(rh1, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleIsCreated() return value"
write(failMsg, *) "Incorrect return value"
call ESMF_Test((isCreated), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleGet()"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_RouteHandleGet(rh1, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleWrite()"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_RouteHandleWrite(rh1, fileName="testWrite.RH", rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleDestroy()"
write(failMsg, *) "RouteHandleDestroy failed"
call ESMF_RouteHandleDestroy(rh1, noGarbage=.true., rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleCreate(from file)"
write(failMsg, *) "Did not return ESMF_SUCCESS"
rh2 = ESMF_RouteHandleCreate(fileName="testWrite.RH", rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Apply the read in Routehandle"
write(failMsg, *) "ESMF_FieldRedist failed"
call ESMF_FieldRedist(srcField=fieldA, dstField=fieldB1, &
routehandle=rh2, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleDestroy() for the read in Routehandle"
write(failMsg, *) "RouteHandleDestroy failed"
call ESMF_RouteHandleDestroy(rh2, noGarbage=.true., rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
! Prepare to test create RH from RH
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Create RouteHandle for the original petList"
write(failMsg, *) "RouteHandleCreate failed"
call ESMF_FieldRedistStore(srcField=fieldA, dstField=fieldB1, &
routehandle=rh1, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
! construct originPetList
allocate(originPetList(size(petListA)+size(petListB1)))
originPetList(1:size(petListA)) = petListA(:)
originPetList(size(petListA)+1:) = petListB1(:)
! construct targetPetList
allocate(targetPetList(size(petListA)+size(petListB2)))
targetPetList(1:size(petListA)) = petListA(:)
targetPetList(size(petListA)+1:) = petListB2(:)
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Transfer RouteHandle to a different petList"
write(failMsg, *) "RouteHandleCreate failed"
rh2 = ESMF_RouteHandleCreate(rh1, originPetList=originPetList, &
targetPetList=targetPetList, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
deallocate(originPetList, targetPetList)
!-----------------------------------------------------------------------------
call ESMF_RouteHandlePrint(rh1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldFill(fieldA, dataFillScheme="sincos", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldFill(fieldB1, dataFillScheme="one", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_FieldFill(fieldB2, dataFillScheme="one", rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleDestroy()"
write(failMsg, *) "RouteHandleDestroy failed"
call ESMF_RouteHandleDestroy(rh1, noGarbage=.true., rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
! apply the RH
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Apply the copied Routehandle"
write(failMsg, *) "ESMF_FieldRedist failed"
call ESMF_FieldRedist(srcField=fieldA, dstField=fieldB2, &
routehandle=rh2, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test RouteHandleDestroy() for the copied Routehandle"
write(failMsg, *) "RouteHandleDestroy failed"
call ESMF_RouteHandleDestroy(rh2, noGarbage=.true., rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
call ESMF_GridCompFinalize(compA, exportState=stateAB1, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompFinalize(compB2, importState=stateAB2, userRc=urc, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompDestroy(compA, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompDestroy(compB1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_GridCompDestroy(compB2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_StateDestroy(stateAB1, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
call ESMF_StateDestroy(stateAB2, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, &
line=__LINE__, &
file=__FILE__)) &
call ESMF_Finalize(endflag=ESMF_END_ABORT)
deallocate(petListA)
deallocate(petListB1)
deallocate(petListB2)
#ifndef ESMF_NO_DYNMASKOVERLOAD
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test ESMF_DynamicMaskSetR4R4R4()"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_DynamicMaskSetR4R4R4(dynamicMask, &
dynamicMaskRoutine=dynMaskR4R4R4, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test ESMF_DynamicMaskSetR4R4R4V()"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_DynamicMaskSetR4R4R4V(dynamicMask, &
dynamicMaskRoutine=dynMaskR4R4R4V, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
!NEX_UTest_Multi_Proc_Only
write(name, *) "Test ESMF_DynamicMaskSetR4R8R4V()"
write(failMsg, *) "Did not return ESMF_SUCCESS"
call ESMF_DynamicMaskSetR4R8R4V(dynamicMask, &
dynamicMaskRoutine=dynMaskR4R8R4V, rc=rc)
call ESMF_Test((rc == ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!-----------------------------------------------------------------------------
#else
write(name, *) "Dummy test to satisfy scripts for ESMF_NO_DYNMASKOVERLOAD"
write(failMsg, *) "Did not succeed"
do i=1,3
call ESMF_Test((.true.), name, failMsg, result, ESMF_SRCLINE)
enddo
#endif
!------------------------------------------------------------------------
10 continue
call ESMF_TestEnd(ESMF_SRCLINE) ! calls ESMF_Finalize() internally
!------------------------------------------------------------------------
end program ESMF_RouteHandleAdvancedUTest