check1DBnds2x2 Subroutine

subroutine check1DBnds2x2(grid, coordDim, staggerloc, localPet, petCount, ielbnd0, ieubnd0, iloff0, iuoff0, ielbnd1, ieubnd1, iloff1, iuoff1, ielbnd2, ieubnd2, iloff2, iuoff2, ielbnd3, ieubnd3, iloff3, iuoff3, correct, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_Grid) :: grid
integer, intent(in) :: coordDim
type(ESMF_StaggerLoc), intent(in) :: staggerloc
integer, intent(in) :: localPet
integer, intent(in) :: petCount
integer, intent(in) :: ielbnd0(:)
integer, intent(in) :: ieubnd0(:)
integer, intent(in) :: iloff0(:)
integer, intent(in) :: iuoff0(:)
integer, intent(in) :: ielbnd1(:)
integer, intent(in) :: ieubnd1(:)
integer, intent(in) :: iloff1(:)
integer, intent(in) :: iuoff1(:)
integer, intent(in) :: ielbnd2(:)
integer, intent(in) :: ieubnd2(:)
integer, intent(in) :: iloff2(:)
integer, intent(in) :: iuoff2(:)
integer, intent(in) :: ielbnd3(:)
integer, intent(in) :: ieubnd3(:)
integer, intent(in) :: iloff3(:)
integer, intent(in) :: iuoff3(:)
logical, intent(inout) :: correct
integer, intent(inout) :: rc

Calls

proc~~check1dbnds2x2~~CallsGraph proc~check1dbnds2x2 check1DBnds2x2 interface~esmf_gridgetcoord ESMF_GridGetCoord proc~check1dbnds2x2->interface~esmf_gridgetcoord proc~esmf_gridgetcoordbounds ESMF_GridGetCoordBounds proc~check1dbnds2x2->proc~esmf_gridgetcoordbounds proc~esmf_gridgetcoord1dr4 ESMF_GridGetCoord1DR4 interface~esmf_gridgetcoord->proc~esmf_gridgetcoord1dr4 proc~esmf_gridgetcoord1dr8 ESMF_GridGetCoord1DR8 interface~esmf_gridgetcoord->proc~esmf_gridgetcoord1dr8 proc~esmf_gridgetcoord2dr4 ESMF_GridGetCoord2DR4 interface~esmf_gridgetcoord->proc~esmf_gridgetcoord2dr4 proc~esmf_gridgetcoord2dr8 ESMF_GridGetCoord2DR8 interface~esmf_gridgetcoord->proc~esmf_gridgetcoord2dr8 proc~esmf_gridgetcoord3dr4 ESMF_GridGetCoord3DR4 interface~esmf_gridgetcoord->proc~esmf_gridgetcoord3dr4 proc~esmf_gridgetcoord3dr8 ESMF_GridGetCoord3DR8 interface~esmf_gridgetcoord->proc~esmf_gridgetcoord3dr8 proc~esmf_gridgetcoordinfo ESMF_GridGetCoordInfo interface~esmf_gridgetcoord->proc~esmf_gridgetcoordinfo proc~esmf_gridgetcoordintoarray ESMF_GridGetCoordIntoArray interface~esmf_gridgetcoord->proc~esmf_gridgetcoordintoarray proc~esmf_gridgetcoordr4 ESMF_GridGetCoordR4 interface~esmf_gridgetcoord->proc~esmf_gridgetcoordr4 proc~esmf_gridgetcoordr8 ESMF_GridGetCoordR8 interface~esmf_gridgetcoord->proc~esmf_gridgetcoordr8 c_esmc_gridgetcoordbounds c_esmc_gridgetcoordbounds proc~esmf_gridgetcoordbounds->c_esmc_gridgetcoordbounds interface~esmf_interarraycreate ESMF_InterArrayCreate proc~esmf_gridgetcoordbounds->interface~esmf_interarraycreate proc~esmf_gridgetinit ESMF_GridGetInit proc~esmf_gridgetcoordbounds->proc~esmf_gridgetinit proc~esmf_imerr ESMF_IMErr proc~esmf_gridgetcoordbounds->proc~esmf_imerr proc~esmf_interarraydestroy ESMF_InterArrayDestroy proc~esmf_gridgetcoordbounds->proc~esmf_interarraydestroy proc~esmf_logfounderror ESMF_LogFoundError proc~esmf_gridgetcoordbounds->proc~esmf_logfounderror

Called by

proc~~check1dbnds2x2~~CalledByGraph proc~check1dbnds2x2 check1DBnds2x2 program~esmf_gridcoordutest ESMF_GridCoordUTest program~esmf_gridcoordutest->proc~check1dbnds2x2

Source Code

subroutine check1DBnds2x2(grid, coordDim, staggerloc, localPet, petCount, &
                          ielbnd0,ieubnd0,iloff0,iuoff0, &
                          ielbnd1,ieubnd1,iloff1,iuoff1, &
                          ielbnd2,ieubnd2,iloff2,iuoff2, &
                          ielbnd3,ieubnd3,iloff3,iuoff3, &
                          correct, rc)

  type (ESMF_Grid) :: grid
  type (ESMF_StaggerLoc),intent(in) :: staggerloc
  integer,intent(in) :: coordDim, localPet, petCount
  integer,intent(in) :: ielbnd0(:),ieubnd0(:),iloff0(:),iuoff0(:)
  integer,intent(in) :: ielbnd1(:),ieubnd1(:),iloff1(:),iuoff1(:)
  integer,intent(in) :: ielbnd2(:),ieubnd2(:),iloff2(:),iuoff2(:)
  integer,intent(in) :: ielbnd3(:),ieubnd3(:),iloff3(:),iuoff3(:)
  logical,intent(inout) :: correct
  integer,intent(inout) :: rc
  
  integer :: localrc
  integer :: elbnd(1),eubnd(1),ecnt(1)
  integer :: clbnd(1),cubnd(1),ccnt(1)
  integer :: tlbnd(1),tubnd(1),tcnt(1)
  real (ESMF_KIND_R8), pointer :: farrayPtr(:)


  ! Check if bounds are correct for each DE
  if (petCount .eq. 1) then
      ! Note the order of DE's here is dependant on the ordering
      ! in ESMF_GridCreateNoPeriDim, if that changes then this will
      ! probably have to change also. 

      ! check DE 0
      call ESMF_GridGetCoordBounds(grid, coordDim=coordDim, localDE=0, &
             staggerLoc=staggerloc,                  &
             exclusiveLBound=elbnd, exclusiveUBound=eubnd,  exclusiveCount=ecnt,     &
             computationalLBound=clbnd, computationalUBound=cubnd,  computationalCount=ccnt,     &
             totalLBound=tlbnd, totalUBound=tubnd, totalCount=tcnt, rc=localrc)
             if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE

!    write(*,*) "0:",clbnd,",",cubnd,correct

     !! set pointer to null
     nullify(farrayPtr)
 
     !! Get Coord Array From Grid
     call ESMF_GridGetCoord(grid, localDE=0, &
              staggerLoc=staggerloc, coordDim=coordDim, farrayPtr=farrayPtr, rc=localrc)
     if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE

     !! Check that output is as expected
     if (.not. associated(farrayPtr)) correct=.false.
     if (lbound(farrayPtr,1) .ne. tlbnd(1)) correct=.false.
     if (ubound(farrayPtr,1) .ne. tubnd(1)) correct=.false.

     if (elbnd(1) .ne. ielbnd0(1)-iloff0(1)) correct=.false.
     if (eubnd(1) .ne. ieubnd0(1)+iuoff0(1)) correct=.false.
     if (ecnt(1) .ne. ieubnd0(1)-ielbnd0(1)+1+iloff0(1)+iuoff0(1)) correct=.false.

     if (clbnd(1) .ne. ielbnd0(1)-iloff0(1)) correct=.false.
     if (cubnd(1) .ne. ieubnd0(1)+iuoff0(1)) correct=.false.
     if (ccnt(1) .ne. ieubnd0(1)-ielbnd0(1)+1+iloff0(1)+iuoff0(1)) correct=.false.

     if (tlbnd(1) .ne. ielbnd0(1)-iloff0(1)) correct=.false.
     if (tubnd(1) .ne. ieubnd0(1)+iuoff0(1)) correct=.false.
     if (tcnt(1) .ne. ieubnd0(1)-ielbnd0(1)+1+iloff0(1)+iuoff0(1)) correct=.false.


      ! check DE 1
      call ESMF_GridGetCoordBounds(grid2D, coordDim=coordDim, localDE=1, &
             staggerLoc=staggerloc,                  &
             exclusiveLBound=elbnd, exclusiveUBound=eubnd,   exclusiveCount=ecnt,     &
             computationalLBound=clbnd, computationalUBound=cubnd, computationalCount=ccnt,  &
             totalLBound=tlbnd, totalUBound=tubnd, totalCount=tcnt, rc=localrc)
             if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE

!    write(*,*) "1:",clbnd,",",cubnd,correct

     !! set pointer to null
     nullify(farrayPtr)

     !! Get Coord From Grid
     call ESMF_GridGetCoord(grid, localDE=1, &
              staggerLoc=staggerloc, coordDim=coordDim, farrayPtr=farrayPtr, rc=localrc)
     if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE

     !! Check that output is as expected
     if (.not. associated(farrayPtr)) correct=.false.
     if (lbound(farrayPtr,1) .ne. tlbnd(1)) correct=.false.
     if (ubound(farrayPtr,1) .ne. tubnd(1)) correct=.false.

     if (elbnd(1) .ne. ielbnd1(1)-iloff1(1)) correct=.false.
     if (eubnd(1) .ne. ieubnd1(1)+iuoff1(1)) correct=.false.
     if (ecnt(1) .ne. ieubnd1(1)-ielbnd1(1)+1+iloff1(1)+iuoff1(1)) correct=.false.

     if (clbnd(1) .ne. ielbnd1(1)-iloff1(1)) correct=.false.
     if (cubnd(1) .ne. ieubnd1(1)+iuoff1(1)) correct=.false.
     if (ccnt(1) .ne. ieubnd1(1)-ielbnd1(1)+1+iloff1(1)+iuoff1(1)) correct=.false.

     if (tlbnd(1) .ne. ielbnd1(1)-iloff1(1)) correct=.false.
     if (tubnd(1) .ne. ieubnd1(1)+iuoff1(1)) correct=.false.
     if (tcnt(1) .ne. ieubnd1(1)-ielbnd1(1)+1+iloff1(1)+iuoff1(1)) correct=.false.

      ! check DE 2
      call ESMF_GridGetCoordBounds(grid, coordDim=coordDim, localDE=2, &
             staggerLoc=staggerloc,                  &
             exclusiveLBound=elbnd, exclusiveUBound=eubnd,   exclusiveCount=ecnt,     &
             computationalLBound=clbnd, computationalUBound=cubnd, computationalCount=ccnt,   &
             totalLBound=tlbnd, totalUBound=tubnd, totalCount=tcnt, rc=localrc)
             if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
 !   write(*,*) "2:",clbnd,",",cubnd,correct
     !! set pointer to null
     nullify(farrayPtr)

     !! Get Coord From Grid
     call ESMF_GridGetCoord(grid, localDE=2, &
              staggerLoc=staggerloc, coordDim=coordDim, farrayPtr=farrayPtr, rc=localrc)
     if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE

     !! Check that output is as expected
     if (.not. associated(farrayPtr)) correct=.false.
     if (lbound(farrayPtr,1) .ne. tlbnd(1)) correct=.false.
     if (ubound(farrayPtr,1) .ne. tubnd(1)) correct=.false.
 

     if (elbnd(1) .ne. ielbnd2(1)-iloff2(1)) correct=.false.
     if (eubnd(1) .ne. ieubnd2(1)+iuoff2(1)) correct=.false.
     if (ecnt(1) .ne. ieubnd2(1)-ielbnd2(1)+1+iloff2(1)+iuoff2(1)) correct=.false.

     if (clbnd(1) .ne. ielbnd2(1)-iloff2(1)) correct=.false.
     if (cubnd(1) .ne. ieubnd2(1)+iuoff2(1)) correct=.false.
     if (ccnt(1) .ne. ieubnd2(1)-ielbnd2(1)+1+iloff2(1)+iuoff2(1)) correct=.false.

     if (tlbnd(1) .ne. ielbnd2(1)-iloff2(1)) correct=.false.
     if (tubnd(1) .ne. ieubnd2(1)+iuoff2(1)) correct=.false.
     if (tcnt(1) .ne. ieubnd2(1)-ielbnd2(1)+1+iloff2(1)+iuoff2(1)) correct=.false.


      ! check DE 3
      call ESMF_GridGetCoordBounds(grid, coordDim=coordDim, localDE=3, &
             staggerLoc=staggerloc,                  &
             exclusiveLBound=elbnd, exclusiveUBound=eubnd,   exclusiveCount=ecnt,     &
             computationalLBound=clbnd, computationalUBound=cubnd, computationalCount=ccnt,   &
             totalLBound=tlbnd, totalUBound=tubnd, totalCount=tcnt, rc=localrc)
             if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE
 !    write(*,*) "3:",clbnd,",",cubnd,correct
     !! set pointer to null
     nullify(farrayPtr)

     !! Get Coord From Grid
     call ESMF_GridGetCoord(grid, localDE=3, &
              staggerLoc=staggerloc, coordDim=coordDim, farrayPtr=farrayPtr, rc=localrc)
     if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE

     !! Check that output is as expected
     if (.not. associated(farrayPtr)) correct=.false.
     if (lbound(farrayPtr,1) .ne. tlbnd(1)) correct=.false.
     if (ubound(farrayPtr,1) .ne. tubnd(1)) correct=.false.

     if (elbnd(1) .ne. ielbnd3(1)-iloff3(1)) correct=.false.
     if (eubnd(1) .ne. ieubnd3(1)+iuoff3(1)) correct=.false.
     if (ecnt(1) .ne. ieubnd3(1)-ielbnd3(1)+1+iloff3(1)+iuoff3(1)) correct=.false.

     if (clbnd(1) .ne. ielbnd3(1)-iloff3(1)) correct=.false.
     if (cubnd(1) .ne. ieubnd3(1)+iuoff3(1)) correct=.false.
     if (ccnt(1) .ne. ieubnd3(1)-ielbnd3(1)+1+iloff3(1)+iuoff3(1)) correct=.false.

     if (tlbnd(1) .ne. ielbnd3(1)-iloff3(1)) correct=.false.
     if (tubnd(1) .ne. ieubnd3(1)+iuoff3(1)) correct=.false.
     if (tcnt(1) .ne. ieubnd3(1)-ielbnd3(1)+1+iloff3(1)+iuoff3(1)) correct=.false.

  else  if (petCount .eq. 4) then
      call ESMF_GridGetCoordBounds(grid, coordDim=coordDim, localDE=0, &
             staggerLoc=staggerloc,                  &
             exclusiveLBound=elbnd, exclusiveUBound=eubnd,  exclusiveCount=ecnt,      &
             computationalLBound=clbnd, computationalUBound=cubnd, computationalCount=ccnt, &
             totalLBound=tlbnd, totalUBound=tubnd, totalCount=tcnt, rc=localrc)
             if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE

      ! set pointer to null
      nullify(farrayPtr)

     ! Get Coord From Grid
     call ESMF_GridGetCoord(grid, localDE=0, &
              staggerLoc=staggerloc, coordDim=coordDim, farrayPtr=farrayPtr, rc=localrc)
     if (localrc .ne. ESMF_SUCCESS) rc=ESMF_FAILURE

     ! Check that output is as expected
     if (.not. associated(farrayPtr)) correct=.false.
     if (lbound(farrayPtr,1) .ne. tlbnd(1)) correct=.false.
     if (ubound(farrayPtr,1) .ne. tubnd(1)) correct=.false.

     if (localPet .eq. 0) then

        if (elbnd(1) .ne. ielbnd0(1)-iloff0(1)) correct=.false.
        if (eubnd(1) .ne. ieubnd0(1)+iuoff0(1)) correct=.false.
        if (ecnt(1) .ne. ieubnd0(1)-ielbnd0(1)+1+iloff0(1)+iuoff0(1)) correct=.false.

        if (clbnd(1) .ne. ielbnd0(1)-iloff0(1)) correct=.false.
        if (cubnd(1) .ne. ieubnd0(1)+iuoff0(1)) correct=.false.
        if (ccnt(1) .ne. ieubnd0(1)-ielbnd0(1)+1+iloff0(1)+iuoff0(1)) correct=.false.

        if (tlbnd(1) .ne. ielbnd0(1)-iloff0(1)) correct=.false.
        if (tubnd(1) .ne. ieubnd0(1)+iuoff0(1)) correct=.false.
        if (tcnt(1) .ne. ieubnd0(1)-ielbnd0(1)+1+iloff0(1)+iuoff0(1)) correct=.false.

     else if (localPet .eq. 1) then
        if (elbnd(1) .ne. ielbnd1(1)-iloff1(1)) correct=.false.
        if (eubnd(1) .ne. ieubnd1(1)+iuoff1(1)) correct=.false.
        if (ecnt(1) .ne. ieubnd1(1)-ielbnd1(1)+1+iloff1(1)+iuoff1(1)) correct=.false.

        if (clbnd(1) .ne. ielbnd1(1)-iloff1(1)) correct=.false.
        if (cubnd(1) .ne. ieubnd1(1)+iuoff1(1)) correct=.false.
        if (ccnt(1) .ne. ieubnd1(1)-ielbnd1(1)+1+iloff1(1)+iuoff1(1)) correct=.false.

        if (tlbnd(1) .ne. ielbnd1(1)-iloff1(1)) correct=.false.
        if (tubnd(1) .ne. ieubnd1(1)+iuoff1(1)) correct=.false.
        if (tcnt(1) .ne. ieubnd1(1)-ielbnd1(1)+1+iloff1(1)+iuoff1(1)) correct=.false.

     else if (localPet .eq. 2) then
        if (elbnd(1) .ne. ielbnd2(1)-iloff2(1)) correct=.false.
        if (eubnd(1) .ne. ieubnd2(1)+iuoff2(1)) correct=.false.
        if (ecnt(1) .ne. ieubnd2(1)-ielbnd2(1)+1+iloff2(1)+iuoff2(1)) correct=.false.

        if (clbnd(1) .ne. ielbnd2(1)-iloff2(1)) correct=.false.
        if (cubnd(1) .ne. ieubnd2(1)+iuoff2(1)) correct=.false.
        if (ccnt(1) .ne. ieubnd2(1)-ielbnd2(1)+1+iloff2(1)+iuoff2(1)) correct=.false.

        if (tlbnd(1) .ne. ielbnd2(1)-iloff2(1)) correct=.false.
        if (tubnd(1) .ne. ieubnd2(1)+iuoff2(1)) correct=.false.
        if (tcnt(1) .ne. ieubnd2(1)-ielbnd2(1)+1+iloff2(1)+iuoff2(1)) correct=.false.

     else if (localPet .eq. 3) then
        if (elbnd(1) .ne. ielbnd3(1)-iloff3(1)) correct=.false.
        if (eubnd(1) .ne. ieubnd3(1)+iuoff3(1)) correct=.false.
        if (ecnt(1) .ne. ieubnd3(1)-ielbnd3(1)+1+iloff3(1)+iuoff3(1)) correct=.false.

        if (clbnd(1) .ne. ielbnd3(1)-iloff3(1)) correct=.false.
        if (cubnd(1) .ne. ieubnd3(1)+iuoff3(1)) correct=.false.
        if (ccnt(1) .ne. ieubnd3(1)-ielbnd3(1)+1+iloff3(1)+iuoff3(1)) correct=.false.

        if (tlbnd(1) .ne. ielbnd3(1)-iloff3(1)) correct=.false.
        if (tubnd(1) .ne. ieubnd3(1)+iuoff3(1)) correct=.false.
        if (tcnt(1) .ne. ieubnd3(1)-ielbnd3(1)+1+iloff3(1)+iuoff3(1)) correct=.false.

     endif
  endif
end subroutine check1DBnds2x2