subroutine test_pointlist_from_grid_wmask(rc)
integer, intent(out) :: rc
integer :: localrc
!LOCAL VARIABLES:
type(ESMF_PointList) :: pointlist
type(ESMF_VM) :: vm
integer :: maxpts, mydims, mypts, myid
type(ESMF_Grid) :: myGrid
integer :: lDE, localDECount
integer :: clbndx(2),cubndx(2)
integer :: clbndy(2),cubndy(2)
integer :: i1,i2
real(ESMF_KIND_R8), pointer :: coordX(:),coordY(:)
integer :: petCount,localPet
integer(ESMF_KIND_I4), pointer :: gMask(:,:)
integer(ESMF_KIND_I4) :: maskValues(2)
integer :: local_pts
real(ESMF_KIND_R8), dimension(2) :: test_coords
real(ESMF_KIND_R8) test_coordx,test_coordy
real(ESMF_KIND_R8) my_err1,my_err2,my_err3
! get global VM
call ESMF_VMGetGlobal(vm, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_VMGet(vm, localPet=localPet, petCount=petCount, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Create Grid with globalXCountxglobalYCount cells
myGrid=ESMF_GridCreateNoPeriDim(minIndex=(/1,1/),maxIndex=(/10,20/), &
coordSys=ESMF_COORDSYS_CART, &
coordDep1 = (/1/), &
coordDep2 = (/2/), &
indexflag=ESMF_INDEX_GLOBAL, &
rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble creating grid'
rc=ESMF_FAILURE
return
endif
! Get number of local DEs
call ESMF_GridGet(myGrid, localDECount=localDECount, rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble accessing localDECount from grid'
rc=ESMF_FAILURE
return
endif
! Allocate Center (e.g. Center) stagger
call ESMF_GridAddCoord(myGrid, staggerloc=ESMF_STAGGERLOC_CENTER, rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble adding coordinates to grid'
rc=ESMF_FAILURE
return
endif
! Allocate Masks
call ESMF_GridAddItem(myGrid, staggerloc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_MASK, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
print*,'ERROR: trouble allocating mask info in grid'
rc=ESMF_FAILURE
return
endif
! Loop through DEs and set Centers as the average of the corners
do lDE=0,localDECount-1
! get and fill first coord array
call ESMF_GridGetCoord(myGrid, localDE=lDE, staggerloc=ESMF_STAGGERLOC_CENTER, &
coordDim=1, &
computationalLBound=clbndx, computationalUBound=cubndx, &
farrayPtr=coordX, &
rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble accessing coordinates from grid'
rc=ESMF_FAILURE
return
endif
do i1=clbndx(1),cubndx(1)
coordX(i1) = i1*10.0
enddo
! get and fill second coord array
call ESMF_GridGetCoord(myGrid, localDE=lDE, staggerloc=ESMF_STAGGERLOC_CENTER, &
coordDim=2, &
computationalLBound=clbndy, computationalUBound=cubndy, &
farrayPtr=coordY, &
rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble accessing coordinates from grid'
rc=ESMF_FAILURE
return
endif
do i2=clbndy(1),cubndy(1)
coordY(i2) = i2*10.0
enddo
call ESMF_GridGetItem(myGrid, localDE=lDE, staggerLoc=ESMF_STAGGERLOC_CENTER, &
itemflag=ESMF_GRIDITEM_MASK, farrayPtr=gMask, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
print*,'ERROR: trouble accessing mask info from grid'
rc=ESMF_FAILURE
return
endif
local_pts=0
do i1=clbndx(1),cubndx(1)
do i2=clbndy(1),cubndy(1)
if (i1 == i2) then
gMask(i1,i2) = 2
else
gMask(i1,i2) = 0
local_pts=local_pts+1
test_coordx=coordX(i1)
test_coordy=coordY(i2)
endif
enddo
enddo
enddo
maxpts=-99
mypts=-99
mydims=-99
myid=-99
! convert mask values
maskValues=(/1,2/)
pointlist=ESMF_PointListCreate(myGrid,ESMF_STAGGERLOC_CENTER, &
maskValues=maskValues, rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble creating pointlist'
rc=ESMF_FAILURE
return
endif
call ESMF_PointListGet(pointlist, dims=mydims, numpts=mypts, maxpts=maxpts, rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble accessing pointlist data with get routine'
rc=ESMF_FAILURE
return
endif
if (maxpts .ne. local_pts .or. mypts .ne. local_pts .or. mydims .ne. 2) then
print*,'ERROR: unexpected values for newly created pointlist:'
print*,'maxpts should be: ',local_pts,' got: ',maxpts
print*,'numpts should be: ',local_pts,' got: ',mypts
print*,'dims should be: 2 got: ',mydims
rc=ESMF_FAILURE
return
endif
!locations values are zero based
call ESMF_PointListGetForLoc(pointlist,mypts-1,loc_coords=test_coords,rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble accessing pointlist data with get for location routine'
rc=ESMF_FAILURE
return
endif
my_err1 = abs(test_coordx - test_coords(1))
my_err2 = abs(test_coordy - test_coords(2))
if (my_err1 .gt. .0001 .or. my_err2 .gt. .0001) then
print*,'ERROR: unexpected coordinates for queried pointlist location:'
print*,'expected ( ',test_coordx,' , ',test_coordy,' ) got (',test_coords(1),',',test_coords(2),')'
rc=ESMF_FAILURE
return
endif
! call ESMF_PointListPrint(pointlist)
! if (localrc /= ESMF_SUCCESS) then
! rc=ESMF_FAILURE
! return
! endif
call ESMF_GridDestroy(myGrid, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
print*,'ERROR: trouble destroying grid'
rc=ESMF_FAILURE
return
endif
call ESMF_PointListDestroy(pointlist,rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble destroying pointlist'
rc=ESMF_FAILURE
return
endif
rc=ESMF_SUCCESS
end subroutine test_pointlist_from_grid_wmask