subroutine test_globalindex(pinflag, testEmptyComplete, rc)
type(ESMF_Pin_Flag), optional :: pinflag
logical, optional :: testEmptyComplete
integer, intent(out) :: rc
integer :: localrc
type(ESMF_Field) :: field
type(ESMF_Grid) :: grid
real (ESMF_KIND_R8), pointer:: farray(:,:)
type(ESMF_VM) :: vm
integer :: localPet, petCount
integer :: localDeCount, ssiLocalDeCount
integer :: compLBnd(2), compUBnd(2)
type(ESMF_ArraySpec) :: arrayspec
logical :: correct
logical :: ssiSharedMemoryEnabled, testEC
rc = ESMF_SUCCESS
localrc = ESMF_SUCCESS
correct=.true.
call ESMF_VMGetGlobal(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm, petCount=petCount, localPet=localpet, &
ssiSharedMemoryEnabledFlag=ssiSharedMemoryEnabled, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! only do this if there is 4 Pets
if (petCount .eq. 4) then
! create grid with global indices
grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/16,20/), &
regDecomp=(/2,2/), indexflag=ESMF_INDEX_GLOBAL , rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! set arrayspec
call ESMF_ArraySpecSet(arrayspec, rank=2, typekind=ESMF_TYPEKIND_R8, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (present(pinflag).and.(.not.ssiSharedMemoryEnabled)) then
! force DE-TO-PET pinning
pinflag = ESMF_PIN_DE_TO_PET
endif
testEC = .false.
if (present(testEmptyComplete)) testEC = testEmptyComplete
if (testEC) then
! create field on grid via EmptyCreate() and EmptyComplete()
field = ESMF_FieldEmptyCreate(rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldEmptySet(field, grid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldEmptyComplete(field, arrayspec, pinflag=pinflag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
else
! create field on grid via FieldCreate()
field = ESMF_FieldCreate(grid, arrayspec, pinflag=pinflag, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Get field bounds
call ESMF_FieldGet(field, localde=0, farrayPtr=farray, &
computationalLBound=compLBnd, computationalUBound=compUBnd, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! check bounds
if (localpet .eq. 0) then
if (compLBnd(1) .ne. 1) correct=.false.
if (compLBnd(2) .ne. 1) correct=.false.
if (compUBnd(1) .ne. 8) correct=.false.
if (compUBnd(2) .ne. 10) correct=.false.
else if (localpet .eq. 1) then
if (compLBnd(1) .ne. 9) correct=.false.
if (compLBnd(2) .ne. 1) correct=.false.
if (compUBnd(1) .ne. 16) correct=.false.
if (compUBnd(2) .ne. 10) correct=.false.
else if (localpet .eq. 2) then
if (compLBnd(1) .ne. 1) correct=.false.
if (compLBnd(2) .ne. 11) correct=.false.
if (compUBnd(1) .ne. 8) correct=.false.
if (compUBnd(2) .ne. 20) correct=.false.
else if (localpet .eq. 3) then
if (compLBnd(1) .ne. 9) correct=.false.
if (compLBnd(2) .ne. 11) correct=.false.
if (compUBnd(1) .ne. 16) correct=.false.
if (compUBnd(2) .ne. 20) correct=.false.
endif
if (present(pinflag)) then
if (pinflag == ESMF_PIN_DE_TO_SSI) then
! check that each PET sees all 4 DEs across the SSI
call ESMF_FieldGet(field, localDeCount=localDeCount, &
ssiLocalDeCount=ssiLocalDeCount, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if (localDeCount /= 1) correct=.false.
if (ssiLocalDeCount /= 4) correct=.false.
endif
endif
call ESMF_FieldDestroy(field, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridDestroy(grid, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! return rc based on correct
if (correct) then
rc=ESMF_SUCCESS
else
rc=ESMF_FAILURE
endif
end subroutine test_globalindex