subroutine test3a_fptr(rc)
integer, intent(out) :: rc
integer :: localrc
type(ESMF_Field) :: field
type(ESMF_Grid) :: grid
real, dimension(:,:), pointer :: farray
real, dimension(:,:), pointer :: farray1
integer, dimension(2) :: tlb, tub, felb, feub, fclb, fcub
integer, dimension(2) :: gelb, geub, gclb, gcub
logical :: t
integer :: i
rc = ESMF_SUCCESS
localrc = ESMF_SUCCESS
grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=(/10,20/), &
regDecomp=(/2,2/), name="testgrid", rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_GridGetFieldBounds(grid, localDe=0, totalLBound=tlb, totalUBound=tub, rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(farray(tlb(1):tub(1), tlb(2):tub(2)))
field = ESMF_FieldCreate(grid, farrayPtr=farray, &
staggerloc=ESMF_STAGGERLOC_CENTER, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
call ESMF_FieldGet(field, localDe=0, farrayPtr=farray1, &
exclusiveLBound=felb, exclusiveUBound=feub, &
computationalLBound=fclb, computationalUBound=fcub, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! test pointer equivalence
t = associated(farray, farray1)
do i = 1, 2
t = t .and. (lbound(farray, i) .eq. tlb(i))
t = t .and. (ubound(farray, i) .eq. tub(i))
enddo
if(.not. t) then
call ESMF_LogSetError(ESMF_RC_PTR_BAD, &
msg="- pointer queried from object is not equivalent to the one passed in)", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
! test field and grid bounds
call ESMF_GridGet(grid, localDe=0, staggerloc=ESMF_STAGGERLOC_CENTER, &
exclusiveLBound=gelb, exclusiveUBound=geub, &
computationalLBound=gclb, computationalUBound=gcub, &
rc=localrc)
if (ESMF_LogFoundError(localrc, &
ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
t = .true.
do i = 1, 2
t = t .and. (gelb(i) .eq. felb(i))
t = t .and. (geub(i) .eq. feub(i))
t = t .and. (gclb(i) .eq. fclb(i))
t = t .and. (gcub(i) .eq. fcub(i))
enddo
if(.not. t) then
call ESMF_LogSetError(ESMF_RC_PTR_BAD, &
msg="- bounds queried from grid different from those queried from field)", &
ESMF_CONTEXT, rcToReturn=rc)
return
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(farray1)
end subroutine test3a_fptr