subroutine create_array(Array, DistGrid, Memory, Grid, rc)
!-----------------------------------------------------------------------------
! routine creates a single distribution from specifier files
!
!-----------------------------------------------------------------------------
! arguments
type(ESMF_Array), intent( out) :: Array
type(ESMF_DistGrid), intent(in ) :: DistGrid
type(memory_config), intent(in ) :: Memory
type(grid_specification_record), intent(in ) :: Grid
integer, intent(inout) :: rc
! local ESMF types
type(ESMF_ArraySpec) :: ArraySpec
! local integer variables
integer :: irank, k, tensorsize
integer, allocatable :: haloL(:), haloR(:)
integer, allocatable :: top(:), bottom(:)
integer :: localrc ! local error status
integer :: allocRcToTest
! local logicals
logical :: nohaloflag
! initialize return flag
localrc = ESMF_RC_NOT_IMPL
rc = ESMF_RC_NOT_IMPL
!-----------------------------------------------------------------------------
! set the dimensionality of actual data storage to the memory size specified
! by the problem descriptor string
!-----------------------------------------------------------------------------
call ESMF_ArraySpecSet(ArraySpec, typekind=ESMF_TYPEKIND_R8, &
rank=Memory%memRank, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating ArraySpecSet", &
rcToReturn=rc)) return
!-----------------------------------------------------------------------------
! sanity check, make certain there are nonzero values for all distgrid dimensions
!-----------------------------------------------------------------------------
! do k=1, Memory%DistRank
! if( map(k) == 0 .or. map(k) > Memory%MemRank ) then
! print*,'error - the inversion of DistOrder has failed',map(k)
! endif
! enddo
! ! drs debug
! print*,' distgridto arraymap ',map
! drs debug
!-----------------------------------------------------------------------------
! determine if halo is present
!-----------------------------------------------------------------------------
nohaloflag = .true.
do irank=1, Memory%GridRank
if( Memory%HaloL(irank) /= 0 ) nohaloflag = .false.
if( Memory%HaloR(irank) /= 0 ) nohaloflag = .false.
enddo ! irank
!-----------------------------------------------------------------------------
! if no halo specified, create array from ArraySpec object
!-----------------------------------------------------------------------------
if( nohaloflag ) then
! print*,' no halos specified '
!--------------------------------------------------------------------------
! assume that the GridRank=DistGridRank, by construction if the
! distGridRank < GridRank, we pad the distGrid with ones so that they are
! the same rank.
!
! next if the MemoryRank = GridRank, there are no tensor dimensions (i.e.
! dimensions both not distributed nor associated with a grid), thus the
! undistLBound and undistUBound arguments need not be specified.
!--------------------------------------------------------------------------
if( Memory%memRank == Memory%GridRank ) then
!-----------------------------------------------------------------------
! Memory Rank = Grid Rank
!-----------------------------------------------------------------------
! print*,'Memory Rank = Grid Rank ',Memory%memRank, ' = ', Memory%GridRank
Array = ESMF_ArrayCreate(arrayspec=ArraySpec, distgrid=DistGrid, &
indexflag=ESMF_INDEX_GLOBAL, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating non-haloed ESMF " // &
"Array with no tensor dimensions", rcToReturn=rc)) return
elseif( Memory%memRank > Memory%GridRank ) then
!-----------------------------------------------------------------------
! Memory Rank > Grid Rank, so there are tensor dimensions
!-----------------------------------------------------------------------
tensorsize = Memory%memRank-Memory%GridRank
allocate( top(tensorsize), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" top in create_array", rcToReturn=rc)) then
endif
allocate( bottom(tensorsize), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" bottom in create_array", rcToReturn=rc)) then
endif
print*,'Tensor dims ',tensorsize,' - Memory Rank > Grid Rank ', &
Memory%memRank, Memory%GridRank
!-----------------------------------------------------------------------
! specify the bounds of the undistributed dimension(s).
!-----------------------------------------------------------------------
do k=Grid%grank,Grid%grank-tensorsize+1,-1
bottom(k) = 1
top(k) = Grid%gsize( Memory%GridOrder(k) )
enddo ! k
Array = ESMF_ArrayCreate(arrayspec=ArraySpec, distgrid=DistGrid, &
indexflag=ESMF_INDEX_GLOBAL, &
undistLBound=bottom, undistUBound=top, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating non-haloed ESMF " // &
"Array with tensor dimensions", rcToReturn=rc)) return
deallocate( top, bottom )
else
print*,'error - Memory Rank < Grid Rank'
call ESMF_LogSetError( ESMF_FAILURE, msg="memory rank < Grid rank not"// &
"supported ",rcToReturn=localrc)
return
endif
else
!-----------------------------------------------------------------------------
! else if halo is specified, create an array with halo padding by setting
! totalLWith and totalRwidth
!-----------------------------------------------------------------------------
allocate( haloL(Memory%memRank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" haloL in create_array", rcToReturn=rc)) then
endif
allocate( haloR(Memory%memRank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" haloR in create_array", rcToReturn=rc)) then
endif
do k=1,Memory%GridRank
haloL(k) = Memory%HaloL(k)
haloR(k) = Memory%HaloR(k)
enddo
! padd additional values so that array sizes matches memory rank
do k=Memory%GridRank+1,Memory%memRank
haloL(k) = 0
haloR(k) = 0
enddo
!--------------------------------------------------------------------------
! assume that the GridRank=DistGridRank, by construction if the
! distGridRank < GridRank, we pad the distGrid with ones so that they are
! the same rank.
!
! next if the MemoryRank = GridRank, there are no tensor dimensions (i.e.
! dimensions both not distributed nor associated with a grid), thus the
! undistLBound and undistUBound arguments need not be specified.
!--------------------------------------------------------------------------
if( Memory%memRank == Memory%GridRank ) then
!-----------------------------------------------------------------------
! Memory Rank = Grid Rank
!-----------------------------------------------------------------------
! print*,'Memory Rank = Grid Rank ',Memory%memRank, Memory%GridRank
Array = ESMF_ArrayCreate(arrayspec=ArraySpec, distgrid=DistGrid, &
totalLWidth=HaloL, totalUWidth=HaloR, &
indexflag=ESMF_INDEX_GLOBAL, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating non-haloed ESMF " // &
"Array with no tensor dimensions", rcToReturn=rc)) return
elseif( Memory%memRank > Memory%GridRank ) then
!-----------------------------------------------------------------------
! Memory Rank > Grid Rank, so there are tensor dimensions
!-----------------------------------------------------------------------
tensorsize = Memory%memRank-Memory%GridRank
allocate( top(tensorsize), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" top in create_array", rcToReturn=rc)) then
endif
allocate( bottom(tensorsize), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" bottom in create_array", rcToReturn=rc)) then
endif
! print*,'Tensor dims ',tensorsize,' - Memory Rank > Grid Rank ', &
! Memory%memRank, Memory%GridRank
!-----------------------------------------------------------------------
! specify the bounds of the undistributed dimension(s).
!-----------------------------------------------------------------------
do k=Grid%grank,Grid%grank-tensorsize+1,-1
bottom(k) = 1
top(k) = Grid%gsize( Memory%GridOrder(k) )
enddo ! k
Array = ESMF_ArrayCreate(arrayspec=ArraySpec, distgrid=DistGrid, &
totalLWidth=HaloL, totalUWidth=HaloR, &
indexflag=ESMF_INDEX_GLOBAL, &
undistLBound=bottom, undistUBound=top, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating haloed ESMF " // &
"Array with tensor dimensions", rcToReturn=rc)) return
deallocate( top, bottom )
else
! print*,'error - Memory Rank < Grid Rank'
call ESMF_LogSetError( ESMF_FAILURE, msg="memory rank < Grid rank not"// &
"supported ",rcToReturn=localrc)
return
endif
!--------------------------------------------------------------------------
! clean up
!--------------------------------------------------------------------------
deallocate( haloL, haloR )
endif
!-----------------------------------------------------------------------------
rc = ESMF_SUCCESS
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
end subroutine create_array