test_pointlist_from_grid_nomask Subroutine

subroutine test_pointlist_from_grid_nomask(rc)

Arguments

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

Source Code

  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