MAPL_CFIOWriteBundlePost Subroutine

public subroutine MAPL_CFIOWriteBundlePost(MCFIO, PrePost, RC)

The subroutine MAPL_CFIOWriteBundlePost writes an ESMF Bundle to a File. Only the MAPL_CFIO object is a required argument as pointers to the actual data to be written is recorded in it during creation.

CLOCK, BUNDLE can be used to override the choice made at creation, but this is of dubious value, particularly for BUNDLE since it must be excatly conformant with the creation BUNDLE. NBITS if the number of bits of the mantissa to retain. This is used to write files with degraded precision, which can then be compressed with standard utilities. The default is no degradation of precision.

A note about compression. NetCDF-4, HDF-4 and HDF-5 all support transparent internal GZIP compression of the data being written. However, very little is gained by compressing float point fields from earth system models. Compression yields can be greatly increased by setting to zero bits in the mantissa of float numbers. On average 50\% compression can be achieved, while preserving a meaningful accuracy in the fields. Unlike classical CF compression by means of scale_factor and add_offset attributes, internal GZIP compression requires no special handling by the users of the data. In fact, they do not even need to know that the data is compressed! At this point, MAPL_CFIO does not activate this GZIP compression feature in the files being written, but the resulting precision degredaded files can be compressed offline with the HDF-4 hrepack utility.

Arguments

Type IntentOptional Attributes Name
type(MAPL_CFIO), intent(inout) :: MCFIO
logical, intent(in), optional :: PrePost
integer, intent(out), optional :: RC

Calls

proc~~mapl_cfiowritebundlepost~~CallsGraph proc~mapl_cfiowritebundlepost MAPL_CFIOWriteBundlePost ESMF_VMGetCurrent ESMF_VMGetCurrent proc~mapl_cfiowritebundlepost->ESMF_VMGetCurrent esmf_fieldbundleget esmf_fieldbundleget proc~mapl_cfiowritebundlepost->esmf_fieldbundleget esmf_fieldget esmf_fieldget proc~mapl_cfiowritebundlepost->esmf_fieldget interface~arraygather ArrayGather proc~mapl_cfiowritebundlepost->interface~arraygather interface~mapl_allocnodearray MAPL_AllocNodeArray proc~mapl_cfiowritebundlepost->interface~mapl_allocnodearray interface~mapl_arrayigather MAPL_ArrayIGather proc~mapl_cfiowritebundlepost->interface~mapl_arrayigather interface~mapl_assert MAPL_Assert proc~mapl_cfiowritebundlepost->interface~mapl_assert interface~mapl_bcastshared MAPL_BcastShared proc~mapl_cfiowritebundlepost->interface~mapl_bcastshared interface~mapl_deallocnodearray MAPL_DeAllocNodeArray proc~mapl_cfiowritebundlepost->interface~mapl_deallocnodearray none~regrid~12 AbstractRegridder%regrid proc~mapl_cfiowritebundlepost->none~regrid~12 proc~mapl_createrequest MAPL_CreateRequest proc~mapl_cfiowritebundlepost->proc~mapl_createrequest proc~mapl_gridget MAPL_GridGet proc~mapl_cfiowritebundlepost->proc~mapl_gridget proc~mapl_return MAPL_Return proc~mapl_cfiowritebundlepost->proc~mapl_return proc~mapl_verify MAPL_Verify proc~mapl_cfiowritebundlepost->proc~mapl_verify none~regrid_vector_3d_real64~3 AbstractRegridder%regrid_vector_3d_real64 none~regrid~12->none~regrid_vector_3d_real64~3 proc~mapl_createrequest->ESMF_VMGetCurrent proc~mapl_createrequest->interface~mapl_assert proc~mapl_createrequest->proc~mapl_return proc~mapl_createrequest->proc~mapl_verify ESMF_GridGet ESMF_GridGet proc~mapl_createrequest->ESMF_GridGet ESMF_VMGet ESMF_VMGet proc~mapl_createrequest->ESMF_VMGet mpi_irecv mpi_irecv proc~mapl_createrequest->mpi_irecv proc~mapl_distgridget MAPL_DistGridGet proc~mapl_createrequest->proc~mapl_distgridget proc~mapl_gridget->proc~mapl_return proc~mapl_gridget->proc~mapl_verify ESMF_AttributeGet ESMF_AttributeGet proc~mapl_gridget->ESMF_AttributeGet ESMF_DistGridGet ESMF_DistGridGet proc~mapl_gridget->ESMF_DistGridGet proc~mapl_gridget->ESMF_GridGet proc~mapl_gridget->proc~mapl_distgridget proc~mapl_getimsjms MAPL_GetImsJms proc~mapl_gridget->proc~mapl_getimsjms proc~mapl_gridhasde MAPL_GridHasDE proc~mapl_gridget->proc~mapl_gridhasde at at proc~mapl_return->at insert insert proc~mapl_return->insert proc~mapl_throw_exception MAPL_throw_exception proc~mapl_return->proc~mapl_throw_exception proc~mapl_verify->proc~mapl_throw_exception none~regrid_vector_3d_real64~3->interface~mapl_assert none~regrid_vector_3d_real64~3->proc~mapl_return proc~mapl_distgridget->proc~mapl_verify proc~mapl_distgridget->ESMF_DistGridGet proc~mapl_getimsjms->interface~mapl_assert proc~mapl_getimsjms->proc~mapl_return proc~mapl_getimsjms->proc~mapl_verify interface~mapl_sort MAPL_Sort proc~mapl_getimsjms->interface~mapl_sort proc~mapl_gridhasde->proc~mapl_return proc~mapl_gridhasde->proc~mapl_verify proc~mapl_gridhasde->ESMF_DistGridGet proc~mapl_gridhasde->ESMF_GridGet ESMF_DELayoutGet ESMF_DELayoutGet proc~mapl_gridhasde->ESMF_DELayoutGet

Source Code

  subroutine MAPL_CFIOWriteBundlePost( MCFIO, PrePost, RC )
!
    type(MAPL_CFIO  ),               intent(INOUT) :: MCFIO
    logical,               optional, intent(IN   ) :: PrePost
    integer,               optional, intent(  OUT) :: RC

    integer                    :: status

    type(ESMF_FIELD)           :: FIELD
    integer                    :: L, K, k0, LM
    integer                    :: NN
    real,             pointer  :: Ptr2(:,:), Ptr3(:,:,:)
    real, target, allocatable  :: Ple3d(:,:,:)
    real,         allocatable  :: Pl3d(:,:,:)
    real,         allocatable  :: Ptrx(:,:,:)
    real,             pointer  :: layer(:,:),ps0(:,:)
    logical                    :: PrePost_
    integer                    :: globalcount(3)
    type(ESMF_VM)              :: vm
!                              ---
    _ASSERT(MCFIO%CREATED, 'MCFIO%CREATED is false')

    if (present(PrePost)) then
       PrePost_ = PrePost
    else
       PrePost_ = .true.
    end if

!  Set centers and edges of interpolating field
!----------------------------------------------

    if(mCFIO%Vinterp) then
       call ESMF_FieldBundleGet(mCFIO%bundle, fieldName=mCFIO%Vvar, Field=Field,  RC=STATUS)
       _VERIFY(STATUS)

       nullify (ptr3)
       call ESMF_FieldGet(Field, localDE=0, farrayPtr=Ptr3, rc=status)
       _VERIFY(STATUS)

       allocate( LAYER(size(Ptr3,1),size(Ptr3,2) ), stat=status)
       _VERIFY(STATUS)

       if (associated(mcfio%regridder)) then
          call ESMF_VMGetCurrent(vm,rc=status)
          _VERIFY(status)
          call MAPL_GridGet(mcfio%grid,globalCellCountPerDim=globalCount,rc=status)
          _VERIFY(status)
          call MAPL_AllocNodeArray(ps0,[globalCount(1),globalCount(2)],rc=status)
          if(STATUS==MAPL_NoShm) allocate(ps0(globalCount(1),globalCount(2)),stat=status)
          _VERIFY(status)
          call MAPL_AllocNodeArray(mcfio%surfaceLayer,[mcfio%im,mcfio%jm],rc=status)
          if(STATUS==MAPL_NoShm) allocate(mcfio%surfaceLayer(mcfio%im,mcfio%jm),stat=status)
          _VERIFY(STATUS)
       end if

! The Ptr3 interpolating variable is a zero-based (0-LM) edge variable
!---------------------------------------------------------------------
       if(lbound(PTR3,3)==0) then
          allocate( ple3D(size(Ptr3,1),size(Ptr3,2),size(Ptr3,3)  ), stat=status)
          _VERIFY(STATUS)
          allocate(  pl3D(size(Ptr3,1),size(Ptr3,2),size(Ptr3,3)-1), stat=status)
          _VERIFY(STATUS)

          if    (mCFIO%Func=='log') then
             ple3D = log(Ptr3)
             pl3D  = log( 0.5*(Ptr3(:,:,1:)+Ptr3(:,:,0:ubound(Ptr3,3)-1)) )
          elseif(mCFIO%Func=='pow') then
             ple3D = Ptr3**mCFIO%pow
             pl3D  =    ( 0.5*(Ptr3(:,:,1:)+Ptr3(:,:,0:ubound(Ptr3,3)-1)) )**mCFIO%pow
          else
             ple3D = Ptr3
             pl3D  =    ( 0.5*(Ptr3(:,:,1:)+Ptr3(:,:,0:ubound(Ptr3,3)-1)) )
          end if
          if (associated(mCFIO%regridder)) then
             mcfio%ascending = (ptr3(1,1,0)<ptr3(1,1,1))
             call ArrayGather(ptr3(:,:,ubound(ptr3,3)),ps0,mcfio%grid,rc=status)
             _VERIFY(status)
          end if

       else

! The Ptr3 interpolating variable is a (1-LM) mid-layer variable
!---------------------------------------------------------------
          allocate(  Ptrx(size(Ptr3,1),size(Ptr3,2),0:size(Ptr3,3)  ), stat=status)
          _VERIFY(STATUS)
          allocate( ple3D(size(Ptr3,1),size(Ptr3,2),0:size(Ptr3,3)  ), stat=status)
          _VERIFY(STATUS)
          allocate(  pl3D(size(Ptr3,1),size(Ptr3,2),  size(Ptr3,3)  ), stat=status)
          _VERIFY(STATUS)

          Ptrx(:,:,0               ) = 0.5*( 3* Ptr3(:,:,1)             -Ptr3(:,:,2)                )
          Ptrx(:,:,1:size(Ptr3,3)-1) = 0.5*(    Ptr3(:,:,2:size(Ptr3,3))+Ptr3(:,:,1:size(Ptr3,3)-1) )
          Ptrx(:,:,  size(Ptr3,3)  ) = 0.5*( 3* Ptr3(:,:,  size(Ptr3,3))-Ptr3(:,:,  size(Ptr3,3)-1) )

          if    (mCFIO%Func=='log') then
             ple3D = log(Ptrx)
             pl3D  = log( 0.5*(Ptrx(:,:,1:)+Ptrx(:,:,0:ubound(Ptrx,3)-1)) )
          elseif(mCFIO%Func=='pow') then
             ple3D = Ptrx**mCFIO%pow
             pl3D  =    ( 0.5*(Ptrx(:,:,1:)+Ptrx(:,:,0:ubound(Ptrx,3)-1)) )**mCFIO%pow
          else
             ple3D = Ptrx
             pl3D  =    ( 0.5*(Ptrx(:,:,1:)+Ptrx(:,:,0:ubound(Ptrx,3)-1)) )
          end if

          if (associated(mCFIO%regridder)) then
             mcfio%ascending = (ptrx(1,1,0)<ptrx(1,1,1))
             call ArrayGather(ptrx(:,:,ubound(ptrx,3)),ps0,mcfio%grid,rc=status)
             _VERIFY(status)

          end if
          deallocate(Ptrx)
       end if

       if (associated(mCFIO%regridder)) then
          call MAPL_BcastShared(vm,data=ps0,N=globalCount(1)*globalCount(2),root=0,RootOnly=.false.,rc=status)
          _VERIFY(status)
          if (MAPL_AmNodeRoot .or. (.not. MAPL_ShmInitialized)) then
             call mCFIO%regridder%regrid(ps0,mcfio%surfaceLayer,rc=status)
             _VERIFY(status)
          end if

          if (MAPL_ShmInitialized) then
             call MAPL_DeAllocNodeArray(ps0,rc=status)
             _VERIFY(status)
          else
             deallocate(ps0)
          end if
       end if

    end if

    call MAPL_CFIOSetVectorPairs(mCFIO,rc=status)
    _VERIFY(status)

! Cycle through all variables posting receives.
!----------------------------------------------

    nn = 0

    POSTRECV: do L=1, size(MCFIO%VarDims)
       if    (mCFIO%VarDims(L)==2) then ! Rank == 2
          LM = 1
       elseif(MCFIO%VarDims(L)==3) then ! Rank == 3
          LM = MCFIO%LM
       else
          LM = 0
       endif

       do K=1,LM
          nn    = nn + 1
          call MAPL_CreateRequest(MCFIO%GRID, MCFIO%Krank(nn), MCFIO%reqs(nn), &
                                  tag=nn, RequestType=MAPL_IsGather, PrePost = PrePost_, RC=STATUS)
          _VERIFY(STATUS)
       enddo
    end do POSTRECV

! Cycle through all variables posting sends.
!-------------------------------------------

    nn = 0

    VARIABLES: do L=1, size(MCFIO%VarDims)

       call ESMF_FieldBundleGet(MCFIO%BUNDLE, MCFIO%VARNAME(L), FIELD=FIELD,                  RC=STATUS)
       _VERIFY(STATUS)

! We treat only fields with rank 2 (horizontal 2D) and
!  rank 3 (first 2 dimension are horz, third is vert).
!--------------------------------------------------------

       RANK: if (MCFIO%VarDims(L)==2) then ! Rank == 2

          nn    = nn + 1
          ptr2  =>null()

          call ESMF_FieldGet      (FIELD, localDE=0, farrayPtr=PTR2, RC=STATUS)
          _VERIFY(STATUS)
          call MAPL_ArrayIGather  (Ptr2, MCFIO%reqs(NN), RC=STATUS)
          _VERIFY(STATUS)

       elseif(MCFIO%VarDims(L)==3) then ! Rank == 3

          ptr3 =>null()

          call ESMF_FieldGet      (FIELD, localDE=0, farrayPtr=PTR3, RC=STATUS)
          _VERIFY(STATUS)

          K0  = lbound(PTR3,3) - 1

! For each level, interpolate vertically and post gather
!-------------------------------------------------------

          LAYERS: do K=1,MCFIO%LM
             VINTERP: if(mCFIO%Vinterp) then
                call VertInterp(LAYER, PTR3, MCFIO%LEVS(K), ple3d, pl3d, rc=status)
                _VERIFY(STATUS)
             else if (MCFIO%LEVS(K)<0) then
                LAYER => PTR3(:,:,K+K0)
             else
                LAYER => PTR3(:,:,nint(MCFIO%LEVS(K)))
             end if VINTERP

             nn    = nn + 1

             call MAPL_ArrayIGather(LAYER, MCFIO%reqs(nn), rc=status)
             _VERIFY(STATUS)
          enddo LAYERS

       end if RANK

    end do VARIABLES



!   if(mCFIO%myPE==mCFIO%Root) then
!      print *, ' Posted to File: ', trim(mCFIO%fName)
!   endif


    if(mCFIO%Vinterp) then
       deallocate( ple3D, stat=status)
       _VERIFY(STATUS)
       deallocate( pl3D , stat=status)
       _VERIFY(STATUS)
       deallocate( Layer, stat=status)
       _VERIFY(STATUS)
    end if

    _RETURN(ESMF_SUCCESS)
  end subroutine MAPL_CFIOWriteBundlePost