ESMFIO_FieldAccess Subroutine

private subroutine ESMFIO_FieldAccess(IOComp, field, action, keywordEnforcer, iofmt, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_GridComp), intent(in) :: IOComp
type(ESMF_Field), intent(in) :: field
character(len=*), intent(in) :: action
type(ESMF_KeywordEnforcer), optional :: keywordEnforcer
type(ESMF_IOFmt_Flag), intent(in), optional :: iofmt
integer, intent(out), optional :: rc

Source Code

  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