subroutine ESMFIO_FieldAccess(IOComp, field, action, keywordEnforcer, &
iofmt, rc)
type(ESMF_GridComp), intent(in) :: IOComp
type(ESMF_Field), intent(in) :: field
character(len=*), intent(in) :: action
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
type(ESMF_IOFmt_flag), intent(in), optional :: iofmt
integer, intent(out), optional :: rc
! -- local variables
integer :: localrc
integer :: localDe, localDeCount, rank
integer :: de, deCount, dimCount, tile, tileCount
integer, dimension(:), allocatable :: deToTileMap, localDeToDeMap
integer, dimension(:,:), allocatable :: minIndexPDe, maxIndexPDe
integer, dimension(:,:), allocatable :: minIndexPTile, maxIndexPTile
type(ioWrapper) :: is
type(ESMF_Grid) :: grid, iogrid
type(ESMF_DistGrid) :: distgrid
type(ESMF_Array) :: array
type(ESMF_VM) :: vm
type(ESMF_GeomType_flag) :: geomtype
type(ESMF_StaggerLoc) :: staggerloc
type(ESMF_TypeKind_Flag) :: typekind
! -- begin
if (present(rc)) rc = ESMF_SUCCESS
if (.not.ESMF_GridCompIsPetLocal(IOComp)) return
call ESMF_GridCompGet(IOComp, grid=iogrid, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_FieldGet(field, geomtype=geomtype, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
if (geomtype == ESMF_GEOMTYPE_GRID) then
call ESMF_FieldGet(field, grid=grid, rank=rank, &
staggerloc=staggerloc, typekind=typekind, localDeCount=localDeCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
if (grid /= iogrid) then
#if 0
call ESMF_LogSetError(ESMF_RC_NOT_IMPL, &
msg="I/O fields and I/O component must be defined on the same grid", &
ESMF_CONTEXT, rcToReturn=rc)
return ! bail out
#else
call ESMF_LogWrite("I/O field and I/O component may not be on same grid", &
ESMF_LOGMSG_WARNING, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
#endif
end if
if (rank /= 2) then
call ESMF_LogSetError(ESMF_RC_NOT_IMPL, &
msg="Only 2D fields are supported.", &
ESMF_CONTEXT, rcToReturn=rc)
return ! bail ou
end if
! -- get domain decomposition
call ESMF_GridGet(grid, staggerloc, distgrid=distgrid, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_DistGridGet(distgrid, deCount=deCount, dimCount=dimCount, &
tileCount=tileCount, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
allocate(minIndexPDe(dimCount, deCount), maxIndexPDe(dimCount, deCount), &
minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount), &
deToTileMap(deCount), localDeToDeMap(localDeCount), stat=localrc)
if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_DistGridGet(distgrid, &
minIndexPDe=minIndexPDe, maxIndexPDe=maxIndexPDe, &
minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_FieldGet(field, array=array, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_ArrayGet(array, deToTileMap=deToTileMap, &
localDeToDeMap=localDeToDeMap, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
call ESMF_GridCompGetInternalState(IOComp, is, localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
do localDe = 0, localDeCount-1
de = localDeToDeMap(localDe+1) + 1
tile = deToTileMap(de)
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
select case (trim(action))
case('r','read')
call IORead2D(vm, field, &
minIndexPDe(:,de), maxIndexPDe(:,de), &
minIndexPTile(:,tile), maxIndexPTile(:,tile), &
iofmt=iofmt, localDe=localDe, &
ncid=is % IO % IOLayout(localDe) % ncid, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
case('w','write')
call IOWrite2D(vm, field, &
minIndexPDe(:,de), maxIndexPDe(:,de), &
minIndexPTile(:,tile), maxIndexPTile(:,tile), &
iofmt=iofmt, localDe=localDe, &
ncid=is % IO % IOLayout(localDe) % ncid, &
rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
case default
! -- do nothing
end select
end do
deallocate(minIndexPDe, maxIndexPDe, minIndexPTile, maxIndexPTile, &
deToTileMap, localDeToDeMap, stat=localrc)
if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
ESMF_CONTEXT, rcToReturn=rc)) return ! bail out
else
call ESMF_LogSetError(ESMF_RC_NOT_IMPL, &
msg="I/O fields can only be defined on Grid objects.", &
ESMF_CONTEXT, rcToReturn=rc)
return ! bail ou
end if
end subroutine ESMFIO_FieldAccess