subroutine create_grid_from_distgrid(Grid, DistGrid, Memory, Grid_info, &
Dist_info, rc)
!-----------------------------------------------------------------------------
! routine creates a grid from an existing distribution and specifier files
!-----------------------------------------------------------------------------
! arguments
type(ESMF_Grid), intent(inout) :: Grid
type(ESMF_DistGrid), intent(in ) :: DistGrid
type(memory_config), intent(in ) :: Memory
type(grid_specification_record), intent(in ) :: Grid_info
type(dist_specification_record), intent(in ) :: Dist_info
integer, intent(inout) :: rc
! local ESMF types
! local integer variables
integer :: i,j,k
! integer :: l, m
integer, allocatable :: lbnd(:), ubnd(:), maxI(:)
integer :: localDECount, lDE, GridRank
integer, allocatable :: decompOrder(:)
integer :: localrc ! local error status
! local real variables
real(ESMF_KIND_R8), pointer :: coordX2D(:,:), coordY2D(:,:)
real(ESMF_KIND_R8), pointer :: coordX3D(:,:,:), coordY3D(:,:,:)
real(ESMF_KIND_R8), pointer :: coordZ3D(:,:,:)
! initialize return flag
localrc = ESMF_RC_NOT_IMPL
rc = ESMF_RC_NOT_IMPL
!-----------------------------------------------------------------------------
! cludge the distribution info
!-----------------------------------------------------------------------------
allocate( decompOrder(Memory%GridRank) )
do k=1,Memory%DistRank
decompOrder(k) = Dist_info%dsize( Memory%DistOrder(k) )
enddo ! k
! pad the distribution with ones until its the same rank as the grid
do k=Memory%DistRank+1, Memory%GridRank
decompOrder(k) = 1
enddo ! k
!-----------------------------------------------------------------------------
! Create the Grid object from an existing distribution
!-----------------------------------------------------------------------------
select case(Grid_info%grank)
case(2)
! Grid = ESMF_GridCreate(distgrid=DistGrid, gridEdgeLWidth=(/ 0,0 /), &
! gridEdgeUWidth =(/0,0/), rc=localrc)
allocate( maxI(Grid_info%grank) )
maxI = Grid_info%gsize
Grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), maxIndex=maxI, &
regDecomp=decompOrder, &
coordSys=ESMF_COORDSYS_CART, &
indexflag=ESMF_INDEX_GLOBAL, &
gridEdgeLWidth=(/ 0,0 /), &
gridEdgeUWidth =(/0,0/), rc=localrc)
deallocate( maxI )
case(3)
! Grid = ESMF_GridCreate(distgrid=DistGrid, gridEdgeLWidth=(/0,0,0/), &
! gridEdgeUWidth =(/0,0,0/), rc=localrc)
allocate( maxI(Grid_info%grank) )
maxI = Grid_info%gsize
Grid = ESMF_GridCreateNoPeriDim(minIndex=(/1,1,1/), maxIndex=maxI, &
regDecomp=decompOrder, &
coordSys=ESMF_COORDSYS_CART, &
indexflag=ESMF_INDEX_GLOBAL, &
gridEdgeLWidth=(/0,0,0/), &
gridEdgeUWidth =(/0,0,0/), rc=localrc)
deallocate( maxI )
case default
call ESMF_LogSetError(ESMF_FAILURE, msg="error in creating grid from distribution - unsupported rank", &
rcToReturn=rc)
return
end select
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating grid from distribution", &
rcToReturn=rc)) return
!-----------------------------------------------------------------------------
! Get the number of local DEs
!-----------------------------------------------------------------------------
call ESMF_GridGet(grid=Grid, localDECount=localDECount, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting local DE count from grid", &
rcToReturn=rc)) return
!-----------------------------------------------------------------------------
! Get the number of local DEs
!-----------------------------------------------------------------------------
call ESMF_GridGet(grid=Grid, dimCount=GridRank, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting Grid rank from grid", &
rcToReturn=rc)) return
!-----------------------------------------------------------------------------
! allocate arrays to hold the local array bounds
!-----------------------------------------------------------------------------
allocate( lbnd(GridRank) )
allocate( ubnd(GridRank) )
!-----------------------------------------------------------------------------
! Allocate coordinates
!-----------------------------------------------------------------------------
call ESMF_GridAddCoord(Grid, staggerloc=ESMF_STAGGERLOC_CENTER, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error adding coord to grid", &
rcToReturn=rc)) return
do lDE=0,localDECount-1
select case(GridRank)
case(1)
!-------------------------------------------------------------------------
! grid rank = 1
!-------------------------------------------------------------------------
localrc = ESMF_FAILURE
call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=1 not supported ", &
rcToReturn=localrc)
return
case(2)
!-------------------------------------------------------------------------
! grid rank = 2
!-------------------------------------------------------------------------
call ESMF_GridGetCoord(Grid, localDE=lDE, &
staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1, &
computationalLBound=lbnd, computationalUBound=ubnd, &
farrayPtr=coordX2D, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=1 coordinates", &
rcToReturn=rc)) return
call ESMF_GridGetCoord(Grid, localDE=lDE, &
staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2, &
computationalLBound=lbnd, computationalUBound=ubnd, &
farrayPtr=coordY2D, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=2 coordinates", &
rcToReturn=rc)) return
!-------------------------------------------------------------------------
! set coordinates
!-------------------------------------------------------------------------
do j=lbnd(2),ubnd(2)
do i=lbnd(1),ubnd(1)
coordX2D(i,j) = create_coord(i, Grid_info, 1, localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting x coordinates", &
rcToReturn=rc)) return
coordY2D(i,j) = create_coord(j, Grid_info, 2, localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting y coordinates", &
rcToReturn=rc)) return
!--------------------------------------------------------------------
! debug
!--------------------------------------------------------------------
if( debug_flag ) then
print*,'coord values ',i,j,coordX2D(i,j),coordY2D(i,j)
endif
!--------------------------------------------------------------------
! debug
!--------------------------------------------------------------------
enddo ! i loop
enddo ! j loop
!-------------------------------------------------------------------------
! debug
!-------------------------------------------------------------------------
if( debug_flag ) then
print*,'Set Coordinates'
print*,'x/y(1,1)',coordX2D(lbnd(1),lbnd(2)),coordY2D(lbnd(1),lbnd(2))
print*,'x/y(1,n)',coordX2D(lbnd(1),ubnd(2)),coordY2D(lbnd(1),ubnd(2))
print*,'x/y(n,n)',coordX2D(ubnd(1),ubnd(2)),coordY2D(ubnd(1),ubnd(2))
endif
!-------------------------------------------------------------------------
! debug
!-------------------------------------------------------------------------
case(3)
!-------------------------------------------------------------------------
! grid rank = 3
!-------------------------------------------------------------------------
call ESMF_GridGetCoord(Grid, localDE=lDE, &
staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=1, &
computationalLBound=lbnd, computationalUBound=ubnd, &
farrayPtr=coordX3D, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=1 coordinates", &
rcToReturn=rc)) return
call ESMF_GridGetCoord(Grid, localDE=lDE, &
staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=2, &
computationalLBound=lbnd, computationalUBound=ubnd, &
farrayPtr=coordY3D, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=2 coordinates", &
rcToReturn=rc)) return
call ESMF_GridGetCoord(Grid, localDE=lDE, &
staggerLoc=ESMF_STAGGERLOC_CENTER, coordDim=3, &
computationalLBound=lbnd, computationalUBound=ubnd, &
farrayPtr=coordZ3D, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting grid=3 coordinates", &
rcToReturn=rc)) return
!-------------------------------------------------------------------------
! set coordinates
!-------------------------------------------------------------------------
do k=lbnd(3),ubnd(3)
do j=lbnd(2),ubnd(2)
do i=lbnd(1),ubnd(1)
coordX3D(i,j,k) = create_coord(i, Grid_info, 1, localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting x coordinates", &
rcToReturn=rc)) return
coordY3D(i,j,k) = create_coord(j, Grid_info, 2, localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting y coordinates", &
rcToReturn=rc)) return
coordZ3D(i,j,k) = create_coord(k, Grid_info, 3, localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error getting z coordinates", &
rcToReturn=rc)) return
enddo ! i loop
enddo ! j loop
enddo ! k loop
case(4)
!-------------------------------------------------------------------------
! grid rank = 4
!-------------------------------------------------------------------------
localrc = ESMF_FAILURE
call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=4 not supported ", &
rcToReturn=localrc)
return
case(5)
!-------------------------------------------------------------------------
! grid rank = 5
!-------------------------------------------------------------------------
localrc = ESMF_FAILURE
call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=5 not supported ", &
rcToReturn=localrc)
return
case(6)
!-------------------------------------------------------------------------
! grid rank = 6
!-------------------------------------------------------------------------
localrc = ESMF_FAILURE
call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=6 not supported ", &
rcToReturn=localrc)
return
case(7)
!-------------------------------------------------------------------------
! grid rank = 7
!-------------------------------------------------------------------------
localrc = ESMF_FAILURE
call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank=7 not supported ", &
rcToReturn=localrc)
return
case default
!-------------------------------------------------------------------------
! error
!-------------------------------------------------------------------------
localrc = ESMF_FAILURE
call ESMF_LogSetError(ESMF_FAILURE, msg="Grid rank not between 1 & 7",&
rcToReturn=localrc)
return
end select
enddo ! lDE
!-----------------------------------------------------------------------------
! clean up
!-----------------------------------------------------------------------------
deallocate( lbnd, ubnd)
deallocate( decompOrder )
!-----------------------------------------------------------------------------
rc = ESMF_SUCCESS
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
end subroutine create_grid_from_distgrid