function ESMFIO_Create(grid, keywordEnforcer, rc)
type(ESMF_Grid), intent(in) :: grid
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
integer, intent(out), optional :: rc
type(ESMF_GridComp) :: ESMFIO_Create
! -- local variables
integer :: localrc
integer :: i, localDe, localDeCount, localpe, peCount, npe
integer :: tile, tileCount
integer, dimension(:), allocatable :: localTile, tileToPet, pes, recvpes
type(ESMF_GridComp) :: IOComp, taskComp
type(ESMF_VM) :: vm
type(ioWrapper) :: is
type(ioData), pointer :: IO => null()
! -- begin
if (present(rc)) rc = ESMF_SUCCESS
nullify(IO)
call ESMF_GridGet(grid, localDeCount=localDeCount, tileCount=tileCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_VMGetCurrent(vm, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_VMGet(vm, localPet=localpe, petCount=peCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
allocate(recvpes(peCount), pes(peCount), stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, &
msg="Unable to allocate internal memory for ESMFIO initialization", &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
pes = 0
pes(localpe+1) = -localDeCount
call ESMF_VMAllReduce(vm, pes, recvpes, peCount, ESMF_REDUCE_SUM, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
pes = -1
npe = 0
do i = 1, peCount
if (recvpes(i) < 0) then
npe = npe + 1
pes(npe) = i - 1
end if
end do
! -- create IO component on this PET
IOComp = ESMF_GridCompCreate(name="io_comp", petList=pes(1:npe), rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
deallocate(recvpes, pes, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_GridCompSetServices(IOComp, IOCompSetServices, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
if (ESMF_GridCompIsPetLocal(IOComp)) then
allocate(IO, stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, &
msg="Unable to allocate internal memory for ESMFIO initialization", &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
allocate(IO % IOLayout(0:localDeCount-1), stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, &
msg="Unable to allocate internal memory for ESMFIO initialization", &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
is % IO => IO
else
is % IO => null()
end if
! -- set internal state for IO component
call ESMF_GridCompSetInternalState(IOComp, is, localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
! -- save grid object in IO component
call ESMF_GridCompSet(IOComp, grid=grid, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
allocate(localTile(tileCount), tileToPet(tileCount*peCount), stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, &
msg="Unable to allocate internal memory for ESMFIO initialization", &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
! -- store which tiles are assigned to this PET
localTile = -1
do localDe = 0, localDeCount-1
call ESMF_GridGet(grid, localDE=localDe, tile=tile, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
localTile(tile) = localpe
is % IO % IOLayout(localDe) % tile = tile
is % IO % IOLayout(localDe) % ncid = 0
end do
tileToPet = -1
call ESMF_VMAllGather(vm, localTile, tileToPet, tileCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
deallocate(localTile, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
! -- extract the list of PETs assigned to each tile and create MPI groups
allocate(pes(peCount), stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, &
msg="Unable to allocate internal memory for ESMFIO initialization", &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
! -- gather PET list for each tile and create tile-specific VMs
pes = -1
do tile = 1, tileCount
npe = 0
do i = tile, tileCount*peCount, tileCount
if (tileToPet(i) > -1) then
npe = npe + 1
pes(npe) = tileToPet(i)
end if
end do
taskComp = ESMF_GridCompCreate(petList=pes(1:npe), rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_GridCompSetServices(taskComp, IOCompSetServices, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
do localDe = 0, localDeCount-1
call ESMF_GridGet(grid, localDE=localDe, tile=i, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
if (tile == i) then
! -- create new VM for tile
is % IO % IOLayout(localDe) % taskComp = taskComp
end if
end do
end do
deallocate(pes, tileToPet, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
! -- flag PET if local I/O must be performed
do localDe = 0, localDeCount - 1
call ESMF_GridCompGet(is % IO % IOLayout(localDe) % taskComp, vm=vm, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_VMGet(vm, localPet=localpe, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
is % IO % IOLayout(localDe) % localIOflag = (localpe == 0)
end do
ESMFIO_Create = IOComp
end function ESMFIO_Create