! ! Simple unit test for CFIO Read/Write Bundle with variable NBIT precision ! #include "MAPL_Generic.h" Program utCFIO use ESMF_Mod use MAPL_BaseMod use MAPL_CommsMod use ESMF_CfioMod use MAPL_CfioMod implicit NONE type(ESMF_Grid) :: grid type (ESMF_VM) :: VM type(ESMF_DELayout) :: layout integer :: nymd, nhms type(ESMF_Time) :: fTime, dTime type(ESMF_TimeInterval) :: fTimeStep, dTimeStep type(ESMF_Clock) :: fClock, dClock type(ESMF_Bundle) :: fBundle, dBundle type(ESMF_CFIO) :: cfio integer :: IM_WORLD = 288, JM_WORLD = 181, KM_WORLD = 72 ! globalc72 integer :: i, j, k, im, jm, km ! local character(len=*), parameter :: & dirname = '/share/dasilva/fvInput/fvchem/c/aero_clm', & fFilename = dirname // '/gfedv2.aero.eta.200207clm.hdf' character(len=255) :: fname ! output file name integer :: status, rc, nbits logical :: IamRoot integer, pointer :: resolution(:), levels(:) character(len=*), parameter :: Iam = 'utCFIO' ! ----- call test_main() CONTAINS subroutine test_main() ! Initialize framework ! -------------------- call ESMF_Initialize (vm=vm, rc=status) _VERIFY(status) IamRoot = MAPL_am_I_root() ! Get the global vm ! ----------------- call ESMF_VMGetGlobal(vm, rc=status) _VERIFY(status) ! Create a grid ! ------------- grid = MyGridCreate_ ( vm, rc=status ) _VERIFY(status) ! Create empty bundles ! -------------------- fBundle = ESMF_BundleCreate ( name='Francesca', grid=grid, rc=status ) _VERIFY(status) dBundle = ESMF_BundleCreate ( name='Denise', grid=grid, rc=status ) _VERIFY(status) ! Set the time as the one on the hardwired file name ! -------------------------------------------------- call ESMF_CalendarSetDefault ( ESMF_CAL_GREGORIAN, rc=status ) _VERIFY(STATUS) call ESMF_TimeSet( fTime, yy=2002, mm=7, dd=15, h=12, m=0, s=0, rc=status ) _VERIFY(STATUS) call ESMF_TimeIntervalSet( fTimeStep, h=6, m=0, s=0, rc=status ) _VERIFY(STATUS) fClock = ESMF_ClockCreate ( name="Clovis", timeStep=fTimeStep, & startTime=fTime, rc=status ) _VERIFY(STATUS) ! Read Bundle from file on a clean slate ! -------------------------------------- if ( IamRoot ) print *, 'Reading ' // fFilename call ESMF_ioRead ( fFilename, fTime, fBundle, rc=status, & verbose=.true., force_regrid=.true. ) _VERIFY(status) ! Setup data types need for write ! ------------------------------- allocate ( resolution(2), levels(KM_WORLD), stat=status ) _VERIFY(status) resolution = (/ IM_WORLD/2, JM_WORLD/2 /) levels = (/ (k, k=1,KM_WORLD) /) ! Write the same bundle to a different file, each time with ! different precision ! ---------------------------------------------------------- nbits = 32 ! full precision write(fname,"('test.aero.eta.',I2.2)") nbits call ESMF_ioCreate ( cfio, fname, fClock, fBundle, fTimeStep, & resolution, levels, 'Bundle Write Test', rc=status ) _VERIFY(status) call ESMF_ioWrite ( cfio, fClock, fBundle, fTimeStep, levels, rc=status, & verbose = .true. ) ! omit nbits _VERIFY(status) call ESMF_ioDestroy ( cfio ) do nbits = 16, 8, -2 write(fname,"('test.aero.eta.',I2.2)") nbits call ESMF_ioCreate ( cfio, fname, fClock, fBundle, fTimeStep, & resolution, levels, 'Bundle Write Test', rc=status ) _VERIFY(status) call ESMF_ioWrite ( cfio, fClock, fBundle, fTimeStep, levels, rc=status, & nbits = nbits, verbose = .true. ) _VERIFY(status) call ESMF_ioDestroy ( cfio ) end do ! precision loop ! All done ! -------- call ESMF_Finalize ( rc=status ) _VERIFY(STATUS) end subroutine test_main !........................................................................ function MyGridCreate_ ( vm, rc) result(grid) type (ESMF_VM), intent(IN ) :: VM integer, optional, intent(OUT) :: rc type (ESMF_Grid) :: grid ! Local vars integer :: status character(len=ESMF_MAXSTR), parameter :: IAm='MyGridCreate' integer :: LM integer :: L integer :: NX, NY integer, allocatable :: IMXY(:), JMXY(:) character(len=ESMF_MAXSTR) :: gridname real(ESMF_KIND_R8) :: minCoord(3) real(ESMF_KIND_R8) :: deltaX, deltaY, deltaZ real :: LON0, LAT0 real :: pi, d2r ! grid create lm = KM_WORLD ! no. vertical layers nx = 2 ny = 2 pi = 4.0 * atan ( 1.0 ) d2r = pi / 180. LON0 = -180 * d2r LAT0 = -90.0 * d2r ! Get the IMXY vector ! ------------------- allocate( imxy(0:nx-1) ) call MAPL_GET_LOCAL_DIMS ( IM_WORLD, imxy, nx ) ! Get the JMXY vector ! ------------------- allocate( jmxy(0:ny-1) ) call MAPL_GET_LOCAL_DIMS ( JM_WORLD, jmxy, ny ) deltaX = 2.0*pi/IM_WORLD deltaY = pi/(JM_WORLD-1) deltaZ = 1.0 if ( MAPL_Am_I_Root() ) then print *, 'nx : imxy = ', nx, ' : ', imxy print *, 'ny : jmxy = ', ny, ' : ', jmxy endif ! Define South-West Corner of First Grid-Box ! ------------------------------------------ minCoord(1) = LON0 - deltaX/2 minCoord(2) = LAT0 - deltaY/2 minCoord(3) = deltaZ/2. layout = ESMF_DELayoutCreate(vm, deCountList=(/NX, NY/), rc=status) _VERIFY(STATUS) grid = ESMF_GridCreateHorzLatLonUni( & counts = (/IM_WORLD, JM_WORLD/), & minGlobalCoordPerDim=minCoord(1:2), & deltaPerDim=(/deltaX, deltaY /), & horzStagger=ESMF_Grid_Horz_Stagger_A, & periodic=(/ESMF_TRUE, ESMF_FALSE/), & name='Beatrice', rc=status) _VERIFY(STATUS) call ESMF_GridAddVertHeight(grid, & delta=(/(deltaZ, L=1,LM) /), & rc=status) _VERIFY(STATUS) call ESMF_GridDistribute(grid, & deLayout=layout, & countsPerDEDim1=imxy, & countsPerDEDim2=jmxy, & rc=status) _VERIFY(STATUS) deallocate(imxy) deallocate(jmxy) _RETURN(STATUS) end function MyGridCreate_ end Program utCFIO