subroutine test_pointlist_from_grid_nomask(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 :: clbnd(3),cubnd(3)
integer :: i1,i2
real(ESMF_KIND_R8), pointer :: coordX(:),coordY(:)
integer :: petCount,localPet
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
! 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=clbnd, computationalUBound=cubnd, &
farrayPtr=coordX, &
rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble accessing coordinates from grid'
rc=ESMF_FAILURE
return
endif
do i1=clbnd(1),cubnd(1)
coordX(i1) = i1*10.0
enddo
local_pts=(cubnd(1)-clbnd(1)+1)
test_coordx=coordX(clbnd(1))
! get and fill second coord array
call ESMF_GridGetCoord(myGrid, localDE=lDE, staggerloc=ESMF_STAGGERLOC_CENTER, &
coordDim=2, &
computationalLBound=clbnd, computationalUBound=cubnd, &
farrayPtr=coordY, &
rc=localrc)
if (localrc /= ESMF_SUCCESS) then
print*,'ERROR: trouble accessing coordinates from grid'
rc=ESMF_FAILURE
return
endif
do i2=clbnd(1),cubnd(1)
coordY(i2) = i2*10.0
enddo
local_pts=local_pts*(cubnd(1)-clbnd(1)+1)
test_coordy=coordY(clbnd(1))
enddo
maxpts=-99
mypts=-99
mydims=-99
myid=-99
pointlist=ESMF_PointListCreate(myGrid,ESMF_STAGGERLOC_CENTER, 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
! call ESMF_PointListPrint(pointlist)
! if (localrc /= ESMF_SUCCESS) then
! rc=ESMF_FAILURE
! return
! endif
!locations values are zero based
call ESMF_PointListGetForLoc(pointlist,0,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_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_nomask