test_locstreambkgnda Subroutine

subroutine test_locstreambkgnda(rc)

Arguments

Type IntentOptional Attributes Name
integer, intent(out) :: rc

Source Code

      subroutine test_locstreambkgnda(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, &
                                 gridAlign=(/1,1/),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 first proc extend by 1 downward to cover other point of cell
  !!      Note that this is the other direction than the other test because of
  !!      the difference in GridAlign
  if (localPet .gt. 0) clbnd(1) =clbnd(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_locstreambkgnda