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.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(MAPL_CFIO), | intent(inout) | :: | MCFIO | |||
logical, | intent(in), | optional | :: | PrePost | ||
integer, | intent(out), | optional | :: | RC |
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