subroutine test_locstreambkg(rc)
integer, intent(out) :: rc
logical :: correct
integer :: localrc
type(ESMF_Grid) :: gridA
type(ESMF_VM) :: vm
real(ESMF_KIND_R8), pointer :: farrayPtrXC(:,:)
real(ESMF_KIND_R8), pointer :: farrayPtrYC(:,:)
integer :: clbnd(2),cubnd(2)
integer :: i1,i2,i3, index(2)
real(ESMF_KIND_R8) :: coord(2)
integer A_nx, A_ny
real(ESMF_KIND_R8) :: A_minx,A_miny
real(ESMF_KIND_R8) :: A_maxx,A_maxy
integer :: localPet, petCount
real(ESMF_KIND_R8) :: de_minx, de_maxx
real(ESMF_KIND_R8) :: de_miny, de_maxy
integer :: pntCount
real(ESMF_KIND_R8), pointer :: X(:),Y(:)
real(ESMF_KIND_R8), pointer :: tstX(:),tstY(:)
type(ESMF_LocStream) :: locstream, newlocstream
real(ESMF_KIND_R8) :: tmpXC, tmpYC
! result code
integer :: finalrc
! init success flag
correct=.true.
rc=ESMF_SUCCESS
! get pet info
call ESMF_VMGetGlobal(vm, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
call ESMF_VMGet(vm, petCount=petCount, localPet=localpet, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Establish the resolution of the grids
A_nx = 16
A_ny = 16
! Establish the coordinates of the grids
A_minx = 0.0
A_miny = 0.0
A_maxx = 2.0
A_maxy = 2.0
! setup source grid
gridA=ESMF_GridCreateNoPeriDim(minIndex=(/1,1/),maxIndex=(/A_nx,A_ny/),regDecomp=(/petCount,1/), &
coordSys=ESMF_COORDSYS_CART, &
indexflag=ESMF_INDEX_GLOBAL, &
rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Allocate coordinates
call ESMF_GridAddCoord(gridA, staggerloc=ESMF_STAGGERLOC_CORNER, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! Construct Grid A
! (Get memory and set coords for src)
!! get coord 1
call ESMF_GridGetCoord(gridA, localDE=0, staggerLoc=ESMF_STAGGERLOC_CORNER, coordDim=1, &
computationalLBound=clbnd, computationalUBound=cubnd, farrayPtr=farrayPtrXC, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
call ESMF_GridGetCoord(gridA, localDE=0, staggerLoc=ESMF_STAGGERLOC_CORNER, coordDim=2, &
computationalLBound=clbnd, computationalUBound=cubnd, farrayPtr=farrayPtrYC, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
!! set coords, interpolated function
do i1=clbnd(1),cubnd(1)
do i2=clbnd(2),cubnd(2)
! Set source coordinates
farrayPtrXC(i1,i2) = ((A_maxx-A_minx)*REAL(i1-1)/REAL(A_nx-1))+A_minx
farrayPtrYC(i1,i2) = ((A_maxy-A_miny)*REAL(i2-1)/REAL(A_ny-1))+A_miny
enddo
enddo
!!!!!!!! Create LocStream !!!!!!!!!!!
! Set number of points
if (localPet .eq. 0) then
pntCount=2
else if (localPet .eq. 1) then
pntCount=3
else if (localPet .eq. 2) then
pntCount=1
else if (localPet .eq. 3) then
pntCount=1
endif
! Create LocStream
locstream=ESMF_LocStreamCreate(localCount=pntCount, &
coordSys=ESMF_COORDSYS_CART, &
rc=localrc)
if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
! Allocate X array
allocate(X(pntCount))
! allocate Y array
allocate(Y(pntCount))
! Fill in points
if (localPet .eq. 0) then
X(1)=1.0
Y(1)=1.0
X(2)=0.5
Y(2)=1.5
else if (localPet .eq. 1) then
X(1)=1.5
Y(1)=0.5
X(2)=1.5
Y(2)=1.5
X(3)=1.9
Y(3)=1.75
else if (localPet .eq. 2) then
X(1)=0.5
Y(1)=0.5
else if (localPet .eq. 3) then
X(1)=1.9
Y(1)=0.1
endif
! Add key X
call ESMF_LocStreamAddKey(locstream, keyName="ESMF:X", farray=X, rc=localrc)
if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
! Add key Y
call ESMF_LocStreamAddKey(locstream, keyName="ESMF:Y", farray=Y, rc=localrc)
if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
! Do locStream create from background mesh
newLocstream=ESMF_LocStreamCreate(locstream, &
background=gridA, rc=localrc)
if (localrc .ne. ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
call ESMF_LocStreamDestroy(locstream,rc=localrc)
if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
! deallocate array
deallocate(X)
deallocate(Y)
! Test Newly Created LocStream
! Since the grid is setup to be rectilinear checking the min/max should be fine
!! get coord 1
call ESMF_GridGetCoord(gridA, localDE=0, staggerLoc=ESMF_STAGGERLOC_CORNER, coordDim=1, &
farrayPtr=farrayPtrXC, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
call ESMF_GridGetCoord(gridA, localDE=0, staggerLoc=ESMF_STAGGERLOC_CORNER, coordDim=2, &
computationalLBound=clbnd, computationalUBound=cubnd, farrayPtr=farrayPtrYC, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
!! Init min/max of DE
de_minx=A_maxx
de_miny=A_maxy
de_maxx=A_minx
de_maxy=A_miny
!! Adjust loop to cover min-max of cells not just nodes
!! i.e. if not the last proc extend by 1 to cover other point of cell
if (localPet .lt. petCount-1) cubnd(1) =cubnd(1)+1
!! set coords, interpolated function
do i1=clbnd(1),cubnd(1)
do i2=clbnd(2),cubnd(2)
! Set source coordinates
tmpXC = ((A_maxx-A_minx)*REAL(i1-1)/REAL(A_nx-1))+A_minx
tmpYC = ((A_maxy-A_miny)*REAL(i2-1)/REAL(A_ny-1))+A_miny
! Min/max off coordinates
if (tmpXC < de_minx) de_minx=tmpXC
if (tmpXC > de_maxx) de_maxx=tmpXC
if (tmpYC < de_miny) de_miny=tmpYC
if (tmpYC > de_maxy) de_maxy=tmpYC
enddo
enddo
!!!!!!!!! Check locstream points vs Grid min max !!!!!!!!!!!!!!!!!
call ESMF_LocStreamGetKey(newlocStream,keyName="ESMF:X", &
farray=tstX, &
exclusiveLBound=el, exclusiveUBound=eu, rc=localrc)
if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
call ESMF_LocStreamGetKey(newLocStream,keyName="ESMF:Y", &
farray=tstY, rc=localrc)
if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
! Test points
do i=el,eu
if ((tstX(i) < de_minx) .or. (tstX(i) > de_maxx)) then
write(*,*) tstX(i),"not in [",de_minx,de_maxx,"]"
correct=.false.
endif
if ((tstY(i) < de_miny) .or. (tstY(i) > de_maxy)) then
write(*,*) tstY(i),"not in [",de_miny,de_maxy,"]"
correct=.false.
endif
enddo
! Get rid of the new locstream
call ESMF_LocStreamDestroy(newLocstream,rc=localrc)
if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
! Free the grids
call ESMF_GridDestroy(gridA, rc=localrc)
if (localrc /=ESMF_SUCCESS) then
rc=ESMF_FAILURE
return
endif
! return answer based on correct flag
if (correct) then
rc=ESMF_SUCCESS
else
rc=ESMF_FAILURE
endif
end subroutine test_locstreambkg