function ESMF_GridCreateDistgridIrreg(dimCount, &
minIndex, maxIndex, &
countsPerDEDim1,countsPerDeDim2, &
countsPerDEDim3, &
indexflag, petMap, connList, rc)
!
! !RETURN VALUE:
type(ESMF_DistGrid) :: ESMF_GridCreateDistgridIrreg
!
! !ARGUMENTS:
integer, intent(in) :: dimCount
integer, intent(in) :: minIndex(:)
integer, intent(in) :: maxIndex(:)
integer, intent(in) :: countsPerDEDim1(:)
integer, intent(in) :: countsPerDEDim2(:)
integer, intent(in), optional :: countsPerDEDim3(:)
type(ESMF_Index_Flag), intent(in), optional :: indexflag
integer, intent(in), optional :: petMap(:,:,:)
type(ESMF_DistgridConnection), intent(in), optional :: connList(:)
integer, intent(out), optional :: rc
!
! !DESCRIPTION:
!
! This is an internal method to create a single tile, irregularly distributed distgrid
! (see Figure \ref{fig:GridDecomps}).
! To specify the irregular distribution, the user passes in an array
! for each grid dimension, where the length of the array is the number
! of DEs in the dimension. Up to three dimensions can be specified,
! using the countsPerDEDim1, countsPerDEDim2, countsPerDEDim3 arguments.
! The index of each array element corresponds to a DE number. The
! array value at the index is the number of grid cells on the DE in
! that dimension. The dimCount of the grid is equal to the number of
! countsPerDEDim arrays that are specified.
!
! Section \ref{example:2DIrregUniGrid} shows an example
! of using this method to create a 2D Grid with uniformly spaced
! coordinates. This creation method can also be used as the basis for
! grids with rectilinear coordinates or curvilinear coordinates.
!
! The arguments are:
! \begin{description}
! \item[{minIndex}]
! Tuple to start the index ranges at. If not present, defaults
! to /1,1,1,.../.
! \item[{maxIndex}]
! Tuple to end the index ranges at.
! \item[{countsPerDEDim1}]
! This arrays specifies the number of cells per DE for index dimension 1
! for the exclusive region (the center stagger location).
! \item[{countsPerDEDim2}]
! This array specifies the number of cells per DE for index dimension 2
! for the exclusive region (center stagger location).
! \item[{[countsPerDEDim3]}]
! This array specifies the number of cells per DE for index dimension 3
! for the exclusive region (center stagger location).
! If not specified then grid is 2D.
! \item[{[indexflag]}]
! Indicates the indexing scheme to be used in the new Grid. Please see
! Section~\ref{const:indexflag} for the list of options. If not present,
! defaults to ESMF\_INDEX\_DELOCAL.
! \item[{[petMap]}]
! \begin{sloppypar}
! Sets the mapping of pets to the created DEs. This 3D
! should be of size size(countsPerDEDim1) x size(countsPerDEDim2) x
! size(countsPerDEDim3). If countsPerDEDim3 isn't present, then
! the last dimension is of size 1.
! \end{sloppypar}
! \item[{[rc]}]
! Return code; equals {\tt ESMF\_SUCCESS} if there are no errors.
! \end{description}
!
!EOPI
type(ESMF_DistGrid) :: distgrid
type(ESMF_DELayout) :: delayout
integer, pointer :: petList(:)
integer :: localrc
integer :: i,maxSizeDEDim
integer, pointer :: deDimCount(:)
integer, pointer :: countsPerDEDim1Local(:)
integer, pointer :: countsPerDEDim2Local(:)
integer, pointer :: countsPerDEDim3Local(:)
integer, pointer :: deBlockList(:,:,:),minPerDEDim(:,:),maxPerDEDim(:,:)
integer :: deCount
integer :: d,i1,i2,i3,k
integer :: top
! Initialize return code; assume failure until success is certain
localrc = ESMF_RC_NOT_IMPL
if (present(rc)) rc = ESMF_RC_NOT_IMPL
! error checking
if (present(petMap)) then
if (dimCount > 2) then
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= size(countsPerDEDim3))) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
else
if ((size(petMap,1) /= size(countsPerDEDim1)) .or. &
(size(petMap,2) /= size(countsPerDEDim2)) .or. &
(size(petMap,3) /= 1)) then
call ESMF_LogSetError(rcToCheck=ESMF_RC_ARG_SIZE, &
msg="- petMap wrong size in one or more dimensions", &
ESMF_CONTEXT, rcToReturn=rc)
return
endif
endif
endif
! Copy vales for countsPerDEDim --------------------------------------------
allocate(countsPerDEDim1Local(size(countsPerDEDim1)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim1Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim1Local=countsPerDEDim1
allocate(countsPerDEDim2Local(size(countsPerDEDim2)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim2Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim2Local=countsPerDEDim2
if (dimCount > 2) then
allocate(countsPerDEDim3Local(size(countsPerDEDim3)), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating countsPerDEDim3Local", &
ESMF_CONTEXT, rcToReturn=rc)) return
countsPerDEDim3Local=countsPerDEDim3
endif
! Setup deBlockList for DistGrid ------------------------------------------------
! count de blocks
deCount=1
deCount=deCount*size(countsPerDEDim1Local)
deCount=deCount*size(countsPerDEDim2Local)
if (dimCount > 2) then
deCount=deCount*size(countsPerDEDim3Local)
endif
! Calc the max size of a DEDim
maxSizeDEDim=1
if (size(countsPerDEDim1Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim1Local)
endif
if (size(countsPerDEDim2Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim2Local)
endif
if (dimCount > 2) then
if (size(countsPerDEDim3Local) > maxSizeDEDim) then
maxSizeDEDim=size(countsPerDEDim3Local)
endif
endif
! generate deblocklist
allocate(maxPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(minPerDEDim(dimCount,maxSizeDEDim), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating minPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
allocate(deDimCount(dimCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating maxPerDEDim", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Calc the maximum end of each DE in a Dim, and the size of each DEDim
d=1
deDimCount(d)=size(countsPerDEDim1Local)
minPerDeDim(d,1)=minIndex(d)
maxPerDeDim(d,1)=minIndex(d)+countsPerDEDim1Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim1Local(i)-1
enddo
d=2
deDimCount(d)=size(countsPerDEDim2Local)
minPerDeDim(d,1)=minIndex(d)
maxPerDeDim(d,1)=minIndex(d)+countsPerDEDim2Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim2Local(i)-1
enddo
if (dimCount > 2) then
d=3
deDimCount(d)=size(countsPerDEDim3Local)
minPerDeDim(d,1)=minIndex(d)
maxPerDeDim(d,1)=minIndex(d)+countsPerDEDim3Local(1)-1
do i=2,deDimCount(d)
minPerDEDim(d,i)=maxPerDEDim(d,i-1)+1
maxPerDEDim(d,i)=minPerDEDim(d,i)+countsPerDEDim3Local(i)-1
enddo
endif
! allocate deblocklist
allocate(deBlockList(dimCount,2,deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating deBlockList", &
ESMF_CONTEXT, rcToReturn=rc)) return
! Fill in DeBlockList
if (dimCount == 2) then
k=1
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
k=k+1
enddo
enddo
else if (dimCount == 3) then
k=1
do i3=1,deDimCount(3)
do i2=1,deDimCount(2)
do i1=1,deDimCount(1)
deBlockList(1,1,k)=minPerDEDim(1,i1)
deBlockList(1,2,k)=maxPerDEDim(1,i1)
deBlockList(2,1,k)=minPerDEDim(2,i2)
deBlockList(2,2,k)=maxPerDEDim(2,i2)
deBlockList(3,1,k)=minPerDEDim(3,i3)
deBlockList(3,2,k)=maxPerDEDim(3,i3)
k=k+1
enddo
enddo
enddo
endif
! do i=1,deCount
! write(*,*) i,"min=",deBlockList(:,1,i)," max=",deBlockList(:,2,i)
! enddo
! Process PetMap --------------------------------------------------------------
if (present(petMap)) then
!! Allocate petList
allocate(petList(deCount), stat=localrc)
if (ESMF_LogFoundAllocError(localrc, msg="Allocating petList", &
ESMF_CONTEXT, rcToReturn=rc)) return
!! copy petMap to petList
if (dimCount > 2) then
k=1
do i3=1,size(countsPerDEDim3Local)
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
else
k=1
do i3=1,1
do i2=1,size(countsPerDEDim2Local)
do i1=1,size(countsPerDEDim1Local)
petList(k)=petMap(i1,i2,i3)
k=k+1
enddo
enddo
enddo
endif
!! create delayout from the petList
delayout=ESMF_DELayoutCreate(petMap=petList,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
!! Get rid of list
deallocate(petList)
else
!! create a default delayout
delayout=ESMF_DELayoutCreate(deCount=deCount,rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
endif
! Create DistGrid --------------------------------------------------------------
ESMF_GridCreateDistgridIrreg=ESMF_DistGridCreate(minIndex=minIndex, maxIndex=maxIndex, &
deBlockList=deBlockList, delayout=delayout, indexflag=indexflag, &
connectionList=connList, rc=localrc)
if (ESMF_LogFoundError(localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return
! Clean up memory
deallocate(maxPerDEDim)
deallocate(minPerDEDim)
deallocate(deDimCount)
deallocate(deBlockList)
deallocate(countsPerDEDim1Local)
deallocate(countsPerDEDim2Local)
if (dimCount > 2) then
deallocate(countsPerDEDim3Local)
endif
! Return successfully
if (present(rc)) rc = ESMF_SUCCESS
end function ESMF_GridCreateDistgridIrreg