subroutine test2d_generic(rc, minindex, maxindex, &
gridEdgeLWidth, gridEdgeUWidth, &
regDecomp, &
datacopyflag, &
staggerloc, &
gridToFieldMap, &
ungriddedLBound, ungriddedUBound, &
totalLWidth, totalUWidth, &
fieldget)
integer, dimension(:) :: minIndex
integer, dimension(:) :: maxIndex
integer, dimension(:), optional :: gridEdgeLWidth, gridEdgeUWidth
integer, dimension(:), optional :: regDecomp
type(ESMF_DataCopy_Flag), optional :: datacopyflag
type(ESMF_STAGGERLOC), optional :: staggerloc
integer, dimension(:), optional :: gridToFieldMap
integer, dimension(:), optional :: ungriddedLBound, ungriddedUBound
integer, dimension(:), optional :: totalLWidth, totalUWidth
logical, optional :: fieldget
integer, intent(out) :: rc
integer :: gminIndex(2), gmaxIndex(2), geleCount(2)
integer :: lminIndex(2), lmaxIndex(2), leleCount(2)
type(ESMF_Field) :: field
type(ESMF_Grid) :: grid
integer :: localrc, i, j
type(ESMF_Grid) :: grid1
type(ESMF_Array) :: array
type(ESMF_TypeKind_Flag) :: typekind
integer :: dimCount
type(ESMF_StaggerLoc) :: lstaggerloc
integer, dimension(2) :: lgridToFieldMap
integer, dimension(2) :: lungriddedLBound
integer, dimension(2) :: lungriddedUBound
integer, dimension(2,1) :: ltotalLWidth
integer, dimension(2,1) :: ltotalUWidth
integer, dimension(:,:), pointer :: farray
integer, dimension(:,:), pointer :: farray1
type(ESMF_VM) :: vm
integer :: lpe
integer, dimension(2) :: ec, cc, g2fm, mhlw, mhuw
integer, dimension(2) :: gelb, geub, gclb, gcub
integer, dimension(2) :: fsize
integer, dimension(2) :: felb, feub, fclb, fcub, ftlb, ftub
integer, dimension(2) :: fec, fcc, ftc
integer :: gridDimCount
rc = ESMF_SUCCESS
localrc = ESMF_SUCCESS
grid = ESMF_GridCreateNoPeriDim(minIndex=minIndex, maxIndex=maxIndex, &
gridEdgeLWidth=gridEdgeLWidth, gridEdgeUWidth=gridEdgeUWidth, &
regDecomp=regDecomp, name="testgrid", rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, dimCount=gridDimCount, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGet(grid, localDe=0, staggerloc=staggerloc, &
exclusiveLBound=gelb, exclusiveUBound=geub, exclusiveCount=ec, &
computationalLBound=gclb, computationalUBound=gcub, computationalCount=cc, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if(present(gridToFieldMap)) then
g2fm(1:size(gridToFieldMap)) = gridToFieldMap
else
do i = 1, 2
g2fm(i) = i
enddo
endif
mhlw = 0
if(present(totalLWidth)) then
mhlw(1:gridDimCount) = totalLWidth(1:gridDimCount)
endif
mhuw = 0
if(present(totalUWidth)) then
mhuw(1:gridDimCount) = totalUWidth(1:gridDimCount)
endif
fsize=0
do i = 1, 2
! now halowidth is in array dimension order
fsize(i) = max(cc(g2fm(i))+mhlw(i)+mhuw(i), ec(g2fm(i)))
enddo
call ESMF_GridGetFieldBounds(grid, localDe=0, staggerloc=staggerloc, &
gridToFieldMap=gridToFieldMap, &
ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, &
totalLWidth=totalLWidth, totalUWidth=totalUWidth, &
totalCount=fsize, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGetGlobal(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm, localPet=lpe, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! write(*, "(A5, 13I3)") 'MZZ: ', lpe, ec(1:2), cc(1:2), fsize(1:2),&
! mhlw(1:2), mhuw(1:2), g2fm(1:2)
allocate(farray(fsize(1), fsize(2)))
if(present(fieldget)) then
if(fieldget) then
do i = 1, fsize(1)
do j = 1, fsize(2)
farray(i, j) = i+j*2
enddo
enddo
endif
endif
field = ESMF_FieldCreate(grid, farray, &
indexflag=ESMF_INDEX_DELOCAL, datacopyflag=datacopyflag, &
staggerloc=staggerloc, gridToFieldMap=gridToFieldMap, &
ungriddedLBound=ungriddedLBound, ungriddedUBound=ungriddedUBound, &
totalLWidth=totalLWidth, totalUWidth=totalUWidth, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
if(present(fieldget)) then
if(fieldget) then
call ESMF_FieldGet(field, grid=grid1, array=array, typekind=typekind, &
dimCount=dimCount, staggerloc=lstaggerloc, gridToFieldMap=lgridToFieldMap, &
ungriddedLBound=lungriddedLBound, ungriddedUBound=lungriddedUBound, &
totalLWidth=ltotalLWidth, totalUWidth=ltotalUWidth, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(field, localDe=0, farrayPtr=farray1, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGetBounds(field, exclusiveLBound=felb, exclusiveUBound=feub, exclusiveCount=fec, &
computationalLBound=fclb, computationalUBound=fcub, computationalCount=fcc, &
totalLBound=ftlb, totalUBound=ftub, totalCount=ftc, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!write(*, "(A5, 42I3)") 'MZY: ', felb, feub, fclb, fcub, ftlb, ftub
do i = ftlb(1), ftub(1)
do j = ftlb(2), ftub(2)
if(farray1(i, j) .ne. ((i-ftlb(1)+1)+(j-ftlb(2)+1)*2) ) localrc = ESMF_FAILURE
enddo
enddo
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(field, minIndex = gminIndex, maxIndex = gmaxIndex, &
elementCount = geleCount, &
localMinIndex = lminIndex, &
localMaxIndex = lmaxIndex, &
localelementCount = leleCount, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
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
deallocate(farray)
end subroutine test2d_generic