subroutine create_distribution(Memory, DistRecord, GridRecord, DistGrid,VM,rc)
!-----------------------------------------------------------------------------
! routine creates a single distribution from specifier files
!
!-----------------------------------------------------------------------------
! arguments
type(memory_config), intent(in ) :: Memory
type(dist_specification_record), intent(in ) :: DistRecord
type(grid_specification_record), intent(in ) :: GridRecord
type(ESMF_DistGrid), intent( out) :: DistGrid
type(ESMF_VM), intent(in ) :: VM
integer, intent(inout) :: rc
! local parameters
integer :: localrc ! local error status
integer :: allocRcToTest
! local integer variables
integer :: k, nconnect
integer, allocatable :: BIndx(:), EIndx(:)
integer, allocatable :: decompOrder(:)
type(ESMF_Decomp_Flag), allocatable :: decompType(:)
type(ESMF_DistGridConnection), allocatable :: connectionList(:)
integer, allocatable :: positionVector(:),orientationVector(:)
! local logicals
logical :: noconnections
! initialize return flag
localrc = ESMF_RC_NOT_IMPL
rc = ESMF_RC_NOT_IMPL
!-----------------------------------------------------------------------------
! allocate input arrays with size of the grid rank - since dist rank is now
! equal to the size of Grid Rank, with any dist missing dimensions set to one.
!-----------------------------------------------------------------------------
allocate( BIndx(Memory%GridRank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" BIndx in create_distribution", rcToReturn=rc)) then
endif
allocate( EIndx(Memory%GridRank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" EIndx in create_distribution", rcToReturn=rc)) then
endif
allocate( decompOrder(Memory%GridRank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" decompOrder in create_distribution", rcToReturn=rc)) then
endif
allocate( decompType(Memory%GridRank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="Type "// &
" decompType in create_distribution", rcToReturn=rc)) then
endif
allocate( connectionList(1), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" connectionList in create_distribution", rcToReturn=rc)) then
endif
!-----------------------------------------------------------------------------
! fill input arrays:
! EIndx - filled with the grid sizes as specified by the grid specifier
! files, but in the order indicated by the problem descriptor strings
! decompOrder - filled with distribution sizes as specified by the dist
! specifier files, but in the order indicated by the PDStrings
! decompType - set to either ESMF_DECOMP_BALANCED or ESMF_DECOMP_CYCLIC
! depending on how its indicated in the problem descriptor string
!-----------------------------------------------------------------------------
nconnect = 0 ! assume number of connections is zero
! print*,' memory rank ',Memory%memRank
! print*,' grid rank',Memory%GridRank
! fill the array with gridRank number of elements
do k=1,Memory%GridRank
BIndx(k) = 1
EIndx(k) = GridRecord%gsize( Memory%GridOrder(k) )
enddo ! k
! if there are additional memory elements fill them with what is left over
! if( Memory%memRank > Memory%GridRank ) then
! do k=Memory%GridRank+1,Memory%memRank
! EIndx(k) = GridRecord%gsize( Memory%GridOrder(k) )
! enddo ! k
! endif
! pad the distribution with ones until its the same rank as the grid
do k=1,Memory%DistRank
decompOrder(k) = DistRecord%dsize( Memory%DistOrder(k) )
decompType(k) = ESMF_DECOMP_BALANCED
enddo ! k
do k=Memory%DistRank+1, Memory%GridRank
decompOrder(k) = 1
decompType(k) = ESMF_DECOMP_BALANCED
enddo ! k
do k=1, Memory%DistRank
! assume the decomposition type is block unless block-cyclic is specified
if( trim(adjustL(Memory%DistType(k)%string)) == "C" ) then
decompType(k) = ESMF_DECOMP_CYCLIC
endif
! look for periodic boundary conditions specified in the grid specifier file
if( pattern_query(GridRecord%gtype(Memory%GridOrder(k))%string, &
"_periodic") /= 0 .or. pattern_query( &
GridRecord%gtype(Memory%GridOrder(k))%string,"_PERIODIC") /= 0) then
nconnect = nconnect + 1
endif
enddo ! k
! print*,' mem rank ',Memory%memRank
! do k=1,Memory%GridRank
! print*,k,' order/size ',Memory%GridOrder(k),decompOrder(k),EIndx(k)
! enddo
! print*,' '
! print*,'record size dist ',DistRecord%dsize(1),DistRecord%dsize(2)
!-----------------------------------------------------------------------------
! check for a connected domain - set connection call arguments
!-----------------------------------------------------------------------------
if( nconnect == 1 ) then
! singlely periodic domain
noconnections = .FALSE.
! workspace
allocate( positionVector(Memory%memRank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" positionVector in create_distribution", rcToReturn=rc)) then
endif
allocate( orientationVector(Memory%memRank), stat=allocRcToTest )
if (ESMF_LogFoundAllocError(allocRcToTest, msg="integer variable "// &
" orientationVector in create_distribution", rcToReturn=rc)) then
endif
do k=1, Memory%GridRank
positionVector(k) = 0
orientationVector(k) = k
if( pattern_query(GridRecord%gtype(Memory%GridOrder(k))%string, &
"_periodic") /= 0 .or. pattern_query( &
GridRecord%gtype(Memory%GridOrder(k))%string,"_PERIODIC") /= 0) then
positionVector(k) = EIndx(k)
endif
enddo
elseif( nconnect > 1 ) then
! multiply periodic domain
noconnections = .FALSE.
! multiply connected domains are not currently supported
else
! no tile connections specified
noconnections = .TRUE.
endif
!-----------------------------------------------------------------------------
! create the distgrid
!-----------------------------------------------------------------------------
if( noconnections ) then
! no connection
distgrid = ESMF_DistGridCreate(minIndex=BIndx, maxIndex=EIndx, &
regDecomp=decompOrder, decompflag=decompType, &
vm=VM, rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating distgrid", &
rcToReturn=rc)) return
!---------------------------------------------------------------------------
! debug
!---------------------------------------------------------------------------
if( debug_flag ) then
print*,'==============Dist Grid Create info============= '
print*,' Min index ', BIndx
print*,' Max index ', EIndx
print*,' Decomp Order ', decompOrder
print*,' '
endif
!---------------------------------------------------------------------------
! debug
!---------------------------------------------------------------------------
else
! singlely periodic connection
call ESMF_DistGridConnectionSet(connection=connectionList(1), &
tileIndexA=1, tileIndexB=1, &
positionVector=positionVector, &
orientationVector=orientationVector, &
rc=localrc)
distgrid = ESMF_DistGridCreate(minIndex=BIndx, maxIndex=EIndx, &
regDecomp=decompOrder, decompflag=decompType, &
connectionList=connectionList,rc=localrc)
if (CheckError(checkpoint, __LINE__, __FILE__, localrc,"error creating distgrid", &
rcToReturn=rc)) return
deallocate( positionVector,orientationVector )
endif
!-----------------------------------------------------------------------------
! clean up
!-----------------------------------------------------------------------------
deallocate( BIndx, EIndx )
deallocate( decompOrder, decompType )
deallocate( connectionList )
!-----------------------------------------------------------------------------
rc = ESMF_SUCCESS
!-----------------------------------------------------------------------------
!-----------------------------------------------------------------------------
end subroutine create_distribution