IOWrite2D Subroutine

private subroutine IOWrite2D(vm, field, minIndexPDe, maxIndexPDe, minIndexPTile, maxIndexPTile, keywordEnforcer, fileName, iofmt, localDe, ncid, rc)

Arguments

Type IntentOptional Attributes Name
type(ESMF_VM), intent(in) :: vm
type(ESMF_Field), intent(in) :: field
integer, intent(in), dimension(:) :: minIndexPDe
integer, intent(in), dimension(:) :: maxIndexPDe
integer, intent(in), dimension(:) :: minIndexPTile
integer, intent(in), dimension(:) :: maxIndexPTile
type(ESMF_KeywordEnforcer), optional :: keywordEnforcer
character(len=*), intent(in), optional :: fileName
type(ESMF_IOFmt_Flag), intent(in), optional :: iofmt
integer, intent(in), optional :: localDe
integer, intent(in), optional :: ncid
integer, intent(out), optional :: rc

Calls

proc~~iowrite2d~~CallsGraph proc~iowrite2d IOWrite2D esmf_fieldget esmf_fieldget proc~iowrite2d->esmf_fieldget interface~esmf_vmget ESMF_VMGet proc~iowrite2d->interface~esmf_vmget interface~esmf_vmreduce ESMF_VMReduce proc~iowrite2d->interface~esmf_vmreduce proc~esmf_logfoundallocerror ESMF_LogFoundAllocError proc~iowrite2d->proc~esmf_logfoundallocerror proc~esmf_logfounddeallocerror ESMF_LogFoundDeallocError proc~iowrite2d->proc~esmf_logfounddeallocerror proc~esmf_logfounderror ESMF_LogFoundError proc~iowrite2d->proc~esmf_logfounderror proc~esmf_logseterror ESMF_LogSetError proc~iowrite2d->proc~esmf_logseterror proc~esmf_vmgetdefault ESMF_VMGetDefault interface~esmf_vmget->proc~esmf_vmgetdefault proc~esmf_vmgetpetspecific ESMF_VMGetPetSpecific interface~esmf_vmget->proc~esmf_vmgetpetspecific proc~esmf_vmreducei4 ESMF_VMReduceI4 interface~esmf_vmreduce->proc~esmf_vmreducei4 proc~esmf_vmreducei8 ESMF_VMReduceI8 interface~esmf_vmreduce->proc~esmf_vmreducei8 proc~esmf_vmreducer4 ESMF_VMReduceR4 interface~esmf_vmreduce->proc~esmf_vmreducer4 proc~esmf_vmreducer8 ESMF_VMReduceR8 interface~esmf_vmreduce->proc~esmf_vmreducer8 esmf_breakpoint esmf_breakpoint proc~esmf_logfoundallocerror->esmf_breakpoint proc~esmf_logrc2msg ESMF_LogRc2Msg proc~esmf_logfoundallocerror->proc~esmf_logrc2msg proc~esmf_logwrite ESMF_LogWrite proc~esmf_logfoundallocerror->proc~esmf_logwrite proc~esmf_logfounddeallocerror->esmf_breakpoint proc~esmf_logfounddeallocerror->proc~esmf_logrc2msg proc~esmf_logfounddeallocerror->proc~esmf_logwrite proc~esmf_logfounderror->esmf_breakpoint proc~esmf_logfounderror->proc~esmf_logrc2msg proc~esmf_logfounderror->proc~esmf_logwrite proc~esmf_logseterror->esmf_breakpoint proc~esmf_logseterror->proc~esmf_logrc2msg proc~esmf_logseterror->proc~esmf_logwrite

Called by

proc~~iowrite2d~~CalledByGraph proc~iowrite2d IOWrite2D proc~esmfio_fieldaccess ESMFIO_FieldAccess proc~esmfio_fieldaccess->proc~iowrite2d proc~esmfio_read ESMFIO_Read proc~esmfio_read->proc~esmfio_fieldaccess proc~esmfio_write ESMFIO_Write proc~esmfio_write->proc~esmfio_fieldaccess program~esmf_iocomputest ESMF_IOCompUTest program~esmf_iocomputest->proc~esmfio_read program~esmf_iocomputest->proc~esmfio_write

Source Code

  subroutine IOWrite2D(vm, field, &
    minIndexPDe, maxIndexPDe, minIndexPTile, maxIndexPTile, keywordEnforcer, &
    fileName, iofmt, localDe, ncid, rc)
    type(ESMF_VM),         intent(in)            :: vm
    type(ESMF_Field),      intent(in)            :: field
    integer, dimension(:), intent(in)            :: minIndexPDe
    integer, dimension(:), intent(in)            :: maxIndexPDe
    integer, dimension(:), intent(in)            :: minIndexPTile
    integer, dimension(:), intent(in)            :: maxIndexPTile
type(ESMF_KeywordEnforcer), optional:: keywordEnforcer ! must use keywords below
    character(len=*),      intent(in),  optional :: fileName
    type(ESMF_IOFmt_flag), intent(in),  optional :: iofmt
    integer,               intent(in),  optional :: localDe
    integer,               intent(in),  optional :: ncid
    integer,               intent(out), optional :: rc

    ! -- local variables
    integer :: localrc
    integer :: ilen, jlen, lbuf, lde, localpe
    integer :: lncid, varId, ncStatus
    integer, dimension(2) :: elb, eub
    integer(ESMF_KIND_I4), dimension(:),   allocatable :: recvbuf_i4
    integer(ESMF_KIND_I4), dimension(:,:), allocatable :: buf_i4
    integer(ESMF_KIND_I4), dimension(:,:), pointer     :: fp_i4 => null()
    real(ESMF_KIND_R4),    dimension(:),   allocatable :: recvbuf_r4
    real(ESMF_KIND_R4),    dimension(:,:), allocatable :: buf_r4
    real(ESMF_KIND_R4),    dimension(:,:), pointer     :: fp_r4 => null()
    real(ESMF_KIND_R8),    dimension(:),   allocatable :: recvbuf_r8
    real(ESMF_KIND_R8),    dimension(:,:), allocatable :: buf_r8
    real(ESMF_KIND_R8),    dimension(:,:), pointer     :: fp_r8 => null()
    character(len=ESMF_MAXSTR) :: fieldName, dataSetName
    type(ESMF_TypeKind_Flag) :: typekind

    ! -- begin
    if (present(rc)) rc = ESMF_SUCCESS

    lde = 0
    if (present(localDe)) lde = localDe

    call ESMF_FieldGet(field, name=fieldName, typekind=typekind, rc=localrc)
    if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

    ilen = maxIndexPTile(1)-minIndexPTile(1)+1
    jlen = maxIndexPTile(2)-minIndexPTile(2)+1
    lbuf = ilen * jlen

    if      (typekind == ESMF_TYPEKIND_I4) then

      call ESMF_FieldGet(field, localDe=lde, farrayPtr=fp_i4, &
        exclusiveLBound=elb, exclusiveUBound=eub, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      allocate(buf_i4(minIndexPTile(1):maxIndexPTile(1), &
                      minIndexPTile(2):maxIndexPTile(2)), stat=localrc)
      if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      buf_i4 = 0_ESMF_KIND_I4
      buf_i4(minIndexPDe(1):maxIndexPDe(1), &
             minIndexPDe(2):maxIndexPDe(2)) = fp_i4(elb(1):eub(1),elb(2):eub(2))

      nullify(fp_i4)

      allocate(recvbuf_i4(lbuf), stat=localrc)
      if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      call ESMF_VMReduce(vm, reshape(buf_i4, (/lbuf/)), recvbuf_i4, lbuf, &
        ESMF_REDUCE_SUM, 0, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      buf_i4 = reshape(recvbuf_i4, (/ilen, jlen/))

      deallocate(recvbuf_i4, stat=localrc)
      if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

    else if (typekind == ESMF_TYPEKIND_R4) then

      call ESMF_FieldGet(field, localDe=lde, farrayPtr=fp_r4, &
        exclusiveLBound=elb, exclusiveUBound=eub, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      allocate(buf_r4(minIndexPTile(1):maxIndexPTile(1), &
                      minIndexPTile(2):maxIndexPTile(2)), stat=localrc)
      if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      buf_r4 = 0._ESMF_KIND_R4
      buf_r4(minIndexPDe(1):maxIndexPDe(1), &
             minIndexPDe(2):maxIndexPDe(2)) = fp_r4(elb(1):eub(1),elb(2):eub(2))

      nullify(fp_r4)

      allocate(recvbuf_r4(lbuf), stat=localrc)
      if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      call ESMF_VMReduce(vm, reshape(buf_r4, (/lbuf/)), recvbuf_r4, lbuf, &
        ESMF_REDUCE_SUM, 0, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      buf_r4 = reshape(recvbuf_r4, (/ilen, jlen/))

      deallocate(recvbuf_r4, stat=localrc)
      if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

    else if (typekind == ESMF_TYPEKIND_R8) then

      call ESMF_FieldGet(field, localDe=lde, farrayPtr=fp_r8, &
        exclusiveLBound=elb, exclusiveUBound=eub, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      allocate(buf_r8(minIndexPTile(1):maxIndexPTile(1), &
                      minIndexPTile(2):maxIndexPTile(2)), stat=localrc)
      if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      buf_r8 = 0._ESMF_KIND_R8
      buf_r8(minIndexPDe(1):maxIndexPDe(1), &
             minIndexPDe(2):maxIndexPDe(2)) = fp_r8(elb(1):eub(1),elb(2):eub(2))

      nullify(fp_r8)

      allocate(recvbuf_r8(lbuf), stat=localrc)
      if (ESMF_LogFoundAllocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      call ESMF_VMReduce(vm, reshape(buf_r8, (/lbuf/)), recvbuf_r8, lbuf, &
        ESMF_REDUCE_SUM, 0, rc=localrc)
      if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

      buf_r8 = reshape(recvbuf_r8, (/ilen, jlen/))

      deallocate(recvbuf_r8, 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="Field: "//trim(fieldName)//" - typekind not supported", &
        ESMF_CONTEXT, rcToReturn=rc)
      return  ! bail out
    end if

    call ESMF_VMGet(vm, localPet=localpe, rc=localrc)
    if (ESMF_LogFoundError(rcToCheck=localrc, ESMF_ERR_PASSTHRU, &
      ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out

    if (localpe == 0) then
      if (iofmt == ESMF_IOFMT_NETCDF) then
#ifdef ESMF_NETCDF
        lncid = 0
        dataSetName = "NetCDF data set"
        if (present(ncid)) then
          lncid = ncid
        else if (present(fileName)) then
          dataSetName = trim(dataSetName) // " " // trim(fileName)
          ncStatus = nf90_open(trim(fileName), NF90_WRITE, lncid)
          if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
            msg="Field "//trim(fieldName)//" not defined in "//trim(dataSetName), &
            ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
        end if

        ! -- add data
        if (lncid /= 0) then
          ncStatus = nf90_inq_varid(lncid, trim(fieldName), varId)
          if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
            msg="Field "//trim(fieldName)//" not defined in "//trim(dataSetName), &
            ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
        
          if (typekind == ESMF_TYPEKIND_I4) then
            ncStatus = nf90_put_var(lncid, varId, buf_i4)
            if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
              msg="Error writing field "//trim(fieldName)//" to "//trim(dataSetName), &
              ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
          else if (typekind == ESMF_TYPEKIND_R4) then
            ncStatus = nf90_put_var(lncid, varId, buf_r4)
            if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
              msg="Error writing field "//trim(fieldName)//" to "//trim(dataSetName), &
              ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
          else if (typekind == ESMF_TYPEKIND_R8) then
            ncStatus = nf90_put_var(lncid, varId, buf_r8)
            if (ESMF_LogFoundNetCDFError(ncerrToCheck=ncStatus, &
              msg="Error writing field "//trim(fieldName)//" to "//trim(dataSetName), &
              ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
          end if
        end if
#else
    call ESMF_LogSetError(rcToCheck=ESMF_RC_LIB_NOT_PRESENT, &
                 msg="- ESMF_NETCDF not defined when lib was compiled", &
                 ESMF_CONTEXT, rcToReturn=rc)
#endif
      end if
    end if

    if (typekind == ESMF_TYPEKIND_I4) then
      deallocate(buf_i4, stat=localrc)
      if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
    else if (typekind == ESMF_TYPEKIND_R4) then
      deallocate(buf_r4, stat=localrc)
      if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
    else if (typekind == ESMF_TYPEKIND_R8) then
      deallocate(buf_r8, stat=localrc)
      if (ESMF_LogFoundDeallocError(statusToCheck=localrc, ESMF_ERR_PASSTHRU, &
        ESMF_CONTEXT, rcToReturn=rc)) return  ! bail out
    end if

  end subroutine IOWrite2D