diff --git a/code/NcdfUtil/TestNcdfUtil.F90 b/code/NcdfUtil/TestNcdfUtil.F90 new file mode 100644 index 0000000..633b5f4 --- /dev/null +++ b/code/NcdfUtil/TestNcdfUtil.F90 @@ -0,0 +1,710 @@ +!------------------------------------------------------------------------------ +! Harvard University Atmospheric Chemistry Modeling Group ! +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: TestNcdfUtil.F90 +! +! !DESCRIPTION: Program TestNcdfUtilities.F90 is the standalone driver that +! tests if the libNcUtils.a file was built correctly. +!\\ +!\\ +! !INTERFACE: +! +PROGRAM TestNcdfUtil +! +! !USES: +! +! +! !USES: +! + ! Modules for netCDF write + USE m_netcdf_io_define + USE m_netcdf_io_create + USE m_netcdf_io_write + + ! Modules for netCDF read + USE m_netcdf_io_open + USE m_netcdf_io_get_dimlen + USE m_netcdf_io_read + USE m_netcdf_io_readattr + USE m_netcdf_io_close + + IMPLICIT NONE + + ! netCDF include files +# include "netcdf.inc" + +! +! !BUGS: +! None known at this time +! +! !SEE ALSO: +! m_do_err_out.F90 +! m_netcdf_io_checks.F90 +! m_netcdf_io_close.F90 +! m_netcdf_io_create.F90 +! m_netcdf_io_define.F90 +! m_netcdf_io_get_dimlen.F90 +! m_netcdf_io_handle_err.F90 +! m_netcdf_io_open.F90 +! m_netcdf_io_read.F90 +! m_netcdf_io_write.F90 +! +! !SYSTEM ROUTINES: +! None +! +! !REMARKS: +! netCDF library modules originally written by Jules Kouatchou, GSFC +! and re-packaged into NcdfUtilities by Bob Yantosca, Harvard Univ. + +! !REVISION HISTORY: +! 03 Jul 2008 - R. Yantosca (Harvard University) - Initial version +! 24 Jan 2012 - R. Yantosca - Modified to write COARDS-compliant output +! 31 Jan 2012 - R. Yantosca - Bug fix in error checks for attributes +! 14 Jun 2012 - R. Yantosca - Now tests 2D character read/write +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! Global private variables + INTEGER, PARAMETER :: ILONG = 72 ! # of longitude grid points + INTEGER, PARAMETER :: ILAT = 46 ! # of latitude grid points + INTEGER, PARAMETER :: IVERT = 55 ! # of altitude levels + INTEGER, PARAMETER :: ITIME = 1 ! # of times + INTEGER, PARAMETER :: ICHAR1 = 2 ! # of times + INTEGER, PARAMETER :: ICHAR2 = 20 ! # of times + INTEGER :: pCt ! # of passed tests + INTEGER :: tCt ! # of total tests + INTEGER :: I ! Loop index + INTEGER :: longdeg, latdeg ! For longdat, latdat + REAL*8 :: longDat(ILONG) ! Longitude data + REAL*8 :: latDat (ILONG) ! Latitude data + REAL*8 :: levDat (IVERT) ! Altitude data + INTEGER :: timeDat(ITIME) ! Time data + + ! Initialize + pCt = 0 + tCt = 0 + + ! Longitude data + longdeg = 360.0 / REAL( ILONG ) + if ( mod( 360, ILONG) /= 0 ) longdeg = longdeg + 1 + do i = 1, ILONG + longDat(i) = i*longdeg + enddo + + ! Writing latitude data point + latdeg = 180.0 / REAL( ILAT ) + if ( mod( 180, ILAT ) /= 0 ) latdeg = latdeg + 1 + do i = 1, ilong + latDat(i) = -90 + (i-0.5)*latdeg + enddo + + ! Pressure + do i = 1, IVERT + levDat(i) = 1000.00 - (i-1)*(920.00/IVERT) + enddo + + ! Time data + do i = 1, ITIME + timeDat(i) = 0 + enddo + + ! Echo info + WRITE( 6, '(a)' ) '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' + WRITE( 6, '(a)' ) '%%% Testing libNcdfUtilities.a %%%' + WRITE( 6, '(a)' ) '%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%' + + ! Create a netCDF file + CALL TestNcdfCreate + + ! And try to read it back + CALL TestNcdfRead +!BOC + +CONTAINS + +!EOC +!------------------------------------------------------------------------------ +! Harvard University Atmospheric Chemistry Modeling Group ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: TestNcdfCreate +! +! !DESCRIPTION: Subroutine TestNcdfCreate creates a netCDF file +! named \texttt{my\_filename.nc} with the following variables: +! +! \begin{description} +! \item[PSF] Surface pressure (2D variable) +! \item[KEL] Temperature (3D variable) +! \end{description} +! +! Fake values are used for the data. An unlimited dimension is employed +! to write out several records of kel. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE TestNcdfCreate +! +! !REVISION HISTORY: +! 03 Jul 2008 - R. Yantosca (Harvard University) - Initial version +! 24 Jan 2012 - R. Yantosca - Modified to provide COARDS-compliant output +! 14 Jun 2012 - R. Yantosca - Now writes a 2-D character array +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! For netCDF file I/O + INTEGER :: idLon, idLat, idLev, idTime + INTEGER :: idChar1, idChar2 + INTEGER :: fId, vId, omode, i + INTEGER :: ct1d(1), ct2d(2), ct3d(3), ct4d(4) + INTEGER :: st1d(1), st2d(2), st3d(3), st4d(4) + INTEGER :: var1(1), var2(2), var3(3), var4(4) + CHARACTER(LEN=255) :: units, delta_t, begin_d + CHARACTER(LEN=255) :: begin_t, incr + + ! "Fake" data arrays + REAL*4 :: PS( ILONG, ILAT, ITIME ) ! surface pressure + REAL*4 :: T ( ILONG, ILAT, IVERT, ITIME ) ! temperature + CHARACTER :: DESC( ICHAR1, ICHAR2 ) ! Description + + !========================================================================= + ! Create the netCDF file + !========================================================================= + + ! Echo info + WRITE( 6, '(a)' ) '=== Begin netCDF file creation test ===' + + CALL NcCr_Wr( fId, 'my_filename.nc' ) + + ! Turn filling off + CALL NcSetFill( fId, NF_NOFILL, omode ) + + !========================================================================= + ! Define the dimensions + !========================================================================= + + ! Longitude dimension + WRITE( 6, '(a)' ) 'Writing lon (dim ) to netCDF file' + CALL NcDef_Dimension( fId, 'lon', ILONG, idLon ) + + ! Latitude dimension + WRITE( 6, '(a)' ) 'Writing lat (dim ) to netCDF file' + CALL NcDef_Dimension( fId, 'lat', ILAT , idLat ) + + ! Altitude dimension + WRITE( 6, '(a)' ) 'Writing lev (dim ) to netCDF file' + CALL NcDef_Dimension( fId, 'lev', IVERT, idLev ) + + ! Altitude dimension + WRITE( 6, '(a)' ) 'Writing time (dim ) to netCDF file' + CALL NcDef_Dimension( fId, 'time', ITIME, idTime ) + + ! Character dimension 1 + WRITE( 6, '(a)' ) 'Writing cdim1 (dim ) to netCDF file' + CALL NcDef_Dimension( fId, 'cdim1', ICHAR1, idChar1 ) + + ! Character dimension 1 + WRITE( 6, '(a)' ) 'Writing cdim2 (dim ) to netCDF file' + CALL NcDef_Dimension( fId, 'cdim2', ICHAR2, idChar2 ) + + !========================================================================= + ! Define the variables and variable attributes + ! for COARDS compliance and GAMAP compliance + !========================================================================= + CALL NcDef_Glob_Attributes( fId, 'title', 'NcdfUtilities test file' ) + CALL NcDef_Glob_Attributes( fId, 'history', 'test file - 24 Jan 2011' ) + CALL NcDef_Glob_Attributes( fId, 'conventions', 'COARDS' ) + CALL NcDef_Glob_Attributes( fId, 'model', 'GEOS4' ) + CALL NcDef_Glob_Attributes( fId, 'nlayers', '55' ) + CALL NcDef_Glob_Attributes( fId, 'start_date', '20110101' ) + CALL NcDef_Glob_Attributes( fId, 'start_time', '00:00:00.0' ) + CALL NcDef_Glob_Attributes( fId, 'end_date', '20110101' ) + CALL NcDef_Glob_Attributes( fId, 'end_time', '23:59:59.0' ) + CALL NcDef_Glob_Attributes( fId, 'delta_lon', '5' ) + CALL NcDef_Glob_Attributes( fId, 'delta_lat', '4' ) + CALL NcDef_Glob_Attributes( fId, 'delta_time', '000000' ) + CALL NcDef_Glob_Attributes( fId, 'format', 'netCDF-3' ) + + !========================================================================= + ! Define the variables and variable attributes + !========================================================================= + + ! Define longitude variable + vId = 0 + var1 = (/ idLon /) + CALL NcDef_Variable( fId, 'lon', NF_DOUBLE, 1, var1, vId ) + CALL NcDef_Var_Attributes( fId, vId, 'long_name', 'Longitude' ) + CALL NcDef_Var_Attributes( fId, vId, 'units', 'degrees_east' ) + + ! Define latitude variable + vId = vId + 1 + var1 = (/ idLat /) + CALL NcDef_Variable( fId, 'lat', NF_DOUBLE, 1, var1, vId ) + CALL NcDef_Var_Attributes( fId, vId, 'long_name', 'Latitude' ) + CALL NcDef_Var_Attributes( fId, vId, 'units', 'degrees_north' ) + + ! Define vertical (pressure) variable + vId = vId + 1 + var1 = (/ idLev /) + CALL NcDef_Variable( fId, 'lev', NF_DOUBLE, 1, var1, vId ) + CALL NcDef_Var_Attributes( fId, vId, 'long_name', 'Pressure' ) + CALL NcDef_Var_Attributes( fId, vId, 'units', 'hPa' ) + + ! Time index array (hardwire date to 2011/01/01) + vId = vId + 1 + var1 = (/ idTime /) + vId = vId + 1 + units = 'minutes since 2011-01-01 00:00:00 GMT' + delta_t = '0000-00-00 00:00:00' + begin_d = '20110101' + begin_t = '000000' + incr = '000000' + CALL NcDef_Variable ( fId, 'time', NF_INT, 1, var1, vId ) + CALL NcDef_Var_Attributes( fId, vId, 'long_name', 'time' ) + CALL NcDef_Var_Attributes( fId, vId, 'units', TRIM( units ) ) + CALL NcDef_Var_Attributes( fId, vId, 'delta_t', TRIM( delta_t ) ) + CALL NcDef_Var_Attributes( fId, vId, 'begin_date', TRIM( begin_d ) ) + CALL NcDef_Var_Attributes( fId, vId, 'begin_time', TRIM( begin_t ) ) + CALL NcDef_Var_Attributes( fId, vId, 'time_increment', TRIM( incr ) ) + + ! Define surface pressure variable + vId = vId + 1 + var3 = (/ idLon, idLat, idTime /) + CALL NcDef_Variable ( fId, 'PS', NF_FLOAT, 3, var3, vId ) + CALL NcDef_Var_Attributes( fId, vId, 'long_name', 'Surface Pressure' ) + CALL NcDef_Var_Attributes( fId, vId, 'units', 'hPa' ) + CALL NcDef_Var_Attributes( fId, vId, 'gamap_category', 'GMAO-2D' ) + + ! Define temperature variable + vId = vId + 1 + var4 = (/ idLon, idLat, idLev, idTime /) + CALL NcDef_Variable ( fId, 'T', NF_FLOAT, 4, var4, vId ) + CALL NcDef_Var_Attributes( fId, vId, 'long_name', 'Temperature' ) + CALL NcDef_Var_Attributes( fId, vId, 'units', 'K' ) + CALL NcDef_Var_Attributes( fId, vId, 'gamap_category', 'GMAO-3D$' ) + + ! Define description variable + vId = vId + 1 + var2 = (/ idChar1, idChar2 /) + CALL NcDef_Variable ( fId, 'DESC', NF_CHAR, 2, var2, vId ) + CALL NcDef_Var_Attributes( fId, vId, 'long_name', 'Description' ) + CALL NcDef_Var_Attributes( fId, vId, 'units', '1' ) + CALL NcDef_Var_Attributes( fId, vId, 'gamap_category', 'none' ) + + !========================================================================= + ! %%% END OF DEFINITION SECTION %%% + ! %%% NOW WRITE DATA TO FILE %%% + !========================================================================= + CALL NcEnd_def( fId ) + + ! Write longitude + WRITE( 6, '(a)' ) 'Writing lon (1D array) to netCDF file' + st1d = (/ 1 /) + ct1d = (/ ILONG /) + CALL NcWr( longDat, fId, 'lon', st1d, ct1d ) + + ! Write latitude + WRITE( 6, '(a)' ) 'Writing lat (1D array) to netCDF file' + st1d = (/ 1 /) + ct1d = (/ ILAT /) + CALL NcWr( latDat, fId, 'lat', st1d, ct1d ) + + ! Write pressure levels + WRITE( 6, '(a)' ) 'Writing lev (1D array) to netCDF file' + st1d = (/ 1 /) + ct1d = (/ IVERT /) + CALL NcWr( levDat, fId, 'lev', st1d, ct1d ) + + ! Write pressure levels + WRITE( 6, '(a)' ) 'Writing time (1D array) to netCDF file' + st1d = (/ 1 /) + ct1d = (/ ITIME /) + CALL NcWr( timeDat, fId, 'time', st1d, ct1d ) + + ! Write surface pressure (w/ fake values) + WRITE( 6, '(a)' ) 'Writing PS (3D array) to netCDF file' + PS = 1e0 + st3d = (/ 1, 1, 1 /) + ct3d = (/ ILONG, ILAT, ITIME /) + CALL NcWr( PS, fId, 'PS', st3d, ct3d ) + + ! Write temperature (w/ fake values) + WRITE( 6, '(a)' ) 'Writing T (4D array) to netCDF file' + T = 1e0 + st4d = (/ 1, 1, 1, 1 /) + ct4d = (/ ILONG, ILAT, IVERT, ITIME /) + CALL NcWr( T, fId, 'T', st4d, ct4d ) + + ! Initialzie the character array + DO i = 1, ICHAR2 + DESC(1,i) = ACHAR(64+I) + DESC(2,i) = ACHAR(96+I) + ENDDO + + ! Write temperature (w/ fake values) + WRITE( 6, '(a)' ) 'Writing DESC (2D char ) to netCDF file' + st2d = (/ 1, 1 /) + ct2d = (/ ICHAR1, ICHAR2 /) + CALL NcWr( DESC, fId, 'DESC', st2d, ct2d ) + + !========================================================================= + ! Close the netCDF file + !========================================================================= + CALL NcCl( fId ) + + ! Echo info + WRITE( 6, '(a)' ) '=== End netCDF file creation test ===' + + END SUBROUTINE TestNcdfCreate +!EOC +!------------------------------------------------------------------------------ +! Harvard University Atmospheric Chemistry Modeling Group ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: TestNcdfRead +! +! !DESCRIPTION: Routine TestNcdfRead extracts the following fields from +! the netCDF file \texttt{my\_filename.nc}: +! +! \begin{description} +! \item[PSF] Surface pressure (2D variable) +! \item[KEL] Temperature (3D variable). +! \end{description} +! +! Note that the file \texttt{my\_filename.nc} was created with fake data +! values by subroutine TestNcdfCreate. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE TestNcdfRead +! +! !REVISION HISTORY: +! 03 Jul 2008 - R. Yantosca (Harvard University) - Initial version +! 24 Jan 2012 - R. Yantosca - Modified to provide COARDS-compliant output +! 31 Jan 2012 - R. Yantosca - Bug fix in error checks for attributes +! 14 Jun 2012 - R. Yantosca - Now tests 2-D character read +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + ! Scalars + INTEGER :: fId, rc, XDim, CDim1 + INTEGER :: YDim, ZDim, TDim, CDim2 + INTEGER :: ct1d(1), ct2d(2), ct3d(3), ct4d(4) + INTEGER :: st1d(1), st2d(2), st3d(3), st4d(4) + CHARACTER(LEN=255) :: attValue + + ! Arrays + REAL*8, ALLOCATABLE :: lon(:), lat(:), lev(:) + INTEGER, ALLOCATABLE :: time(:) + REAL*4, ALLOCATABLE :: PS(:,:,:) + REAL*4, ALLOCATABLE :: T(:,:,:,:) + CHARACTER, ALLOCATABLE :: DESC(:,:) + + !========================================================================= + ! Open the netCDF file + !========================================================================= + + ! Echo info + WRITE( 6, '(a)' ) '=== Begin netCDF file reading test ===' + + CALL Ncop_Rd( fId, 'my_filename.nc' ) + + !========================================================================= + ! Get the dimensions + !========================================================================= + CALL Ncget_Dimlen( fId, 'lon', XDim ) + CALL Ncget_Dimlen( fId, 'lat', YDim ) + CALL Ncget_Dimlen( fId, 'lev', ZDim ) + CALL Ncget_Dimlen( fId, 'time', TDim ) + CALL Ncget_Dimlen( fId, 'cdim1', CDim1 ) + CALL Ncget_Dimlen( fId, 'cdim2', CDim2 ) + + rc = XDim - ILONG + CALL Check( 'Reading lon (dim ) back from netCDF file', rc, pCt, tCt ) + + rc = YDim - ILAT + CALL Check( 'Reading lat (dim ) back from netCDF file', rc, pCt, tCt ) + + rc = ZDim - IVERT + CALL Check( 'Reading lev (dim ) back from netCDF file', rc, pCt, tCt ) + + rc = TDim - ITIME + CALL Check( 'Reading time (dim ) back from netCDF file', rc, pCt, tCt ) + + rc = CDim1 - ICHAR1 + CALL Check( 'Reading cdim1 (dim ) back from netCDF file', rc, pCt, tCt ) + + rc = CDim2 - ICHAR2 + CALL Check( 'Reading cdim2 (dim ) back from netCDF file', rc, pCt, tCt ) + + !========================================================================= + ! Read the LON variable + !========================================================================= + + ! Read data + ALLOCATE( lon( XDim ) ) + st1d = (/ 1 /) + ct1d = (/ XDim /) + CALL NcRd( lon, fId, 'lon', st1d, ct1d ) + + ! Equality test + rc = SUM( lon - longDat ) + CALL Check( 'Reading lon (array) back from netCDF file', rc, pCt, tCt ) + + !========================================================================= + ! Read the LAT variable + !========================================================================= + + ! Read data + ALLOCATE( lat( YDim ) ) + st1d = (/ 1 /) + ct1d = (/ YDim /) + CALL NcRd( lat, fId, 'lat', st1d, ct1d ) + + ! Equality test + rc = SUM( lat - latDat ) + CALL Check( 'Reading lat (array) back from netCDF file', rc, pCt, tCt ) + + !========================================================================= + ! Read the LEV variable + !========================================================================= + + ! Read data + ALLOCATE( lev( ZDim ) ) + st1d = (/ 1 /) + ct1d = (/ ZDim /) + CALL NcRd( lev, fId, 'lev', st1d, ct1d ) + + ! Equality test + rc = SUM( lev - levDat ) + CALL Check( 'Reading lev (array) back from netCDF file', rc, pCt, tCt ) + + !========================================================================= + ! Read the TIME variable + !========================================================================= + + ! Read data + ALLOCATE( time( TDim ) ) + st1d = (/ 1 /) + ct1d = (/ TDim /) + CALL NcRd( time, fId, 'time', st1d, ct1d ) + + ! Equality test + rc = SUM( time - timeDat ) + CALL Check( 'Reading time (array) back from netCDF file', rc, pCt, tCt ) + + !========================================================================= + ! Read the PS variable + !========================================================================= + + ! Read data + ALLOCATE( ps( XDim, YDim, TDim ) ) + st3d = (/ 1, 1, 1 /) + ct3d = (/ XDim, YDim, TDim /) + CALL NcRd( ps, fId, 'PS', st3d, ct3d ) + + ! Equality test + rc = SUM( PS ) - SIZE( PS ) + CALL Check( 'Reading PS back from netCDF file', rc, pCt, tCt ) + + ! Read units attribute + CALL NcGet_Var_Attributes( fId, 'PS', 'units', attValue ) + IF ( TRIM( attValue ) == 'hPa' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading PS:units back from netCDF file', rc, pCt, tCt ) + + ! Read long_name attribute + CALL NcGet_Var_Attributes( fId, 'PS', 'long_name', attValue ) + IF ( TRIM( attValue ) == 'Surface Pressure' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading PS:long_name back from netCDF file', rc, pCt, tCt ) + + !========================================================================= + ! Read the T variable + !========================================================================= + + ! Read data + ALLOCATE( T( XDim, YDim, ZDim, TDim ) ) + st4d = (/ 1, 1, 1, 1 /) + ct4d = (/ XDim, YDim, ZDim, TDim /) + CALL NcRd( T, fId, 'T', st4d, ct4d ) + + ! Equality test + rc = SUM( t ) - SIZE( t ) + CALL Check( 'Reading T back from netCDF file', rc, pCt, tCt ) + + ! Read units attribute + CALL NcGet_Var_Attributes( fId, 'T', 'units', attValue ) + IF ( TRIM( attValue ) == 'K' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading T:units back from netCDF file', rc, pCt, tCt ) + + ! Read long_name attribute + CALL NcGet_Var_Attributes( fId, 'T', 'long_name', attValue ) + IF ( TRIM( attValue ) == 'Temperature' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading T:long_name back from netCDF file', rc, pCt, tCt ) + + !========================================================================= + ! Read the DESC variable + !========================================================================= + + ! Read data + ALLOCATE( DESC( CDim1, CDim2 ) ) + st2d = (/ 1, 1 /) + ct2d = (/ CDim1, CDim2 /) + CALL NcRd( DESC, fId, 'DESC', st2d, ct2d ) + + ! Check that DESC was read properly + rc = 0 + DO i = 1, ICHAR2 + IF ( ICHAR( DESC(1,i) ) - 64 /= I ) rc = 1 + IF ( ICHAR( DESC(2,i) ) - 96 /= I ) rc = 1 + ENDDO + CALL Check( 'Reading DESC back from netCDF file', rc, pCt, tCt ) + + ! Read units attribute + CALL NcGet_Var_Attributes( fId, 'DESC', 'units', attValue ) + IF ( TRIM( attValue ) == '1' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading DESC:units back from netCDF file', rc, pCt, tCt ) + + ! Read long_name attribute + CALL NcGet_Var_Attributes( fId, 'T', 'long_name', attValue ) + IF ( TRIM( attValue ) == 'Temperature' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading DESC:long_name back from netCDF file', rc, pCt, tCt ) + + + !========================================================================= + ! Read global attributes + !========================================================================= + + ! Read title attribute + CALL NcGet_Glob_Attributes( fId, 'title', attValue ) + IF ( TRIM( attValue ) == 'NcdfUtilities test file' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading title back from netCDF file', rc, pCt, tCt ) + + ! Read start_date + CALL NcGet_Glob_Attributes( fId, 'start_date', attValue ) + IF ( TRIM( attValue ) == '20110101' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading start_date back from netCDF file', rc, pCt, tCt ) + + ! Read start_time + CALL NcGet_Glob_Attributes( fId, 'start_time', attValue ) + IF ( TRIM( attValue ) == '00:00:00.0' ) THEN + rc = 0 + ELSE + rc = -1 + ENDIF + CALL Check( 'Reading start_time back from netCDF file', rc, pCt, tCt ) + + ! Close netCDF file + CALL NcCl( fId ) + + ! Cleanup + IF ( ALLOCATED( lon ) ) DEALLOCATE( lon ) + IF ( ALLOCATED( lat ) ) DEALLOCATE( lat ) + IF ( ALLOCATED( lev ) ) DEALLOCATE( lev ) + IF ( ALLOCATED( time ) ) DEALLOCATE( time ) + IF ( ALLOCATED( PS ) ) DEALLOCATE( PS ) + IF ( ALLOCATED( T ) ) DEALLOCATE( T ) + + ! Echo info + WRITE( 6, '(a)' ) '=== End of netCDF file read test! ===' + + END SUBROUTINE TestNcdfRead +!EOC +!------------------------------------------------------------------------------ +! Harvard University Atmospheric Chemistry Modeling Group ! +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: Check +! +! !DESCRIPTION: Subroutine that prints "PASSED" or "FAILED" after each test. +! Also increments the various counters of passed or failed tests. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE Check( msg, rc, passCt, totCt ) +! +! !INPUT PARAMETERS: +! + CHARACTER(LEN=*), INTENT(IN) :: msg ! message to print + INTEGER, INTENT(IN) :: rc ! Return code +! +! !INPUT/OUTPUT PARAMETERS: +! + INTEGER, INTENT(INOUT) :: passCt ! # of passed tests + INTEGER, INTENT(INOUT) :: totCt ! # of total tests +! +! !REVISION HISTORY: +! 03 Jul 2008 - R. Yantosca (Harvard University) - Initial version +! 14 Jun 2012 - R. Yantosca - Now add 10 more . characters +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + INTEGER :: s + + ! length of message + s = LEN( msg ) + + IF ( rc == 0 ) THEN + WRITE( 6, '(a)' ) msg // REPEAT( '.', 55-s ) // 'PASSED' + passCt = passCt + 1 + ELSE + WRITE( 6, '(a)' ) msg // REPEAT( '.', 55-s ) // 'FAILED' + ENDIF + + totCt = totCt + 1 + + END SUBROUTINE Check +!EOC + +END PROGRAM TestNcdfUtil + diff --git a/code/NcdfUtil/m_do_err_out.F90 b/code/NcdfUtil/m_do_err_out.F90 new file mode 100644 index 0000000..869619c --- /dev/null +++ b/code/NcdfUtil/m_do_err_out.F90 @@ -0,0 +1,107 @@ +! $Id: m_do_err_out.F90,v 1.1 2009/08/04 14:52:04 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_Do_Err_Outc +! +! !INTERFACE: +! + module m_Do_Err_Out +! + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: +! + public Do_Err_Out +! +! !DESCRIPTION: Provides a routine to print an error message and exit the code. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Do_Err_Out +! +! !INTERFACE: +! + subroutine Do_Err_Out & + (err_msg, err_do_stop, err_num_ints, err_int1, err_int2, & + err_num_reals, err_real1, err_real2) +! + implicit none +! +! !INPUT PARAMETERS: +!! err_msg : error message to be printed out +!! err_do_stop : do stop on error? +!! err_num_ints : number of integers to be printed out (0, 1, or 2) +!! err_int1 : integer 1 to print out +!! err_int2 : integer 2 to print out +!! err_num_reals : number of reals to be printed out (0, 1, or 2) +!! err_real1 : real 1 to print out +!! err_real2 : real 2 to print out + character (len=*), intent(in) :: err_msg + logical , intent(in) :: err_do_stop + integer , intent(in) :: err_num_ints + integer , intent(in) :: err_int1 + integer , intent(in) :: err_int2 + integer , intent(in) :: err_num_reals + real*8 , intent(in) :: err_real1 + real*8 , intent(in) :: err_real2 +! +! !DESCRIPTION: Outputs error messages, and exits if requested. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC + Write (6,*) + Write (6,*) & + '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + + Write (6,*) '!! ' // Trim (err_msg) + + if (err_num_ints == 1) then + Write (6,*) '!! ', err_int1 + else if (err_num_ints == 2) then + Write (6,*) '!! ', err_int1, err_int2 + end if + + if (err_num_reals == 1) then + Write (6,*) '!! ', err_real1 + else if (err_num_reals == 2) then + Write (6,*) '!! ', err_real1, err_real2 + end if + + Write (6,*) & + '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!' + Write (6,*) + + if (err_do_stop) then + stop "Code stopped from Do_Err_Out." + end if + + return + + end subroutine Do_Err_Out +!EOC +!------------------------------------------------------------------------ +end module m_Do_Err_Out diff --git a/code/NcdfUtil/m_netcdf_io_checks.F90 b/code/NcdfUtil/m_netcdf_io_checks.F90 new file mode 100644 index 0000000..4b5e076 --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_checks.F90 @@ -0,0 +1,139 @@ +! $Id: m_netcdf_io_checks.F90,v 1.1 2009/08/04 14:52:04 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_checks +! +! !INTERFACE: +! + module m_netcdf_io_checks +! + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: +! + public Ncdoes_Udim_Exist + public Ncdoes_Var_Exist +! +! !DESCRIPTION: Routines to check if a netCDF file contains a specified +! variable. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! +! !FUNCTION: Ncdoes_Udim_Exist +! +! !INTERFACE: +! + function Ncdoes_Udim_Exist (ncid) +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to check + integer, intent (in) :: ncid +! +! !DESCRIPTION: Checks a given netCDF file to see if it contains an +! unlimited dimension. +!\\ +!\\ +! !RETURN VALUE: + logical :: Ncdoes_Udim_Exist +! +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer :: ierr + integer :: udimid +! + ierr = Nf_Inq_Unlimdim (ncid, udimid) + + if (ierr == NF_NOERR) then + Ncdoes_Udim_Exist = .true. + else + Ncdoes_Udim_Exist = .false. + end if + + return + + end function Ncdoes_Udim_Exist +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !FUNCTION: Ncdoes_Var_Exist +! +! !INTERFACE: +! + function Ncdoes_Var_Exist (ncid, varname) +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to check +!! varname : netCDF variable name to check + integer, intent (in) :: ncid + character (len=*), intent (in) :: varname +! +! !DESCRIPTION: Checks a given netCDF file to see if a given netCDF variable +! exists in it. +!\\ +!\\ +! !RETURN VALUE: + logical :: Ncdoes_Var_Exist +! +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr == NF_NOERR) then + Ncdoes_Var_Exist = .true. + else + Ncdoes_Var_Exist = .false. + end if + + return + + end function Ncdoes_Var_Exist +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_checks + diff --git a/code/NcdfUtil/m_netcdf_io_close.F90 b/code/NcdfUtil/m_netcdf_io_close.F90 new file mode 100644 index 0000000..5c515b9 --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_close.F90 @@ -0,0 +1,125 @@ +! $Id: m_netcdf_io_close.F90,v 1.1 2009/08/04 14:52:04 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_close +! +! !INTERFACE: +! + module m_netcdf_io_close +! + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: +! + public Nccl + public Nccl_Noerr +! +! !DESCRIPTION: Routines to close a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Nccl +! +! !INTERFACE: +! + subroutine Nccl (ncid) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id + integer, intent (in) :: ncid +! +! !DESCRIPTION: Closes a netCDF file with file id ncid. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr +! + ierr = Nf_Close (ncid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Nccl: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Nccl +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Nccl_Noerr +! +! !INTERFACE: +! + subroutine Nccl_Noerr (ncid) +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id + integer, intent (in) :: ncid +! +! !DESCRIPTION: Closes a netCDF file (with file id ncid) if it is open and +! suppresses Ncclos error messages/exit if it is not. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + integer :: ierr +! + ierr = Nf_Close (ncid) + + return + + end subroutine Nccl_Noerr +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_close + diff --git a/code/NcdfUtil/m_netcdf_io_create.F90 b/code/NcdfUtil/m_netcdf_io_create.F90 new file mode 100644 index 0000000..4aa8135 --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_create.F90 @@ -0,0 +1,154 @@ +! $Id: m_netcdf_io_create.F90,v 1.1 2009/08/04 14:52:04 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_create +! +! !INTERFACE: +! + module m_netcdf_io_create +! + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: +! + public Nccr_Wr + public Ncdo_Sync +! +! !DESCRIPTION: Routines for creating and syncronizing netCDF files. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! 07 Nov 2011 - R. Yantosca - Also give the option to create a netCDF4 file +!EOP +!------------------------------------------------------------------------- + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Nccr_Wr +! +! !INTERFACE: +! + subroutine Nccr_Wr (ncid, filname, WRITE_NC4) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : opened netCDF file id +! filname : name of netCDF file to open for writing + integer , intent(in) :: ncid + character (len=*), intent(in) :: filname + LOGICAL, OPTIONAL, INTENT(IN) :: WRITE_NC4 +! +! !DESCRIPTION: Creates a netCDF file for writing and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REMARKS: +! If the netCDF4 library is used, then the NF_CLOBBER flag will write +! a classic (i.e. netCDF3) file. Use NF_64_BIT_OFFSET to create a +! netCDF 4 file. (bmy, 11/7/11) +! +! !REVISION HISTORY: +! Initial code. +! 07 Nov 2011 - R. Yantosca - Also give the option to create a netCDF4 file +! by passing the optional WRITE_NC4 argument +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + LOGICAL :: TMP_NC4 +! + ! Save the value of the optional WRITE_NC4 variable in + ! a local shadow variable (bmy, 11/7/11) + IF ( PRESENT( WRITE_NC4 ) ) THEN + TMP_NC4 = WRITE_NC4 + ELSE + TMP_NC4 = .FALSE. + ENDIF + + IF ( TMP_NC4 ) THEN + ierr = Nf_Create (filname, NF_64BIT_OFFSET, ncid) ! netCDF4 file + ELSE + ierr = Nf_Create (filname, NF_CLOBBER, ncid) ! netCDF3 file + ENDIF + + if (ierr /= NF_NOERR) then + err_msg = 'In Nccr_Wr, cannot create: ' // Trim (filname) + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0 , 0.0d0, 0.0d0) + end if + + return + + end subroutine Nccr_Wr +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncdo_Sync +! +! !INTERFACE: +! + subroutine Ncdo_Sync (ncid) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id + integer, intent(in) :: ncid +! +! !DESCRIPTION: Synchronizes a netCDF file. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr +! + ierr = Nf_Sync (ncid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncdo_Sync: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Ncdo_Sync +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_create diff --git a/code/NcdfUtil/m_netcdf_io_define.F90 b/code/NcdfUtil/m_netcdf_io_define.F90 new file mode 100644 index 0000000..90af0de --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_define.F90 @@ -0,0 +1,360 @@ +! $Id: m_netcdf_io_define.F90,v 1.1 2009/08/04 14:52:04 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_define +! +! !INTERFACE: +! + module m_netcdf_io_define +! + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: +! + public NcDef_dimension + public NcDef_variable + public NcDef_var_attributes + public NcDef_glob_attributes + public NcSetFill + public NcEnd_def +! +! !DESCRIPTION: Provides netCDF utility routines to define dimensions, +! variables and attributes. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NcDef_dimension +! +! !INTERFACE: +! + subroutine NcDef_dimension(ncid,name,len,id) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include 'netcdf.inc' +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id +!! name : dimension name +!! len : dimension number + character (len=*), intent(in) :: name + integer, intent(in) :: ncid, len +! +! !OUTPUT PARAMETERS: +!! id : dimension id + integer, intent(out) :: id +! +! !DESCRIPTION: Defines dimension. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou and Maharaj Bhat +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr +! + ierr = Nf_Def_Dim (ncid, name, len, id) + + if (ierr.ne.NF_NOERR) then + err_msg = 'Nf_Def_Dim: can not define dimension : '// Trim (name) + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + end if + + return + end subroutine NcDef_dimension +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NcDef_variable +! +! !INTERFACE: +! + subroutine NcDef_variable(ncid,name,type,ndims,dims,var_id) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include 'netcdf.inc' +! +! !INPUT PARAMETERS: +! +!! ncid : netCDF file id +!! name : name of the variable +!! type : type of the variable +!! (NF_FLOAT, NF_CHAR, NF_INT, NF_DOUBLE, NF_BYTE, NF_SHORT) +!! ndims : number of dimensions of the variable +!! dims : netCDF dimension id of the variable +!! varid : netCDF varid id + + character (len=*), intent(in) :: name + integer, intent(in) :: ncid, ndims, var_id + integer, intent(in) :: dims(ndims) + integer, intent(in) :: type +! +! !DESCRIPTION: Defines a netCDF variable. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou and Maharaj Bhat +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr +! + ierr = Nf_Def_Var (ncid, name, type, ndims, dims, var_id) + + if (ierr.ne.NF_NOERR) then + err_msg = 'Nf_Def_Var: can not define variable : '// Trim (name) + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine NcDef_variable +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NcDef_var_attributes +! +! !INTERFACE: +! + subroutine NcDef_var_attributes(ncid,var_id,att_name,att_val) +! +! !USES: +! + use m_do_err_out +! + implicit none + include 'netcdf.inc' +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id +!! var_id : netCDF variable id +!! att_name: attribute name +!! att_val : attribute value + character (len=*), intent(in) :: att_name, att_val + integer, intent(in) :: ncid, var_id +! +! !DESCRIPTION: Defines netCDF attributes. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou and Maharaj Bhat +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: mylen, ierr +! + mylen = len(att_val) + ierr = Nf_Put_Att_Text (ncid, var_id, att_name, mylen, att_val) + + if (ierr.ne.NF_NOERR) then + err_msg = 'Nf_Put_Att_Text: can not define attribute : ' // Trim (att_name) + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine NcDef_var_attributes +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NcDef_glob_attributes +! +! !INTERFACE: +! + subroutine NcDef_glob_attributes(ncid,att_name,att_val) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include 'netcdf.inc' +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id +!! att_name: attribute name +!! att_val : attribute value +! + character (len=*), intent(in) :: att_name, att_val + integer, intent(in) :: ncid +! +! !DESCRIPTION: Defines global attributes +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: mylen, ierr +! + mylen = len(att_val) + ierr = Nf_Put_Att_Text (ncid, NF_GLOBAL, att_name, mylen, att_val) + + if (ierr.ne.NF_NOERR) then + err_msg = 'Nf_Put_Att_Text: can not define attribute : ' // Trim (att_name) + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine NcDef_glob_attributes +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NcSetFill +! +! !INTERFACE: +! + subroutine NcSetFill(ncid,ifill,omode) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include 'netcdf.inc' +! +! !INPUT PARAMETERS: +! + integer, intent(in) :: ncid, ifill,omode +! +! !DESCRIPTION: Sets fill method. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: mylen, ierr +! + ierr = Nf_Set_Fill (ncid, NF_NOFILL, omode) + + if (ierr.ne.NF_NOERR) then + err_msg = 'Nf_Put_Att_Text: Error in omode ' + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine NcSetFill +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: NcEnd_def +! +! !INTERFACE: +! + subroutine NcEnd_def(ncid) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include 'netcdf.inc' +! +! !INPUT PARAMETERS: +! + integer, intent(in) :: ncid +! +! !DESCRIPTION: Ends definitions of variables and their attributes. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr +! + ierr = Nf_Enddef (ncid) + + if (ierr.ne.NF_NOERR) then + err_msg = 'Nf_Put_Att_Text: Error in closing global attribute' + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine NcEnd_def +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_define diff --git a/code/NcdfUtil/m_netcdf_io_get_dimlen.F90 b/code/NcdfUtil/m_netcdf_io_get_dimlen.F90 new file mode 100644 index 0000000..a7b0b71 --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_get_dimlen.F90 @@ -0,0 +1,159 @@ +! $Id: m_netcdf_io_get_dimlen.F90,v 1.1 2009/08/04 14:52:04 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_get_dimlen +! +! !INTERFACE: +! + module m_netcdf_io_get_dimlen +! + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: +! + public Ncget_Dimlen + public Ncget_Unlim_Dimlen +! +! !DESCRIPTION: Provides routines to obtain the length of a given dimension. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncget_Dimlen +! +! !INTERFACE: +! + subroutine Ncget_Dimlen (ncid, dim_name, dim_len) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include 'netcdf.inc' +! +! !INPUT PARAMETERS: +!! dim_name : netCDF dimension name +!! ncid : netCDF file id + character (len=*), intent(in) :: dim_name + integer, intent(in) :: ncid +! +! !OUTPUT PARAMETERS: +!! dim_len: netCDF dimension length + integer, intent(out) :: dim_len +! +! !DESCRIPTION: Returns the length of a given netCDF dimension. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: dimid + integer :: ierr +! + ierr = Nf_Inq_Dimid (ncid, dim_name, dimid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncget_Dimlen #1: ' // Trim (dim_name) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Inq_Dimlen (ncid, dimid, dim_len) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncget_Dimlen #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, dimid, 0, 0.0d0, 0.0d0) + end if + + return + end subroutine Ncget_Dimlen +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncget_Unlim_Dimlen +! +! !INTERFACE: +! + subroutine Ncget_Unlim_Dimlen (ncid, udim_len) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include 'netcdf.inc' +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id + integer, intent(in) :: ncid +! +! !OUTPUT PARAMETERS: +!! udim_len : netCDF unlimited dimension length + integer, intent(out) :: udim_len +! +! !DESCRIPTION: Returns the length of the unlimited netCDF dimension. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: udimid +! + ierr = Nf_Inq_Unlimdim (ncid, udimid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncget_Unlim_Dimlen #1: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Inq_Dimlen (ncid, udimid, udim_len) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncget_Unlim_Dimlen #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, udimid, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Ncget_Unlim_Dimlen +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_get_dimlen diff --git a/code/NcdfUtil/m_netcdf_io_handle_err.F90 b/code/NcdfUtil/m_netcdf_io_handle_err.F90 new file mode 100644 index 0000000..ba8821a --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_handle_err.F90 @@ -0,0 +1,80 @@ +! $Id: m_netcdf_io_handle_err.F90,v 1.1 2009/08/04 14:52:04 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_handle_err +! +! !INTERFACE: +! + module m_netcdf_io_handle_err +! + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: +! + public Nchandle_Err +! +! !DESCRIPTION: Provides a routine to handle error messages. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Nchandle_Err +! +! !INTERFACE: +! + subroutine Nchandle_Err (ierr) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +! ierr : netCDF error number + integer, intent (in) :: ierr +! +! !DESCRIPTION: Handles netCDF errors. Prints out a message and then exit. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg +! + err_msg = 'In Nchandle_Err: ' // Nf_Strerror (ierr) + + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + + return + + end subroutine Nchandle_Err +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_handle_err + diff --git a/code/NcdfUtil/m_netcdf_io_open.F90 b/code/NcdfUtil/m_netcdf_io_open.F90 new file mode 100644 index 0000000..1fdbfbd --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_open.F90 @@ -0,0 +1,147 @@ +! $Id: m_netcdf_io_open.F90,v 1.1 2009/08/04 14:52:04 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_open +! +! !INTERFACE: +! + module m_netcdf_io_open +! + implicit none +! +! !PUBLIC MEMBER FUNCTIONS: +! + public Ncop_Rd + public Ncop_Wr +! +! !DESCRIPTION: Routines to open a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- + +CONTAINS + +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncop_Rd +! +! !INTERFACE: +! + subroutine Ncop_Rd (ncid, filname) +! +! !USES: +! + use m_do_err_out +! USE NETCDF +! + implicit none +! + include "netcdf.inc" + +! +! !INPUT PARAMETERS: +!! filname : name of netCDF file to open for reading + character (len=*), intent (in) :: filname +! +! !OUTPUT PARAMETERS: +!! ncid : opened netCDF file id + integer , intent (out) :: ncid +! +! !DESCRIPTION: Opens a netCDF file for reading and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr +! + ierr = Nf_Open (trim(filname), NF_NOWRITE, ncid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncop_Rd, cannot open: ' // Trim (filname) + PRINT *,"NetCDF Error Message: " + PRINT *, NF_STRERROR(ierr) + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Ncop_Rd +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncop_Wr +! +! !INTERFACE: +! + subroutine Ncop_Wr (ncid, filname) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! filname : name of netCDF file to open for reading + character (len=*), intent (in) :: filname +! +! !OUTPUT PARAMETERS: +!! ncid : opened netCDF file id + integer , intent (out) :: ncid +! +! !DESCRIPTION: Opens a netCDF file for reading/writing and does some +! error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr +! + ierr = Nf_Open (filname, NF_WRITE, ncid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncop_Rd, cannot open: ' // Trim (filname) + call Do_Err_Out (err_msg, .true., 0, 0, 0, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Ncop_Wr +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_open + diff --git a/code/NcdfUtil/m_netcdf_io_read.F90 b/code/NcdfUtil/m_netcdf_io_read.F90 new file mode 100644 index 0000000..3ac3f0d --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_read.F90 @@ -0,0 +1,1437 @@ +! $Id: m_netcdf_io_read.F90,v 1.1 2009/08/04 14:52:05 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_read +! +! !INTERFACE: +! + MODULE m_netcdf_io_read +! +! !USES: +! + IMPLICIT NONE + PRIVATE +! +! !PUBLIC MEMBER FUNCTIONS: +! + ! Public interface + PUBLIC :: NcRd + + ! Private methods overloaded by public interface + ! (see below for info about these routines & the arguments they take) + INTERFACE NcRd + MODULE PROCEDURE Ncrd_Scal + MODULE PROCEDURE Ncrd_Scal_Int + MODULE PROCEDURE Ncrd_1d_R8 + MODULE PROCEDURE Ncrd_1d_R4 + MODULE PROCEDURE Ncrd_1d_Int + MODULE PROCEDURE Ncrd_1d_Char + MODULE PROCEDURE Ncrd_2d_R8 + MODULE PROCEDURE Ncrd_2d_R4 + MODULE PROCEDURE Ncrd_2d_Int + MODULE PROCEDURE Ncrd_2d_Char + MODULE PROCEDURE Ncrd_3d_R8 + MODULE PROCEDURE Ncrd_3d_R4 + MODULE PROCEDURE Ncrd_3d_Int + MODULE PROCEDURE Ncrd_4d_R8 + MODULE PROCEDURE Ncrd_4d_R4 + MODULE PROCEDURE Ncrd_4d_Int + MODULE PROCEDURE Ncrd_5d_R8 + MODULE PROCEDURE Ncrd_5d_R4 + MODULE PROCEDURE Ncrd_6d_R8 + MODULE PROCEDURE Ncrd_6d_R4 + END INTERFACE +! +! !DESCRIPTION: Routines for reading variables in a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! 03 Jul 2008 - R. Yantosca - Now overload all module methods with a +! single public interface. +! 26 Oct 2011 - R. Yantosca - Add REAL*8 and REAL*4 versions of all +! NCRD_* routines. +! 20 Dec 2011 - R. Yantosca - Added Ncwr_4d_Int +! 20 Dec 2011 - R. Yantosca - Make process more efficient by not casting +! to temporary variables after file read +!EOP +!------------------------------------------------------------------------- +!BOC +CONTAINS +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_Scal +! +! !INTERFACE: +! + subroutine Ncrd_Scal (varrd_scal, ncid, varname) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read variable from +!! varname : netCDF variable name + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname +! +! !OUTPUT PARAMETERS: +!! varrd_scal : variable to fill + real*8 , intent(out) :: varrd_scal +! +! !DESCRIPTION: Reads in a netCDF scalar variable. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid + real*4 :: varrd_scal_tmp +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_Scal #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Var_Real (ncid, varid, varrd_scal_tmp) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_Scal #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + varrd_scal = varrd_scal_tmp + + return + + end subroutine Ncrd_Scal +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_Scal_Int +! +! !INTERFACE: +! + subroutine Ncrd_Scal_Int (varrd_scali, ncid, varname) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read variable from +!! varname : netCDF variable name + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname +! +! !OUTPUT PARAMETERS: +!! varrd_scali : integer variable to fill + integer , intent(out) :: varrd_scali +! +! !DESCRIPTION: Reads in a netCDF integer scalar variable. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_Scal_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Var_Int (ncid, varid, varrd_scali) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_Scal_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Ncrd_Scal_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_1d_R8 +! +! !INTERFACE: +! + subroutine Ncrd_1d_R8 (varrd_1d, ncid, varname, strt1d, cnt1d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varrd_1d where +!! the first of the data values will be read +!! cnt1d : varrd_1d dimension + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) +! +! !OUTPUT PARAMETERS: +!! varrd_1d : array to fill + real*8 , intent(out) :: varrd_1d(cnt1d(1)) +! +! !DESCRIPTION: Reads in a 1D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_1d_R8. REAL*8 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_1d directly from file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_GET_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_1d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Double (ncid, varid, strt1d, cnt1d, varrd_1d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_1d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_1d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_1d_R4 +! +! !INTERFACE: +! + subroutine Ncrd_1d_R4 (varrd_1d, ncid, varname, strt1d, cnt1d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varrd_1d where +!! the first of the data values will be read +!! cnt1d : varrd_1d dimension + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) +! +! !OUTPUT PARAMETERS: +!! varrd_1d : array to fill + real*4 , intent(out) :: varrd_1d(cnt1d(1)) +! +! !DESCRIPTION: Reads in a 1D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_1d_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_1d directly from file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_1d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Real (ncid, varid, strt1d, cnt1d, varrd_1d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_1d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_1d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_1d_Int +! +! !INTERFACE: +! + subroutine Ncrd_1d_Int (varrd_1di, ncid, varname, strt1d, cnt1d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +! +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varrd_1di where +!! the first of the data values will be read +!! cnt1d : varrd_1di dimension + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) +! +! !OUTPUT PARAMETERS: +!! varrd_1di : intger array to fill + integer , intent(out) :: varrd_1di(cnt1d(1)) +! +! !DESCRIPTION: Reads in a 1D netCDF integer array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_1d_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + + ierr = Nf_Get_Vara_Int (ncid, varid, strt1d, cnt1d, varrd_1di) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_1d_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Ncrd_1d_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_2d_R8 +! +! !INTERFACE: +! + subroutine Ncrd_2d_R8 (varrd_2d, ncid, varname, strt2d, cnt2d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varrd_2d where +!! the first of the data values will be read +!! cnt2d : varrd_2d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) +! +! !OUTPUT PARAMETERS: +!! varrd_2d : array to fill + real*8 , intent(out) :: varrd_2d(cnt2d(1), cnt2d(2)) +! +! !DESCRIPTION: Reads in a 2D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_2d_R8. REAL*8 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_2d directly from file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_GET_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_2d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Double (ncid, varid, strt2d, cnt2d, varrd_2d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_2d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_2d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_2d_R4 +! +! !INTERFACE: +! + subroutine Ncrd_2d_R4 (varrd_2d, ncid, varname, strt2d, cnt2d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varrd_2d where +!! the first of the data values will be read +!! cnt2d : varrd_2d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) +! +! !OUTPUT PARAMETERS: +!! varrd_2d : array to fill + real*4 , intent(out) :: varrd_2d(cnt2d(1), cnt2d(2)) +! +! !DESCRIPTION: Reads in a 2D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_2d_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_2d directly from file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_2d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Real (ncid, varid, strt2d, cnt2d, varrd_2d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_2d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_2d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_2d_Int +! +! !INTERFACE: +! + subroutine Ncrd_2d_Int (varrd_2di, ncid, varname, strt2d, cnt2d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varrd_2d where +!! the first of the data values will be read +!! cnt2d : varrd_2di dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) +! +! !OUTPUT PARAMETERS: +!! varrd_2di : intger array to fill + integer , intent(out) :: varrd_2di(cnt2d(1), cnt2d(2)) +! +! !DESCRIPTION: Reads in a 2D netCDF integer array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_2d_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Int (ncid, varid, strt2d, cnt2d, varrd_2di) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_2d_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_2d_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_3d_R8 +! +! !INTERFACE: +! + subroutine Ncrd_3d_R8 (varrd_3d, ncid, varname, strt3d, cnt3d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varrd_3d where +!! the first of the data values will be read +!! cnt3d : varrd_3d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) +! +! !OUTPUT PARAMETERS: +!! varrd_3d : array to fill + real*8 , intent(out) :: varrd_3d(cnt3d(1), cnt3d(2), & + cnt3d(3)) +! +! !DESCRIPTION: Reads in a 3D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_3d_R8. REAL*8 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_3d directly from file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_GET_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_3d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Double (ncid, varid, strt3d, cnt3d, varrd_3d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_3d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_3d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_3d_R4 +! +! !INTERFACE: +! + subroutine Ncrd_3d_R4 (varrd_3d, ncid, varname, strt3d, cnt3d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varrd_3d where +!! the first of the data values will be read +!! cnt3d : varrd_3d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) +! +! !OUTPUT PARAMETERS: +!! varrd_3d : array to fill + real*4 , intent(out) :: varrd_3d(cnt3d(1), cnt3d(2), & + cnt3d(3)) +! +! !DESCRIPTION: Reads in a 3D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_3d_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_3d directly from file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_3d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Real (ncid, varid, strt3d, cnt3d, varrd_3d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_3d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_3d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_3d_Int +! +! !INTERFACE: +! + subroutine Ncrd_3d_Int (varrd_3di, ncid, varname, strt3d, cnt3d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varrd_3d where +!! the first of the data values will be read +!! cnt3d : varrd_3di dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) +! +! !OUTPUT PARAMETERS: +!! varrd_3di : intger array to fill + integer , intent(out) :: varrd_3di(cnt3d(1), cnt3d(2), & + cnt3d(3)) +! +! !DESCRIPTION: Reads in a 3D netCDF integer array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_3d_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Int (ncid, varid, strt3d, cnt3d, varrd_3di) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_3d_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_3d_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_4d_R8 +! +! !INTERFACE: +! + subroutine Ncrd_4d_R8 (varrd_4d, ncid, varname, strt4d, cnt4d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt4d : vector specifying the index in varrd_4d where +!! the first of the data values will be read +!! cnt4d : varrd_4d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) +! +! !OUTPUT PARAMETERS: +!! varrd_4d : array to fill + real*8 , intent(out) :: varrd_4d(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) +! +! !DESCRIPTION: Reads in a 4D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_4d_R8. REAL*8 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_4d directly from file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_GET_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_4d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + + ierr = Nf_Get_Vara_Double (ncid, varid, strt4d, cnt4d, varrd_4d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_4d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_4d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_4d_R4 +! +! !INTERFACE: +! + subroutine Ncrd_4d_R4 (varrd_4d, ncid, varname, strt4d, cnt4d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt4d : vector specifying the index in varrd_4d where +!! the first of the data values will be read +!! cnt4d : varrd_4d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) +! +! !OUTPUT PARAMETERS: +!! varrd_4d : array to fill + real*4 , intent(out) :: varrd_4d(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) +! +! !DESCRIPTION: Reads in a 4D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_4d_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_4d directly from file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_4d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Real (ncid, varid, strt4d, cnt4d, varrd_4d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_4d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_4d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_4d_Int +! +! !INTERFACE: +! + subroutine Ncrd_4d_Int (varrd_4di, ncid, varname, strt4d, cnt4d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varrd_3d where +!! the first of the data values will be read +!! cnt3d : varrd_3di dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) +! +! !OUTPUT PARAMETERS: +!! varrd_3di : intger array to fill + integer , intent(out) :: varrd_4di(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) +! +! !DESCRIPTION: Reads in a 3D netCDF integer array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_3d_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Int (ncid, varid, strt4d, cnt4d, varrd_4di) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_3d_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_4d_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_5d_R8 +! +! !INTERFACE: +! + subroutine Ncrd_5d_R8 (varrd_5d, ncid, varname, strt5d, cnt5d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varrd_5d where +!! the first of the data values will be read +!! cnt5d : varrd_5d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt5d(5) + integer , intent(in) :: cnt5d (5) +! +! !OUTPUT PARAMETERS: +!! varrd_5d : array to fill + real*8 , intent(out) :: varrd_5d(cnt5d(1), cnt5d(2), & + cnt5d(3), cnt5d(4), & + cnt5d(5)) +! +! !DESCRIPTION: Reads in a 5D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_45_R8. REAL*8 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_5d directly from file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_GET_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_5d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Double (ncid, varid, strt5d, cnt5d, varrd_5d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_5d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_5d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_5d_R4 +! +! !INTERFACE: +! + subroutine Ncrd_5d_R4 (varrd_5d, ncid, varname, strt5d, cnt5d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varrd_5d where +!! the first of the data values will be read +!! cnt5d : varrd_5d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt5d(5) + integer , intent(in) :: cnt5d (5) +! +! !OUTPUT PARAMETERS: +!! varrd_5d : array to fill + real*4 , intent(out) :: varrd_5d(cnt5d(1), cnt5d(2), & + cnt5d(3), cnt5d(4), & + cnt5d(5)) +! +! !DESCRIPTION: Reads in a 5D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_45_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_5d directly from file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_5d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Real (ncid, varid, strt5d, cnt5d, varrd_5d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_5d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_5d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_6d_R8 +! +! !INTERFACE: +! + subroutine Ncrd_6d_R8 (varrd_6d, ncid, varname, strt6d, cnt6d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varrd_5d where +!! the first of the data values will be read +!! cnt5d : varrd_5d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt6d(6) + integer , intent(in) :: cnt6d (6) +! +! !OUTPUT PARAMETERS: +!! varrd_5d : array to fill + real*8 , intent(out) :: varrd_6d(cnt6d(1), cnt6d(2), & + cnt6d(3), cnt6d(4), & + cnt6d(5), cnt6d(6)) +! +! !DESCRIPTION: Reads in a 5D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Initial version +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_GET_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_6d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Double (ncid, varid, strt6d, cnt6d, varrd_6d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_6d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_6d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_6d_R4 +! +! !INTERFACE: +! + subroutine Ncrd_6d_R4 (varrd_6d, ncid, varname, strt6d, cnt6d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varrd_5d where +!! the first of the data values will be read +!! cnt5d : varrd_5d dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt6d(6) + integer , intent(in) :: cnt6d (6) +! +! !OUTPUT PARAMETERS: +!! varrd_5d : array to fill + real*4 , intent(out) :: varrd_6d(cnt6d(1), cnt6d(2), & + cnt6d(3), cnt6d(4), & + cnt6d(5), cnt6d(6)) +! +! !DESCRIPTION: Reads in a 5D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Renamed to Ncrd_45_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now read varrd_5d directly from file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_6d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Real (ncid, varid, strt6d, cnt6d, varrd_6d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_6d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_6d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_1d_Char +! +! !INTERFACE: +! + subroutine Ncrd_1d_Char (varrd_1dc, ncid, varname, strt1d, cnt1d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +! +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varrd_1dc where +!! the first of the data values will be read +!! cnt1d : varrd_1dc dimension + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) +! +! !OUTPUT PARAMETERS: +!! varrd_1dc : intger array to fill + character (len=1), intent(out) :: varrd_1dc(cnt1d(1)) +! +! !DESCRIPTION: Reads in a 1D netCDF character array and does some error +! checking. +!\\ +!\\ !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_1d_Char #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Text (ncid, varid, strt1d, cnt1d, varrd_1dc) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_1d_Char #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_1d_Char +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncrd_2d_Char +! +! !INTERFACE: +! + subroutine Ncrd_2d_Char (varrd_2dc, ncid, varname, strt2d, cnt2d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to read array input data from +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varrd_2dc where +!! the first of the data values will be read +!! cnt2d : varrd_2dc dimensions + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) +! +! !OUTPUT PARAMETERS: +!! varrd_2dc : charcter array to fill + character , intent(out) :: varrd_2dc(cnt2d(1), cnt2d(2)) +! +! !DESCRIPTION: Reads in a 2D netCDF character array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_2d_Char #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Get_Vara_Text (ncid, varid, strt2d, cnt2d, varrd_2dc) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncrd_2d_Char #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncrd_2d_Char +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_read + diff --git a/code/NcdfUtil/m_netcdf_io_readattr.F90 b/code/NcdfUtil/m_netcdf_io_readattr.F90 new file mode 100644 index 0000000..41b0d05 --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_readattr.F90 @@ -0,0 +1,562 @@ +!------------------------------------------------------------------------------ +! NASA/GFSC, SIVO, Code 610.3 and +! Harvard Atmospheric Chemistry Modeling Group +!------------------------------------------------------------------------------ +!BOP +! +! !MODULE: m_netcdf_io_readattr +! +! !INTERFACE: +! +MODULE m_netcdf_io_readattr +! +! !USES: + + USE m_do_err_out + + IMPLICIT NONE + PRIVATE + + INCLUDE "netcdf.inc" +! +! !PUBLIC MEMBER FUNCTIONS: +! + PUBLIC :: NcGet_Var_Attributes + INTERFACE NcGet_Var_Attributes + MODULE PROCEDURE NcGet_Var_Attr_C + MODULE PROCEDURE NcGet_Var_Attr_I4 + MODULE PROCEDURE NcGet_Var_Attr_R4 + MODULE PROCEDURE NcGet_Var_Attr_R8 + END INTERFACE + + PUBLIC :: NcGet_Glob_Attributes + INTERFACE NcGet_Glob_Attributes + MODULE PROCEDURE NcGet_Glob_Attr_C + MODULE PROCEDURE NcGet_Glob_Attr_I4 + MODULE PROCEDURE NcGet_Glob_Attr_R4 + MODULE PROCEDURE NcGet_Glob_Attr_R8 + END INTERFACE +! +! !PRIVATE MEMBER FUNCTIONS: +! + PRIVATE :: NcGet_Var_Attr_C + PRIVATE :: NcGet_Var_Attr_I4 + PRIVATE :: NcGet_Var_Attr_R4 + PRIVATE :: NcGet_Var_Attr_R8 + PRIVATE :: NcGet_Glob_Attr_C + PRIVATE :: NcGet_Glob_Attr_I4 + PRIVATE :: NcGet_Glob_Attr_R4 + PRIVATE :: NcGet_Glob_Attr_R8 +! +! !DESCRIPTION: Provides netCDF utility routines to read both netCDF +! variable attributes and global attributes. Individual routines for +! reading attributes of different types are overloaded with F90 +! interfaces. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 30 Apr 2012 - R. Yantosca - Modified for compatibility with netCDF-3 +! 30 Apr 2012 - R. Yantosca - Added comments +!EOP +!------------------------------------------------------------------------------ +!BOC +CONTAINS +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: NcGet_Var_Attr_C +! +! !DESCRIPTION: Returns a variable attribute of type CHARACTER. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE NcGet_Var_Attr_C( fid, varName, attName, attValue ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: fId ! netCDF file ID + CHARACTER(LEN=*), INTENT(IN) :: varName ! netCDF variable name + CHARACTER(LEN=*), INTENT(IN) :: attName ! Name of variable attribute +! +! !OUTPUT PARAMETERS: +! + CHARACTER(LEN=*), INTENT(OUT) :: attValue ! Attribute value +! +! !DESCRIPTION: Reads a variable attribute (CHARACTER type) from a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 31 Jan 2012 - R. Yantosca - Zero attValue before reading attributes +! 30 Apr 2012 - R. Yantosca - Use netCDF library function NF_GET_ATT_TEXT, +! which is compatible w/ netCDF3 +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=128) :: errMsg + INTEGER :: status, vId + + ! Zero return value + attValue = '' + + ! Check if VARNAME is a valid variable + status = Nf_Inq_Varid ( fId, varName, vId ) + + ! Exit w/ error message if VARNAME is not valid + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Var_Attr_C: ' // TRIM( varName ) // & + ', ' // Nf_Strerror( status ) + CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) + ENDIF + + ! Get the attribute + status = Nf_Get_Att_Text( fId, vId, attName, attValue ) + + ! Exit w/ error message if unsuccessful + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Var_Attr_C: cannot read attribute : ' // & + TRIM( attName ) + CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) + endif + + END SUBROUTINE NcGet_Var_Attr_C +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: NcGet_Var_Attr_I4 +! +! !DESCRIPTION: Returns a variable attribute of type INTEGER*4. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE NcGet_Var_Attr_I4( fid, varName, attName, attValue ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: fId ! netCDF file ID + CHARACTER(LEN=*), INTENT(IN) :: varName ! netCDF variable name + CHARACTER(LEN=*), INTENT(IN) :: attName ! Name of variable attribute +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: attValue ! Attribute value +! +! !DESCRIPTION: Reads a variable attribute (INTEGER type) from a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 31 Jan 2012 - R. Yantosca - Zero attValue before reading attributes +! 30 Apr 2012 - R. Yantosca - Use netCDF library function NF_GET_ATT_INT, +! which is compatible w/ netCDF3 +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=128) :: errMsg + INTEGER :: status, vId + + ! Zero return value + attValue = 0 + + ! Check if VARNAME is a valid variable + status = Nf_Inq_Varid ( fId, varName, vId ) + + ! Exit w/ error message if VARNAME is not valid + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Var_Attr_I4: ' // TRIM( varName ) // & + ', ' // Nf_Strerror( status ) + CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) + ENDIF + + ! Get the attribute + status = Nf_Get_Att_Int( fId, vId, attName, attValue ) + + ! Exit w/ error message if unsuccessful + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Var_Attr_I4: cannot read attribute : ' // & + TRIM( attName ) + CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) + endif + + END SUBROUTINE NcGet_Var_Attr_I4 +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: NcGet_Var_Attr_R4 +! +! !DESCRIPTION: Returns a variable attribute of type REAL*4. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE NcGet_Var_Attr_R4( fid, varName, attName, attValue ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: fId ! netCDF file ID + CHARACTER(LEN=*), INTENT(IN) :: varName ! netCDF variable name + CHARACTER(LEN=*), INTENT(IN) :: attName ! Name of variable attribute +! +! !OUTPUT PARAMETERS: +! + REAL*4, INTENT(OUT) :: attValue ! Attribute value +! +! !DESCRIPTION: Reads a variable attribute (REAL*4 type) from a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 31 Jan 2012 - R. Yantosca - Zero attValue before reading attributes +! 30 Apr 2012 - R. Yantosca - Use netCDF library function NF_GET_ATT_REAL, +! which is compatible w/ netCDF3 +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=128) :: errMsg + INTEGER :: status, vId + + ! Zero return value + attValue = 0e0 + + ! Check if VARNAME is a valid variable + status = Nf_Inq_Varid ( fId, varName, vId ) + + ! Exit w/ error message if VARNAME is not valid + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Var_Attr_R4: ' // TRIM( varName ) // & + ', ' // Nf_Strerror( status ) + CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) + ENDIF + + ! Get the attribute + status = Nf_Get_Att_Real( fId, vId, attName, attValue ) + + ! Exit w/ error message if unsuccessful + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Var_Attr_R4: cannot read attribute : ' // & + TRIM( attName ) + CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) + endif + + END SUBROUTINE NcGet_Var_Attr_R4 +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: NcGet_Var_Attr_R4 +! +! !DESCRIPTION: Returns a variable attribute of type REAL*8. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE NcGet_Var_Attr_R8( fid, varName, attName, attValue ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: fId ! netCDF file ID + CHARACTER(LEN=*), INTENT(IN) :: varName ! netCDF variable name + CHARACTER(LEN=*), INTENT(IN) :: attName ! Name of variable attribute +! +! !OUTPUT PARAMETERS: +! + REAL*8, INTENT(OUT) :: attValue ! Attribute value +! +! !DESCRIPTION: Reads a variable attribute (REAL*4 type) from a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 31 Jan 2012 - R. Yantosca - Zero attValue before reading attributes +! 30 Apr 2012 - R. Yantosca - Use internal function NF_GET_ATT_DOUBLE, +! which is compatible w/ netCDF3 +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=128) :: errMsg + INTEGER :: status, vId + + ! Zero return value + attValue = 0d0 + + ! Check if VARNAME is a valid variable + status = Nf_Inq_Varid ( fId, varName, vId ) + + ! Exit w/ error message if VARNAME is not valid + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Var_Attr_R8: ' // TRIM( varName ) // & + ', ' // Nf_Strerror( status ) + CALL Do_Err_Out ( errMsg, .TRUE., 1, fId, 0, 0, 0.0d0, 0.0d0) + ENDIF + + ! Get the attribute + status = Nf_Get_Att_Double( fId, vId, attName, attValue ) + + ! Exit w/ error message if unsuccessful + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Var_Attr_R8: cannot read attribute : ' // & + TRIM( attName ) + CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) + endif + + END SUBROUTINE NcGet_Var_Attr_R8 +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: NcGet_Glob_Attr_C +! +! !DESCRIPTION: Returns a variable attribute of type CHARACTER. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE NcGet_Glob_Attr_C( fid, attName, attValue ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: fId ! netCDF file ID + CHARACTER(LEN=*), INTENT(IN) :: attName ! Name of variable attribute +! +! !OUTPUT PARAMETERS: +! + CHARACTER(LEN=*), INTENT(OUT) :: attValue ! Attribute value +! +! !DESCRIPTION: Reads a global attribute (CHARACTER type) from a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 31 Jan 2012 - R. Yantosca - Zero attValue before reading attributes +! 30 Apr 2012 - R. Yantosca - Use netCDF library function NF_GET_ATT_TEXT, +! which is compatible w/ netCDF3 +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=128) :: errMsg, varName + INTEGER :: status + + ! Zero return value + attValue = '' + + ! Get the attribute + status = Nf_Get_Att_Text( fId, NF_GLOBAL, attName, attValue ) + + ! Exit w/ error message if unsuccessful + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Glob_Attr_C: cannot read attribute : ' // & + TRIM( attName ) + CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) + endif + + END SUBROUTINE NcGet_Glob_Attr_C + +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: NcGet_Glob_Attr_I4 +! +! !DESCRIPTION: Returns a variable attribute of type INTEGER*4. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE NcGet_Glob_Attr_I4( fid, attName, attValue ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: fId ! netCDF file ID + CHARACTER(LEN=*), INTENT(IN) :: attName ! Name of variable attribute +! +! !OUTPUT PARAMETERS: +! + INTEGER, INTENT(OUT) :: attValue ! Attribute value +! +! !DESCRIPTION: Reads a global attribute (INTEGER type) from a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 31 Jan 2012 - R. Yantosca - Zero attValue before reading attributes +! 30 Apr 2012 - R. Yantosca - Use netCDF library function NF_GET_ATT_INT, +! which is compatible w/ netCDF3 +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=128) :: errMsg, varName + INTEGER :: status + + ! Zero return value + attValue = 0 + + ! Get the attribute + status = Nf_Get_Att_Int( fId, NF_GLOBAL, attName, attValue ) + + ! Exit w/ error message if unsuccessful + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Glob_Attr_I4: cannot read attribute : ' // & + TRIM( attName ) + CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) + endif + + END SUBROUTINE NcGet_Glob_Attr_I4 +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: NcGet_Glob_Attr_R4 +! +! !DESCRIPTION: Returns a variable attribute of type REAL*4. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE NcGet_Glob_Attr_R4( fid, attName, attValue ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: fId ! netCDF file ID + CHARACTER(LEN=*), INTENT(IN) :: attName ! Name of variable attribute +! +! !OUTPUT PARAMETERS: +! + REAL*4, INTENT(OUT) :: attValue ! Attribute value +! +! !DESCRIPTION: Reads a global attribute (REAL*4 type) from a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 31 Jan 2012 - R. Yantosca - Zero attValue before reading attributes +! 30 Apr 2012 - R. Yantosca - Use netCDF library function NF_GET_ATT_REAL, +! which is compatible w/ netCDF3 +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=128) :: errMsg, varName + INTEGER :: status + + ! Zero return value + attValue = 0e0 + + ! Get the attribute + status = Nf_Get_Att_Real( fId, NF_GLOBAL, attName, attValue ) + + ! Exit w/ error message if unsuccessful + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Glob_Attr_R4: cannot read attribute : ' // & + TRIM( attName ) + CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) + endif + + END SUBROUTINE NcGet_Glob_Attr_R4 +!EOC +!------------------------------------------------------------------------------ +!BOP +! +! !IROUTINE: NcGet_Glob_Attr_R8 +! +! !DESCRIPTION: Returns a variable attribute of type REAL*8. +!\\ +!\\ +! !INTERFACE: +! + SUBROUTINE NcGet_Glob_Attr_R8( fid, attName, attValue ) +! +! !INPUT PARAMETERS: +! + INTEGER, INTENT(IN) :: fId ! netCDF file ID + CHARACTER(LEN=*), INTENT(IN) :: attName ! Name of variable attribute +! +! !OUTPUT PARAMETERS: +! + REAL*8, INTENT(OUT) :: attValue ! Attribute value +! +! !DESCRIPTION: Reads a global attribute (REAL*8 type) from a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Bob Yantosca (based on code by Jules Kouatchou and Maharaj Bhat) +! +! !REVISION HISTORY: +! 25 Jan 2012 - R. Yantosca - Initial version +! 31 Jan 2012 - R. Yantosca - Zero attValue before reading attributes +! 30 Apr 2012 - R. Yantosca - Use netCDF library function NF_GET_ATT_DOUBLE, +! which is compatible w/ netCDF3 +!EOP +!------------------------------------------------------------------------------ +!BOC +! +! !LOCAL VARIABLES: +! + CHARACTER(LEN=128) :: errMsg, varName + INTEGER :: status + + ! Zero return value + attValue = 0d0 + + ! Get the attribute + status = Nf_Get_Att_Double( fId, NF_GLOBAL, attName, attValue ) + + ! Exit w/ error message if unsuccessful + IF ( status /= NF_NOERR ) THEN + errMsg = 'In NcGet_Glob_Attr_R8: cannot read attribute : ' // & + TRIM( attName ) + CALL Do_Err_Out( errMsg, .TRUE., 0, 0, 0, 0, 0.0d0, 0.0d0 ) + endif + + END SUBROUTINE NcGet_Glob_Attr_R8 +!EOC +END MODULE m_netcdf_io_readattr diff --git a/code/NcdfUtil/m_netcdf_io_write.F90 b/code/NcdfUtil/m_netcdf_io_write.F90 new file mode 100644 index 0000000..583875a --- /dev/null +++ b/code/NcdfUtil/m_netcdf_io_write.F90 @@ -0,0 +1,1392 @@ +! $Id: m_netcdf_io_write.F90,v 1.1 2009/08/04 14:52:05 bmy Exp $ +!------------------------------------------------------------------------- +! NASA/GFSC, SIVO, Code 610.3 +!------------------------------------------------------------------------- +!BOP +! +! !MODULE: m_netcdf_io_write +! +! !INTERFACE: +! + module m_netcdf_io_write +! + IMPLICIT NONE + PRIVATE +! +! !PUBLIC MEMBER FUNCTIONS: +! + ! Public interface + PUBLIC :: NcWr + + ! Private methods overloaded by public interface + ! (see below for info about these routines & the arguments they take) + INTERFACE NcWr + MODULE PROCEDURE Ncwr_Scal + MODULE PROCEDURE Ncwr_Scal_Int + MODULE PROCEDURE Ncwr_1d_R8 + MODULE PROCEDURE Ncwr_1d_R4 + MODULE PROCEDURE Ncwr_1d_Int + MODULE PROCEDURE Ncwr_1d_Char + MODULE PROCEDURE Ncwr_2d_R8 + MODULE PROCEDURE Ncwr_2d_R4 + MODULE PROCEDURE Ncwr_2d_Int + MODULE PROCEDURE Ncwr_2d_Char + MODULE PROCEDURE Ncwr_3d_R8 + MODULE PROCEDURE Ncwr_3d_R4 + MODULE PROCEDURE Ncwr_3d_Int + MODULE PROCEDURE Ncwr_4d_R8 + MODULE PROCEDURE Ncwr_4d_R4 + MODULE PROCEDURE Ncwr_4d_Int + MODULE PROCEDURE Ncwr_5d_R8 + MODULE PROCEDURE Ncwr_5d_R4 + MODULE PROCEDURE Ncwr_6d_R8 + MODULE PROCEDURE Ncwr_6d_R4 + + END INTERFACE +! +! !DESCRIPTION: Routines for writing variables in a netCDF file. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! 26 Oct 2011 - R. Yantosca - Add REAL*8 and REAL*4 versions of all +! NCWR_* routines. +! 20 Dec 2011 - R. Yantosca - Added Ncwr_4d_Int +! 20 Dec 2011 - R. Yantosca - Make process more efficient by not casting +! to temporary variables before file write +!EOP +!------------------------------------------------------------------------- + +CONTAINS + + +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_Scal +! +! !INTERFACE: +! + subroutine Ncwr_Scal (varwr_scal, ncid, varname) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write variable to +!! varname : netCDF variable name +!! varwr_scal : variable to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + real*8 , intent(in) :: varwr_scal +! +! !DESCRIPTION: Writes out a netCDF real scalar variable. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid + real*4 :: varwr_scal_tmp +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_Scal #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + varwr_scal_tmp = varwr_scal + + ierr = Nf_Put_Var_Real (ncid, varid, varwr_scal_tmp) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_Scal #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_Scal +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_Scal_Int +! +! !INTERFACE: +! + subroutine Ncwr_Scal_Int (varwr_scali, ncid, varname) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write variable to +!! varname : netCDF variable name +!! varwr_scali : integer variable to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: varwr_scali +! +! !DESCRIPTION: Writes out a netCDF integer scalar variable. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_Scal_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Var_Int (ncid, varid, varwr_scali) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_Scal_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_Scal_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_1d_R8 +! +! !INTERFACE: +! + subroutine Ncwr_1d_R8 (varwr_1d, ncid, varname, strt1d, cnt1d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varwr_1d where +!! the first of the data values will be written +!! cnt1d : varwr_1d dimension +!! varwr_1d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + real*8 , intent(in) :: varwr_1d(cnt1d(1)) +! +! !DESCRIPTION: Writes out a 1D netCDF real array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to Ncrd_1d_R8. REAL*8 version. +! 20 Dec 2011 - R. Yantosca - Now write varwr_1d directly to file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_PUT_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_1d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Double (ncid, varid, strt1d, cnt1d, varwr_1d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_1d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_1d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_1d_R4 +! +! !INTERFACE: +! + subroutine Ncwr_1d_R4 (varwr_1d, ncid, varname, strt1d, cnt1d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varwr_1d where +!! the first of the data values will be written +!! cnt1d : varwr_1d dimension +!! varwr_1d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + real*4 , intent(in) :: varwr_1d(cnt1d(1)) +! +! !DESCRIPTION: Writes out a 1D netCDF real array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to Ncwr_1d_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now write varwr_1d directly to file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_1d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Real (ncid, varid, strt1d, cnt1d, varwr_1d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_1d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_1d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_1d_Int +! +! !INTERFACE: +! + subroutine Ncwr_1d_Int (varwr_1di, ncid, varname, strt1d, cnt1d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varwr_1di where +!! the first of the data values will be written +!! cnt1d : varwr_1di dimension +!! varwr_1di : intger array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + integer , intent(in) :: varwr_1di(cnt1d(1)) +! +! !DESCRIPTION: Writes out a 1D netCDF integer array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_1d_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Int (ncid, varid, strt1d, cnt1d, varwr_1di) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_1d_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_1d_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_2d_R8 +! +! !INTERFACE: +! + subroutine Ncwr_2d_R8 (varwr_2d, ncid, varname, strt2d, cnt2d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varwr_2d where +!! the first of the data values will be written +!! cnt2d : varwr_2d dimensions +!! varwr_2d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) + real*8 , intent(in) :: varwr_2d(cnt2d(1), cnt2d(2)) +! +! !DESCRIPTION: Writes out a 2D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to Ncwr_2d_R8. REAL*8 version. +! 20 Dec 2011 - R. Yantosca - Now write varwr_2d directly to file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_PUT_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_2d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Double (ncid, varid, strt2d, cnt2d, varwr_2d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_2d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_2d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_2d_R4 +! +! !INTERFACE: +! + subroutine Ncwr_2d_R4 (varwr_2d, ncid, varname, strt2d, cnt2d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varwr_2d where +!! the first of the data values will be written +!! cnt2d : varwr_2d dimensions +!! varwr_2d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) + real*4 , intent(in) :: varwr_2d(cnt2d(1), cnt2d(2)) +! +! !DESCRIPTION: Writes out a 2D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to Ncwr_2d_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now write varwr_2d directly to file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_2d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Real (ncid, varid, strt2d, cnt2d, varwr_2d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_2d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_2d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_2d_Int +! +! !INTERFACE: +! + subroutine Ncwr_2d_Int (varwr_2di, ncid, varname, strt2d, cnt2d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt2d : vector specifying the index in varwr_2di where +!! the first of the data values will be written +!! cnt2d : varwr_2di dimensions +!! varwr_2di : intger array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) + integer , intent(in) :: varwr_2di(cnt2d(1), cnt2d(2)) +! +! !DESCRIPTION: Writes out a 2D netCDF integer array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_2d_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Int (ncid, varid, strt2d, cnt2d, varwr_2di) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_2d_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_2d_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_3d_R8 +! +! !INTERFACE: +! + subroutine Ncwr_3d_R8 (varwr_3d, ncid, varname, strt3d, cnt3d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varwr_3d where +!! the first of the data values will be written +!! cnt3d : varwr_3d dimensions +!! varwr_3d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) + real*8 , intent(in) :: varwr_3d(cnt3d(1), cnt3d(2), cnt3d(3)) +! +! !DESCRIPTION: Writes out a 3D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to NcWr_3d_R8. REAL*8 version +! 20 Dec 2011 - R. Yantosca - Now write varwr_3d directly to file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_PUT_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_3d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Double (ncid, varid, strt3d, cnt3d, varwr_3d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_3d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_3d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_3d_R4 +! +! !INTERFACE: +! + subroutine Ncwr_3d_R4 (varwr_3d, ncid, varname, strt3d, cnt3d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varwr_3d where +!! the first of the data values will be written +!! cnt3d : varwr_3d dimensions +!! varwr_3d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) + real*4 , intent(in) :: varwr_3d(cnt3d(1), cnt3d(2), cnt3d(3)) +! +! !DESCRIPTION: Writes out a 3D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to NcWr_3d_R4. REAL*4 version +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_3d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Real (ncid, varid, strt3d, cnt3d, varwr_3d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_3d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Ncwr_3d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_3d_Int +! +! !INTERFACE: +! + subroutine Ncwr_3d_Int (varwr_3di, ncid, varname, strt3d, cnt3d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varwr_3di where +!! the first of the data values will be written +!! cnt3d : varwr_3di dimensions +!! varwr_3di : intger array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt3d(3) + integer , intent(in) :: cnt3d (3) + integer , intent(in) :: varwr_3di(cnt3d(1), cnt3d(2), cnt3d(3)) +! +! !DESCRIPTION: Writes out a 3D netCDF integer array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_3d_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + + ierr = Nf_Put_Vara_Int (ncid, varid, strt3d, cnt3d, varwr_3di) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_3d_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + return + + end subroutine Ncwr_3d_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_4d_R8 +! +! !INTERFACE: +! + subroutine Ncwr_4d_R8 (varwr_4d, ncid, varname, strt4d, cnt4d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt4d : vector specifying the index in varwr_4d where +!! the first of the data values will be written +!! cnt4d : varwr_4d dimensions +!! varwr_4d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) + real*8 , intent(in) :: varwr_4d(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) +! +! !DESCRIPTION: Writes out a 4D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to NcWr_3d_R8. REAL*8 version +! 20 Dec 2011 - R. Yantosca - Now write varwr_4d directly to file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_PUT_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_4d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + + ierr = Nf_Put_Vara_Double (ncid, varid, strt4d, cnt4d, varwr_4d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_4d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_4d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_4d_R4 +! +! !INTERFACE: +! + subroutine Ncwr_4d_R4 (varwr_4d, ncid, varname, strt4d, cnt4d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt4d : vector specifying the index in varwr_4d where +!! the first of the data values will be written +!! cnt4d : varwr_4d dimensions +!! varwr_4d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) + real*4 , intent(in) :: varwr_4d(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) +! +! !DESCRIPTION: Writes out a 4D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to NcWr_3d_R8. REAL*8 version +! 20 Dec 2011 - R. Yantosca - Now write varwr_4d directly to file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_4d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + + ierr = Nf_Put_Vara_Real (ncid, varid, strt4d, cnt4d, varwr_4d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_4d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_4d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_3d_Int +! +! !INTERFACE: +! + subroutine Ncwr_4d_Int (varwr_4di, ncid, varname, strt4d, cnt4d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt3d : vector specifying the index in varwr_3di where +!! the first of the data values will be written +!! cnt3d : varwr_3di dimensions +!! varwr_3di : intger array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt4d(4) + integer , intent(in) :: cnt4d (4) + integer , intent(in) :: varwr_4di(cnt4d(1), cnt4d(2), & + cnt4d(3), cnt4d(4)) +! +! !DESCRIPTION: Writes out a 3D netCDF integer array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_4d_Int #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + + ierr = Nf_Put_Vara_Int (ncid, varid, strt4d, cnt4d, varwr_4di) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_4d_Int #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_4d_Int +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_5d_R8 +! +! !INTERFACE: +! + subroutine Ncwr_5d_R8 (varwr_5d, ncid, varname, strt5d, cnt5d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varwr_5d where +!! the first of the data values will be written +!! cnt5d : varwr_5d dimensions +!! varwr_5d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt5d(5) + integer , intent(in) :: cnt5d (5) + real*8 , intent(in) :: varwr_5d(cnt5d(1), cnt5d(2), & + cnt5d(3), cnt5d(4), & + cnt5d(5)) +! +! !DESCRIPTION: Writes out a 5D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to NcWr_5d_R8. REAL*8 version +! 20 Dec 2011 - R. Yantosca - Now write varwr_5d directly to file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_PUT_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_5d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Double (ncid, varid, strt5d, cnt5d, varwr_5d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_5d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_5d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_5d_R4 +! +! !INTERFACE: +! + subroutine Ncwr_5d_R4 (varwr_5d, ncid, varname, strt5d, cnt5d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt5d : vector specifying the index in varwr_5d where +!! the first of the data values will be written +!! cnt5d : varwr_5d dimensions +!! varwr_5d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt5d(5) + integer , intent(in) :: cnt5d (5) + real*4 , intent(in) :: varwr_5d(cnt5d(1), cnt5d(2), & + cnt5d(3), cnt5d(4), & + cnt5d(5)) +! +! !DESCRIPTION: Writes out a 5D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to NcWr_5d_R4. REAL*4 version +! 20 Dec 2011 - R. Yantosca - Now write var5d_tmp directly to file + +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_5d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Real (ncid, varid, strt5d, cnt5d, varwr_5d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_5d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_5d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_6d_R8 +! +! !INTERFACE: +! + subroutine Ncwr_6d_R8 (varwr_6d, ncid, varname, strt6d, cnt6d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt6d : vector specifying the index in varwr_6d where +!! the first of the data values will be written +!! cnt6d : varwr_6d dimensions +!! varwr_6d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt6d(6) + integer , intent(in) :: cnt6d (6) + real*8 , intent(in) :: varwr_6d(cnt6d(1), cnt6d(2), & + cnt6d(3), cnt6d(4), & + cnt6d(5), cnt6d(6)) +! +! !DESCRIPTION: Writes out a 6D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to NcWr_6d_R8. REAL*8 version. +! 20 Dec 2011 - R. Yantosca - Now write varwr_6d directly to file +! 20 Dec 2011 - R. Yantosca - Now use netCDF function NF_PUT_VARA_DOUBLE +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_6d_R8 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Double (ncid, varid, strt6d, cnt6d, varwr_6d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_6d_R8 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_6d_R8 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_6d_R4 +! +! !INTERFACE: +! + subroutine Ncwr_6d_R4 (varwr_6d, ncid, varname, strt6d, cnt6d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt6d : vector specifying the index in varwr_6d where +!! the first of the data values will be written +!! cnt6d : varwr_6d dimensions +!! varwr_6d : array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt6d(6) + integer , intent(in) :: cnt6d (6) + real*4 , intent(in) :: varwr_6d(cnt6d(1), cnt6d(2), & + cnt6d(3), cnt6d(4), & + cnt6d(5), cnt6d(6)) +! +! !DESCRIPTION: Writes out a 6D netCDF real array and does some error checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! 20 Dec 2011 - R. Yantosca - Renamed to NcWr_6d_R4. REAL*4 version. +! 20 Dec 2011 - R. Yantosca - Now write varwr_6d directly to file +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_6d_R4 #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Real (ncid, varid, strt6d, cnt6d, varwr_6d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_6d_R4 #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_6d_R4 +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_1d_Char +! +! !INTERFACE: +! + subroutine Ncwr_1d_Char (varwr_1dc, ncid, varname, strt1d, cnt1d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write array output data to +!! varname : netCDF variable name for array +!! strt1d : vector specifying the index in varwr_1dc where +!! the first of the data values will be written +!! cnt1d : varwr_1dc dimension +!! varwr_1dc : intger array to write out + integer , intent(in) :: ncid + character (len=*), intent(in) :: varname + integer , intent(in) :: strt1d(1) + integer , intent(in) :: cnt1d (1) + character (len=1), intent(in) :: varwr_1dc(cnt1d(1)) +! +! !DESCRIPTION: Writes out a 1D netCDF character array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: varid +! + ierr = Nf_Inq_Varid (ncid, varname, varid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_1d_Char #1: ' // Trim (varname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + ierr = Nf_Put_Vara_Text (ncid, varid, strt1d, cnt1d, varwr_1dc) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_1d_Char #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, varid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_1d_Char +!EOC +!------------------------------------------------------------------------- +!BOP +! +! !IROUTINE: Ncwr_2d_Char +! +! !INTERFACE: +! + subroutine Ncwr_2d_Char (char_2d, ncid, tvarname, strt2d, cnt2d) +! +! !USES: +! + use m_do_err_out +! + implicit none +! + include "netcdf.inc" +! +! !INPUT PARAMETERS: +!! ncid : netCDF file id to write text to +!! tvarname : netCDF variable name for text +!! strt2d : vector specifying the index in char_2d where +!! the first of the data values will be written +!! cnt2d : char_2d dimensions +!! char_2d : text to write + integer , intent(in) :: ncid + character (len=*), intent(in) :: tvarname + integer , intent(in) :: strt2d(2) + integer , intent(in) :: cnt2d (2) + character (len=1), intent(in) :: char_2d(cnt2d(1), cnt2d(2)) +! +! !DESCRIPTION: Writes out a 2D netCDF character array and does some error +! checking. +!\\ +!\\ +! !AUTHOR: +! John Tannahill (LLNL) and Jules Kouatchou +! +! !REVISION HISTORY: +! Initial code. +! +!EOP +!------------------------------------------------------------------------- +!BOC +! +! !LOCAL VARIABLES: + character (len=128) :: err_msg + integer :: ierr + integer :: tvarid +! + ierr = Nf_Inq_Varid (ncid, tvarname, tvarid) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_2d_Char #1: ' // Trim (tvarname) // & + ', ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 1, ncid, 0, 0, 0.0d0, 0.0d0) + end if + + + ierr = Nf_Put_Vara_Text (ncid, tvarid, strt2d, cnt2d, char_2d) + + if (ierr /= NF_NOERR) then + err_msg = 'In Ncwr_2d_Char #2: ' // Nf_Strerror (ierr) + call Do_Err_Out (err_msg, .true., 2, ncid, tvarid, 0, 0.0d0, 0.0d0) + end if + + end subroutine Ncwr_2d_Char +!EOC +!------------------------------------------------------------------------ +end module m_netcdf_io_write + diff --git a/code/NcdfUtil/perl/StrTrim.pm b/code/NcdfUtil/perl/StrTrim.pm new file mode 100644 index 0000000..b2718eb --- /dev/null +++ b/code/NcdfUtil/perl/StrTrim.pm @@ -0,0 +1,188 @@ +#!/usr/bin/perl -w + +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: StrTrim +# +# !DESCRIPTION: This Perl package contains routines for splitting a line +# into substrings and removing trailing and leading whitespace. Used by +# the ncCode* scripts. +#\\ +#\\ +# !INTERFACE: +# +package StrTrim; +# +# !USES: +# + require 5.003; # Need this version of Perl or newer + use English; # Use English language + use Carp; # Get detailed error messages + use strict; # Force explicit variable declarations (like IMPLICIT NONE) +# +# +# !PUBLIC MEMBER FUNCTIONS: +# &trim($) +# &splitLine($$) +# +# !CALLING SEQUENCE: +# use StrTrim qw( trim splitLine extractFile ); +# +# !REVISION HISTORY: +# 30 Jan 2012 - R. Yantosca - Initial version +# 26 Mar 2012 - R. Yantosca - Add function &extractFile +#EOP +#------------------------------------------------------------------------------ +#BOC +BEGIN { + + #========================================================================= + # The BEGIN method lists the names to export to the calling routine + #========================================================================= + use Exporter (); + use vars qw( $VERSION @ISA @EXPORT_OK ); + + $VERSION = 1.00; # version number + @ISA = qw( Exporter ); # export method + @EXPORT_OK = qw( &trim &splitLine &extractFile ); +} +#EOC +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !IROUTINE: trim +# +# !DESCRIPTION: Routine trim removes leading and trailing whitespace from +# a string (analogous to IDL's Strtrim( str, 2 ) command). +#\\ +#\\ +# !INTERFACE: +# +sub trim($) { +# +# !CALLING SEQUENCE: +# $string = &trim( $string ); +# +# !REMARKS: +# Found online at this URL: +# http://www.somacon.com/p114.php +# +# !REVISION HISTORY: +# 27 Jan 2012 - R. Yantosca - Initial version +#EOP +#------------------------------------------------------------------------------ +#BOC + + # Shift the @_ array + my $string = shift; + + # Remove leading whitespace + $string =~ s/^\s+//; + + # Remove trailing whitespace + $string =~ s/\s+$//; + + # Return + return( $string ); +} +#EOP +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !IROUTINE: splitLine +# +# !DESCRIPTION: Routine splitLine splits a line on a given delimiter, and +# strips white space. Convenience wrapper for the Perl "split" function. +#\\ +#\\ +# !INTERFACE: +# +sub splitLine($$) { +# +# !INPUT PARAMETERS: +# + # Line to be split, and the delimeter character + # Don't strip the white from $value if $noSplitVal==1 + my( $line, $delim ) = @_; +# +# !CALLING SEQUENCE: +# ( $name, $value ) = &splitLine( $line ); +# +# !REVISION HISTORY: +# 27 Jan 2012 - R. Yantosca - Initial version +#EOP +#------------------------------------------------------------------------------ +#BOC +# +# !LOCAL VARIABLES: +# + # Split the line + my @subStr = split( $delim, $line ); + my $name = &trim( $subStr[0] ); + my $value = &trim( $subStr[1] ); + + # Return substrings + return( $name, $value ); +} +#EOP +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !IROUTINE: extractFile +# +# !DESCRIPTION: Routine extractFile splits a full Unix path name into a +# directory string and a file name. +#\\ +#\\ +# !INTERFACE: +# +sub extractFile($) { +# +# !INPUT PARAMETERS: +# + # Full Unix path name + my( $path ) = @_; +# +# !CALLING SEQUENCE: +# ( $file, $dir ) = &extractFile( $path ); +# +# !REVISION HISTORY: +# 26 Mar 2012 - R. Yantosca - Initial version +#EOP +#------------------------------------------------------------------------------ +#BOC +# +# !LOCAL VARIABLES: +# + my $pos = -1; + my $lastPos = -1; + my $dir = ""; + my $file = ""; + + # Search for the last "/" character in the file path + # This is the place where to split the file & directory + while ( ( $pos = index( $path, '/', $pos ) ) > -1 ) { + $lastPos = $pos; + $pos++; + } + + # Directory part of the path + $dir = substr( $path, 0, $lastPos+1 ); + + # Filename part of the path + $file = substr( $path, $lastPos+1, length( $path ) - $lastPos ); + + # Return substrings + return( $file, $dir ); +} +#EOC +END {} diff --git a/code/NcdfUtil/perl/definitions_a1.rc b/code/NcdfUtil/perl/definitions_a1.rc new file mode 100644 index 0000000..b9391d0 --- /dev/null +++ b/code/NcdfUtil/perl/definitions_a1.rc @@ -0,0 +1,269 @@ +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: definitions_a1.rc +# +# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A1 filename, +# variables, and attributes for use with the ncCode* scripts. Also defines +# the names of the files where Fortran code will be written to. +#\\ +#\\ +# !REMARKS: +# This file has been customized to generate GEOS-Chem Fortran code that +# will read data from a GEOS-5.7.2 A1 met field file. +# +# !REVISION HISTORY: +# 27 Jan 2012 - R. Yantosca - Initial version +#------------------------------------------------------------------------------ + +### !FILENAME: +Fortran Read File = a1_read.F +netCDF FileHandle = fId +netCDF FileName = GEOS572.YYYYMMDD.A1.4x5.nc + + +### !DIMENSIONS: +lon = IIPAR +lat = JJPAR +time = 1 + + +### !VARIABLES: +lon = REAL*4::lon +lon:long_name = longitude +lon:units = degrees_east +#- +lat = REAL*4::lat +lat:long_name = latitude +lat:units = degrees_north +#- +time = INTEGER::time +time:long_name = time +time:units = minutes since YYYY-MM-DD 00:00:00.0 +time:delta_t = 0000-00-00 01:00:00 +time:begin_date = YYYYMMDD +time:begin_time = 000000 +time:time_increment = 010000 +#- +ALBEDO = REAL*4::lon,lat,time +ALBEDO:long_name = Surface albedo +ALBEDO:units = fraction +ALBEDO:gamap_category = GMAO-2D +#- +CLDTOT = REAL*4::lon,lat,time +CLDTOT:long_name = Total cloud fraction +CLDTOT:units = fraction +CLDTOT:gamap_category = GMAO-2D +#- +EFLUX = REAL*4::lon,lat,time +EFLUX:long_name = Latent heat flux positive upward +EFLUX:units = W m-2 +EFLUX:gamap_category = GMAO-2D +#- +EVAP = REAL*4::lon,lat,time +EVAP:long_name = Surface evaporation +EVAP:units = kg m-2 s-2 +EVAP:gamap_category = GMAO-2D +#- +FRSEAICE = REAL*4::lon,lat,time +FRSEAICE:long_name = Fraction of sea ice on surface +FRSEAICE:units = fraction +FRSEAICE:gamap_category = GMAO-2D +#- +FRSNO = REAL*4::lon,lat,time +FRSNO:long_name = Fractional snow-covered area +FRSNO:units = fraction +FRSNO:gamap_category = GMAO-2D +#- +GRN = REAL*4::lon,lat,time +GRN:long_name = Vegetation greenness fraction +GRN:units = fraction +GRN:gamap_category = GMAO-2D +#- +GWETROOT = REAL*4::lon,lat,time +GWETROOT:long_name = Root zone soil wetness +GWETROOT:units = fraction +GWETROOT:gamap_category = GMAO-2D +#- +GWETTOP = REAL*4::lon,lat,time +GWETTOP:long_name = Top soil wetness +GWETTOP:units = fraction +GWETTOP:gamap_category = GMAO-2D +#- +HFLUX = REAL*4::lon,lat,time +HFLUX:long_name = Sensible heat flux positive upward +HFLUX:units = W m-2 +HFLUX:gamap_category = GMAO-2D +#- +LAI = REAL*4::lon,lat,time +LAI:long_name = Leaf area index +LAI:units = m2 m-2 +LAI:gamap_category = GMAO-2D +#- +LWI = REAL*4::lon,lat,time +LWI:long_name = Land/water/ice flags +LWI:units = unitless +LWI:gamap_category = GMAO-2D +#- +LWGNT = REAL*4::lon,lat,time +LWGNT:long_name = Net longwave flux at the ground +LWGNT:units = W m-2 +LWGNT:gamap_category = GMAO-2D +#- +LWTUP = REAL*4::lon,lat,time +LWTUP:long_name = Upward longwave flux at top of atmosphere TOA +LWTUP:units = W m-2 +LWTUP:gamap_category = GMAO-2D +#- +PARDF = REAL*4::lon,lat,time +PARDF:long_name = Surface downward PAR diffuse flux +PARDF:units = W m-2 +PARDF:gamap_category = GMAO-2D +#- +PARDR = REAL*4::lon,lat,time +PARDR:long_name = Surface downward PAR beam flux +PARDR:units = W m-2 +PARDR:gamap_category = GMAO-2D +#- +PBLH = REAL*4::lon,lat,time +PBLH:long_name = Planetary boundary layer height above surface +PBLH:units = m +PBLH:gamap_category = GMAO-2D +#- +PRECANV = REAL*4::lon,lat,time +PRECANV:long_name = Surface precipitation flux from anvils +PRECANV:units = kg m-2 s-2 +PRECANV:gamap_category = GMAO-2D +#- +PRECCON = REAL*4::lon,lat,time +PRECCON:long_name = Surface precipitation flux from convection +PRECCON:units = kg m-2 s-2 +PRECCON:gamap_category = GMAO-2D +#- +PRECLSC = REAL*4::lon,lat,time +PRECLSC:long_name = Surface precipitation flux from large-scale +PRECLSC:units = kg m-2 s-2 +PRECLSC:gamap_category = GMAO-2D +#- +PRECSNO = REAL*4::lon,lat,time +PRECSNO:long_name = Surface precipitation flux from snow +PRECSNO:units = kg m-2 s-2 +PRECSNO:gamap_category = GMAO-2D +#- +PRECTOT = REAL*4::lon,lat,time +PRECTOT:long_name = Total surface precipitation flux +PRECTOT:units = kg m-2 s-2 +PRECTOT:gamap_category = GMAO-2D +#- +QV2M = REAL*4::lon,lat,time +QV2M:long_name = Specific humidity at 2m above the displacement height +QV2M:units = kg kg-1 +QV2M:gamap_category = GMAO-2D +#- +SEAICE00 = REAL*4::lon,lat,time +SEAICE00:long_name = Fraction of grid box that has 0-10% sea ice coverage +SEAICE00:units = fraction +SEAICE00:gamap_category = GMAO-2D +#- +SEAICE10 = REAL*4::lon,lat,time +SEAICE10:long_name = Fraction of grid box that has 10-20% sea ice coverage +SEAICE10:units = fraction +SEAICE10:gamap_category = GMAO-2D +#- +SEAICE20 = REAL*4::lon,lat,time +SEAICE20:long_name = Fraction of grid box that has 20-30% sea ice coverage +SEAICE20:units = fraction +SEAICE20:gamap_category = GMAO-2D +#- +SEAICE30 = REAL*4::lon,lat,time +SEAICE30:long_name = Fraction of grid box that has 30-40% sea ice coverage +SEAICE30:units = fraction +SEAICE30:gamap_category = GMAO-2D +#- +SEAICE40 = REAL*4::lon,lat,time +SEAICE40:long_name = Fraction of grid box that has 40-50% sea ice coverage +SEAICE40:units = fraction +SEAICE40:gamap_category = GMAO-2D +#- +SEAICE50 = REAL*4::lon,lat,time +SEAICE50:long_name = Fraction of grid box that has 50-60% sea ice coverage +SEAICE50:units = fraction +SEAICE50:gamap_category = GMAO-2D +#- +SEAICE60 = REAL*4::lon,lat,time +SEAICE60:long_name = Fraction of grid box that has 60-70% sea ice coverage +SEAICE60:units = fraction +SEAICE60:gamap_category = GMAO-2D +#- +SEAICE70 = REAL*4::lon,lat,time +SEAICE70:long_name = Fraction of grid box that has 70-80% sea ice coverage +SEAICE70:units = fraction +SEAICE70:gamap_category = GMAO-2D +#- +SEAICE80 = REAL*4::lon,lat,time +SEAICE80:long_name = Fraction of grid box that has 80-90% sea ice coverage +SEAICE80:units = fraction +SEAICE80:gamap_category = GMAO-2D +#- +SEAICE90 = REAL*4::lon,lat,time +SEAICE90:long_name = Fraction of grid box that has 90-100% sea ice coverage +SEAICE90:units = fraction +SEAICE90:gamap_category = GMAO-2D +#- +SLP = REAL*4::lon,lat,time +SLP:long_name = Sea level pressure +SLP:units = hPa +SLP:gamap_category = GMAO-2D +#- +SNODP = REAL*4::lon,lat,time +SNODP:long_name = Snow depth +SNODP:units = m +SNODP:gamap_category = GMAO-2D +#- +SNOMAS = REAL*4::lon,lat,time +SNOMAS:long_name = Snow mass +SNOMAS:units = kg m-2 +#- +SWGDN = REAL*4::lon,lat,time +SWGDN:long_name = Surface incident shortwave flux +SWGDN:units = W m-2 +SWGDN:gamap_category = GMAO-2D +#- +TROPPT = REAL*4::lon,lat,time +TROPPT:long_name = Temperature-based tropopause pressure +TROPPT:units = hPa +TROPPT:gamap_category = GMAO-2D +#- +TS = REAL*4::lon,lat,time +TS:long_name = Surface skin temperature +TS:units = K +TS:gamap_category = GMAO-2D +#- +T2M = REAL*4::lon,lat,time +T2M:long_name = Temperature 2m above displacement height +T2M:units = K +T2M:gamap_category = GMAO-2D +#- +U10M = REAL*4::lon,lat,time +U10M:long_name = Eastward wind 10m above displacement height +U10M:units = m s-1 +U10M:gamap_category = GMAO-2D +#- +USTAR = REAL*4::lon,lat,time +USTAR:long_name = Friction velocity +USTAR:units = m s-1 +USTAR:gamap_category = GMAO-2D +#- +V10M = REAL*4::lon,lat,time +V10M:long_name = Northward wind 10m above displacement height +V10M:units = m s-1 +V10M:gamap_category = GMAO-2D +#- +Z0M = REAL*4::lon,lat,time +Z0M:long_name = Roughness length, momentum +Z0M:units = m +Z0M:gamap_category = GMAO-2D + +#EOP diff --git a/code/NcdfUtil/perl/definitions_a3cld.rc b/code/NcdfUtil/perl/definitions_a3cld.rc new file mode 100644 index 0000000..91acfba --- /dev/null +++ b/code/NcdfUtil/perl/definitions_a3cld.rc @@ -0,0 +1,83 @@ +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: definitions_a3cld.rc +# +# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A3cld filename, +# variables, and attributes for use with the ncCode* scripts. Also defines +# the names of the files where Fortran code will be written to. +#\\ +#\\ +# !REMARKS: +# This file has been customized to generate GEOS-Chem Fortran code that +# will read data from a GEOS-5.7.2 A3cld met field file. +# +# !REVISION HISTORY: +# 01 Feb 2012 - R. Yantosca - Initial version +#------------------------------------------------------------------------------ + +### !FILENAME: +Fortran Read File = a3cld_read.F +netCDF FileHandle = fId +netCDF FileName = GEOS572.YYYYMMDD.A3cld.4x5.nc + + +### !DIMENSIONS: +lon = IIPAR +lat = JJPAR +lev = LLPAR +time = 1 + +### !VARIABLES: +lon = REAL*4::lon +lon:long_name = longitude +lon:units = degrees_east +#- +lat = REAL*4::lat +lat:long_name = latitude +lat:units = degrees_north +#- +lev = REAL*4::lev +lev:long_name = levels +lev:units = unitless +#- +time = INTEGER::time +time:units = minutes since YYYY-MM-DD 00:00:00.0 +time:delta_t = 0000-00-00 03:00:00 +time:begin_date = YYYYMMDD +time:begin_time = 000000 +time:time_increment = 030000 +#- +CLOUD = REAL*4::lon,lat,lev,time +CLOUD:long_name = Total cloud fraction in grid box +CLOUD:units = unitless +CLOUD:gamap_category = GMAO-3D$ +#- +OPTDEPTH = REAL*4::lon,lat,lev,time +OPTDEPTH:long_name = Total in-cloud optical thickness (visible band) +OPTDEPTH:units = unitless +OPTDEPTH:gamap_category = GMAO-3D$ +#- +QI = REAL*4::lon,lat,lev,time +QI:long_name = Cloud ice water mixing ratio +QI:units = kg kg-1 +QI:gamap_category = GMAO-3D$ +#- +QL = REAL*4::lon,lat,lev,time +QL:long_name = Cloud liquid water mixing ratio +QL:units = kg kg-1 +QL:gamap_category = GMAO-3D$ +#- +TAUCLI = REAL*4::lon,lat,lev,time +TAUCLI:long_name = In-cloud ice optical thickness (visible band) +TAUCLI:units = unitless +TAUCLI:gamap_category = GMAO-3D$ +#- +TAUCLW = REAL*4::lon,lat,lev,time +TAUCLW:long_name = In-cloud water optical thickness (visible band) +TAUCLW:units = unitless +TAUCLW:gamap_category = GMAO-3D$ + +#EOP diff --git a/code/NcdfUtil/perl/definitions_a3dyn.rc b/code/NcdfUtil/perl/definitions_a3dyn.rc new file mode 100644 index 0000000..72ea8d9 --- /dev/null +++ b/code/NcdfUtil/perl/definitions_a3dyn.rc @@ -0,0 +1,85 @@ +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: definitions_a3dyn.rc +# +# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A3dyn filename, +# variables, and attributes for use with the ncCode* scripts. Also defines +# the names of the files where Fortran code will be written to. +#\\ +#\\ +# !REMARKS: +# This file has been customized to generate GEOS-Chem Fortran code that +# will read data from a GEOS-5.7.2 A3dyn met field file. +# +# !REVISION HISTORY: +# 01 Feb 2012 - R. Yantosca - Initial version +#------------------------------------------------------------------------------ + +### !FILENAME: +Fortran Read File = a3dyn_read.F +netCDF FileHandle = fId +netCDF FileName = GEOS572.YYYYMMDD.A3dyn.4x5.nc + + +### !DIMENSIONS: +lon = IIPAR +lat = JJPAR +lev = LLPAR +ap = LLPAR+1 +time = 1 + + +### !VARIABLES: +lon = REAL*4::lon +lon:long_name = longitude +lon:units = degrees_east +#- +lat = REAL*4::lat +lat:long_name = latitude +lat:units = degrees_north +#- +lev = REAL*4::lev +lev:long_name = levels +lev:units = unitless +#- +time = INTEGER::time +time:units = minutes since YYYY-MM-DD 00:00:00.0 +time:delta_t = 0000-00-00 03:00:00 +time:begin_date = YYYYMMDD +time:begin_time = 000000 +time:time_increment = 030000 +#- +CMFMC = REAL*4::lon,lat,ap,time +CMFMC:long_name = Upward moist convective mass flux +CMFMC:units = kg m-2 s-2 +CMFMC:gamap_category = GMAO-3D$ +#- +DTRAIN = REAL*4::lon,lat,lev,time +DTRAIN:long_name = Detrainment cloud mass flux +DTRAIN:units = kg m-2 s-2 +DTRAIN:gamap_category = GMAO-3D$ +#- +OMEGA = REAL*4::lon,lat,lev,time +OMEGA:long_name = Vertical pressure velocity +OMEGA:units = Pa s-1 +OMEGA:gamap_category = GMAO-3D$ +#- +RH = REAL*4::lon,lat,lev,time +RH:long_name = Relative humidity +RH:units = fraction +RH:gamap_category = GMAO-3D$ +#- +U = REAL*4::lon,lat,lev,time +U:long_name = Eastward component of wind +U:units = m s-1 +U:gamap_category = GMAO-3D$ +#- +V = REAL*4::lon,lat,lev,time +V:long_name = Northward component of wind +V:units = m s-1 +V:gamap_category = GMAO-3D$ + +#EOP diff --git a/code/NcdfUtil/perl/definitions_a3mstc.rc b/code/NcdfUtil/perl/definitions_a3mstc.rc new file mode 100644 index 0000000..eef12d9 --- /dev/null +++ b/code/NcdfUtil/perl/definitions_a3mstc.rc @@ -0,0 +1,74 @@ +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: definitions_a3mstc.rc +# +# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A3mstC filename, +# variables, and attributes for use with the ncCode* scripts. Also defines +# the names of the files where Fortran code will be written to. +#\\ +#\\ +# !REMARKS: +# This file has been customized to generate GEOS-Chem Fortran code that +# will read data from a GEOS-5.7.2 A3mstC met field file. +# +# !REVISION HISTORY: +# 01 Feb 2012 - R. Yantosca - Initial version +#------------------------------------------------------------------------------ + +### !FILENAME: +Fortran Read File = a3mstc_read.F +netCDF FileHandle = fId +netCDF FileName = GEOS572.YYYYMMDD.A3mstC.4x5.nc + + +### !DIMENSIONS: +lon = IIPAR +lat = JJPAR +lev = LLPAR +time = 1 + + +### !VARIABLES: +lon = REAL*4::lon +lon:long_name = longitude +lon:units = degrees_east +#- +lat = REAL*4::lat +lat:long_name = latitude +lat:units = degrees_north +#- +lev = REAL*4::lev +lev:long_name = levels +lev:units = unitless +#- +time = INTEGER::time +time:units = minutes since YYYY-MM-DD 00:00:00.0 +time:delta_t = 0000-00-00 03:00:00 +time:begin_date = YYYYMMDD +time:begin_time = 000000 +time:time_increment = 030000 +#- +DQRCU = REAL*4::lon,lat,lev,time +DQRCU:long_name = Precipitation production rate -- convective +DQRCU:units = kg kg-1 s-1 +DQRCU:gamap_category = GMAO-3D$ +#- +DQRLSAN = REAL*4::lon,lat,lev,time +DQRLSAN:long_name = Precipitation production rate -- large scale + anvil +DQRLSAN:units = kg kg-1 s-1 +DQRLSAN:gamap_category = GMAO-3D$ +#- +REEVAPCN = REAL*4::lon,lat,lev,time +REEVAPCN:long_name = Evaporation of precipitating convective condensate +REEVAPCN:units = kg kg-1 s-1 +REEVAPCN:gamap_category = GMAO-3D$ +#- +REEVAPLS = REAL*4::lon,lat,lev,time +REEVAPLS:long_name = Evaporation of precipitating large-scale & anvil condensate +REEVAPLS:units = kg kg-1 +REEVAPLS:gamap_category = GMAO-3D$ + +#EOP diff --git a/code/NcdfUtil/perl/definitions_a3mste.rc b/code/NcdfUtil/perl/definitions_a3mste.rc new file mode 100644 index 0000000..6b679b0 --- /dev/null +++ b/code/NcdfUtil/perl/definitions_a3mste.rc @@ -0,0 +1,74 @@ +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: definitions_a3mste.rc +# +# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 A3mstE filename, +# variables, and attributes for use with the ncCode* scripts. Also defines +# the names of the files where Fortran code will be written to. +#\\ +#\\ +# !REMARKS: +# This file has been customized to generate GEOS-Chem Fortran code that +# will read data from a GEOS-5.7.2 A3mstE met field file. +# +# !REVISION HISTORY: +# 01 Feb 2012 - R. Yantosca - Initial version +#------------------------------------------------------------------------------ + +### !FILENAME: +Fortran Read File = a3mste_read.F +netCDF FileHandle = fId +netCDF FileName = GEOS572.YYYYMMDD.A3mstE.4x5.nc + + +### !DIMENSIONS: +lon = IIPAR +lat = JJPAR +lev = LLPAR+1 +time = 1 + + +### !VARIABLES: +lon = REAL*4::lon +lon:long_name = longitude +lon:units = degrees_east +#- +lat = REAL*4::lat +lat:long_name = latitude +lat:units = degrees_north +#- +lev = REAL*4::lev +lev:long_name = levels +lev:units = unitless +#- +time = INTEGER::time +time:units = minutes since YYYY-MM-DD 00:00:00.0 +time:delta_t = 0000-00-00 03:00:00 +time:begin_date = YYYYMMDD +time:begin_time = 000000 +time:time_increment = 030000 +#- +PFICU = REAL*4::lon,lat,lev.time +PFICU:long_name = Downward flux of ice precipitation (convective) +PFICU:units = kg m-2 s-1 +PFICU:gamap_category = GMAO-3D$ +#- +PFILSAN = REAL*4::lon,lat,lev.time +PFILSAN:long_name = Downward flux of ice precipitation (large scale + anvil) +PFILSAN:units = kg m-2 s-1 +PFILSAN:gamap_category = GMAO-3D$ +#- +PFLCU = REAL*4::lon,lat,lev.time +PFLCU:long_name = Downward flux of liquid precipitation (convective) +PFLCU:units = kg m-2 s-1 +PFLCU:gamap_category = GMAO-3D$ +#- +PFLLSAN = REAL*4::lon,lat,lev.time +PFLLSAN:long_name = Downward flux of liquid precipitation (large scale + anvil) +PFLLSAN:units = kg m-2 s-1 +PFLLSAN:gamap_category = GMAO-3D$ + +#EOP diff --git a/code/NcdfUtil/perl/definitions_cn.rc b/code/NcdfUtil/perl/definitions_cn.rc new file mode 100644 index 0000000..be4d35f --- /dev/null +++ b/code/NcdfUtil/perl/definitions_cn.rc @@ -0,0 +1,79 @@ +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: definitions_cn.rc +# +# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 CN filename, +# variables, and attributes for use with the ncCode* scripts. Also defines +# the names of the files where Fortran code will be written to. +#\\ +#\\ +# !REMARKS: +# This file has been customized to generate GEOS-Chem Fortran code that +# will read data from a GEOS-5.7.2 CN met field file. +# +# !REVISION HISTORY: +# 01 Feb 2012 - R. Yantosca - Initial version +#------------------------------------------------------------------------------ + +### !FILENAME: +Fortran Read File = cn_read.F +netCDF FileHandle = fId +netCDF FileName = GEOS572.YYYYMMDD.CN.4x5.nc + + +### !DIMENSIONS: +lon = IIPAR +lat = JJPAR +time = 1 + + +### !VARIABLES: +lon = REAL*4::lon +lon:long_name = longitude +lon:units = degrees_east +#- +lat = REAL*4::lat +lat:long_name = latitude +lat:units = degrees_north +#- +lev = REAL*4::lev +lev:long_name = levels +lev:units = unitless +#- +time = INTEGER::time +time:long_name = time +time:units = minutes since 2011-01-01 00:00:00.0 +time:delta_t = 0000-00-00 00:00:00 +time:begin_date = 20110101 +time:begin_time = 000000 +time:time_increment = 000000 +#- +FRLAKE = REAL*4::lon,lat,time +FRLAKE:long_name = Fraction of lake type in grid box +FRLAKE:units = fraction +FRLAKE:gamap_category = GMAO-2D +#- +FRLAND = REAL*4::lon,lat,time +FRLAND:long_name = Fraction of land in grid box +FRLAND:units = fraction +FRLAND:gamap_category = GMAO-2D +#- +FRLANDIC = REAL*4::lon,lat,time +FRLANDIC:long_name = Fraction of land ice in grid box +FRLANDIC:units = fraction +FRLANDIC:gamap_category = GMAO-2D +#- +FROCEAN = REAL*4::lon,lat,time +FROCEAN:long_name = Fraction of ocean in grid box +FROCEAN:units = fraction +FROCEAN:gamap_category = GMAO-2D +#- +PHIS = REAL*4::lon,lat,time +PHIS:long_name = Surface geopotential +PHIS:units = m2 s-2 +PHIS:gamap_category = GMAO-2D + +#EOP diff --git a/code/NcdfUtil/perl/definitions_i3.rc b/code/NcdfUtil/perl/definitions_i3.rc new file mode 100644 index 0000000..cf4cac4 --- /dev/null +++ b/code/NcdfUtil/perl/definitions_i3.rc @@ -0,0 +1,75 @@ +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: definitions_i3.rc +# +# !DESCRIPTION: Resource file that defines the GEOS-5.7.2 I3 filename, +# variables, and attributes for use with the ncCode* scripts. Also defines +# the names of the files where Fortran code will be written to. +#\\ +#\\ +# !REMARKS: +# This file has been customized to generate GEOS-Chem Fortran code that +# will read data from a GEOS-5.7.2 I3 met field file. +# +# !REVISION HISTORY: +# 01 Feb 2012 - R. Yantosca - Initial version +#------------------------------------------------------------------------------ + +### !FILENAME: +Fortran Read File = i3_read.F +netCDF FileHandle = fId +netCDF FileName = GEOS572.YYYYMMDD.I3.4x5.nc + + +### !DIMENSIONS: +lon = IIPAR +lat = JJPAR +lev = LLPAR +time = 1 + + +### !VARIABLES: +lon = REAL*4::lon +lon:long_name = longitude +lon:units = degrees_east +#- +lat = REAL*4::lat +lat:long_name = latitude +lat:units = degrees_north +#- +lev = REAL*4::lev +lev:long_name = levels +lev:units = unitless +#- +time = INTEGER::time +time:long_name = time +time:units = minutes since YYYY-MM-DD 00:00:00.0 +time:delta_t = 0000-00-00 03:00:00 +time:begin_date = YYYYMMDD +time:begin_time = 000000 +time:time_increment = 030000 +#- +PS = REAL*4::lon,lat,time +PS:long_name = Surface pressure +PS:units = hPa +PS:gamap_category = GMAO-2D +#- +PV = REAL*4::lon,lat,lev,time +PV:long_name = Ertel potential vorticity +PV:units = K m-2 kg-1 s-1 +PV:gamap_category = GMAO-3D$ + +QV = REAL*4::lon,lat,lev,time +QV:long_name = Specific humidity +QV:units = kg kg-1 +QV:gamap_category = GMAO-3D$ +#- +T = REAL*4::lon,lat,lev,time +T:long_name = Temperature +T:units = K +T:gamap_category = GMAO-3D$ + +#EOP diff --git a/code/NcdfUtil/perl/ncCodeDef b/code/NcdfUtil/perl/ncCodeDef new file mode 100644 index 0000000..e1e90f9 --- /dev/null +++ b/code/NcdfUtil/perl/ncCodeDef @@ -0,0 +1,790 @@ +#!/usr/bin/perl -w + +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !MODULE: ncCodeDef +# +# !DESCRIPTION: This Perl script automatically creates a Fortran subroutine +# that creates a netCDF file and specifies the relevant variables and +# attributes. The Fortran subroutine (named DEFINE\_NETCDF\_FILE) contains +# calls to the proper NcdfUtilities library routines. +#\\ +#\\ +# !USES: +# + require 5.003; # Need this version of Perl or newer + use English; # Use English language + use Carp; # Get detailed error messages + use strict 'refs'; # Do not allow symbolic references + use strict 'subs'; # Treat all barewords as syntax errors + use StrTrim qw( &trim + &splitLine + &extractFile ); # Get string handling routines +# +# !PRIVATE MEMBER FUNCTIONS: +# &readRcFile($) +# &writeFortranVars($@) +# &writeFortranCalls($@) +# &handleFileName($$) +# &handleGlobalAtts($$) +# &handleDimensions($$) +# &handleVariables($$) +# +# !PUBLIC MEMBER FUNCTIONS: +# &main() +# +# !PUBLIC DATA MEMBERS: +# + $F_ID = ""; # netCDF file ID +# +# !CALLING SEQUENCE: +# ncCodeCreate RESOURCE-FILE-NAME +# +# !REMARKS: +# Some hand-editing of the output Fortran subroutine may be necessary. +# +# !REVISION HISTORY: +# 27 Jan 2012 - R. Yantosca - Initial version +# 30 Jan 2012 - R. Yantosca - Now get trim, splitline routines from the +# Perl module "StrTrim.pm" +# 30 Jan 2012 - R. Yantosca - Now write ProTeX comment headers +# 31 Jan 2012 - R. Yantosca - Minor edits for consistency +# 07 Mar 2012 - R. Yantosca - Minor fix, ignore comment lines +#EOP +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !IROUTINE: readRcFile +# +# !DESCRIPTION: Routine readRcFile reads the resource file which describes +# the variables, attributes, and dimensions of the netCDF file. +#\\ +#\\ +# !INTERFACE: +# +sub readRcFile($) { +# +# !INPUT PARAMETERS: +# + # $fileName : Input file that describes the netCDF file + my ( $fileName ) = @_; +# +# !CALLING SEQUENCE: +# &readRcFile( RESOURCE-FILE-NAME ); +# +# !REVISION HISTORY: +# 27 Jan 2012 - R. Yantosca - Initial version +# 27 Jan 2012 - R. Yantosca - Now get output filename from the resource file +# 07 Mar 2012 - R. Yantosca - Minor fix, ignore comment lines +#EOP +#------------------------------------------------------------------------------ +#BOC +# +# !LOCAL VARIABLES: +# + my $cmdFile = ""; + my $line = ""; + my @lines = (); + my $name = ""; + + #-------------------------------------------------- + # Read variable settings from the resource file + #-------------------------------------------------- + open( I, "<$fileName" ) or die "Cannot open $fileName!\n"; + chomp( @lines = ); + close( I ); + + #-------------------------------------------------- + # Write Fortran commands to the output file + #-------------------------------------------------- + + # Pre-get a few quantities before creating the + # output file with the fortran code + foreach $line ( @lines ) { + + # Skip comment lines + if ( !( substr( $line, 0, 1 ) eq '#' ) ) { + + # Name of output file w/ Fortran code + if ( $line =~ 'Fortran Def File' ) { + ( $name, $cmdFile ) = &splitLine( $line, '=' ); + } + + # NetCDF file ID (aka filehandle) + if ( $line =~ 'netCDF FileHandle' ) { + ( $name, $F_ID ) = &splitLine( $line, '=' ); + } + } + } + + # Open the file that will ho + open( O, ">$cmdFile" ) or die "Cannot open $cmdFile\n"; + + # Pass thru @lines array so that we can declare Fortran variables + &writeFortranVars( \*O, @lines ); + + # Pass thru @lines array again to write + &writeFortranCalls( \*O, @lines ); + + #-------------------------------------------------- + # Cleanup and quit + #-------------------------------------------------- + + # Close output file + close( O ); + + # Return + return( 0 ); +} +#EOC +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !IROUTINE: writeFortranVars +# +# !DESCRIPTION: Routine writeFortranVars generates the proper Fortran +# variable declarations that are needed for use with the NcdfUtilities +# library routines. +#\\ +#\\ +# !INTERFACE: +# +sub writeFortranVars($@) { +# +# !INPUT PARAMETERS: +# + # $O : File handle + # @lines : Contents of the resource file + my ( $O, @lines ) = @_; +# +# !CALLING SEQUENCE: +# &writeFortranVars( \*O, @lines ); +# +# !REVISION HISTORY: +# 27 Jan 2012 - R. Yantosca - Initial version +#EOP +#------------------------------------------------------------------------------ +#BOC +# +# !LOCAL VARIABLES: +# + my @subStr = (); + my $name = ""; + my $value = ""; + my $txt = ""; + + #------------------------------------------------------- + # Write USE statements + #------------------------------------------------------- + $txt .= < ); + close( I ); + + #-------------------------------------------------- + # Write Fortran commands to the output file + #-------------------------------------------------- + + # Pre-get a few quantities before creating the + # output file with the fortran code + foreach $line ( @lines ) { + + # Skip comment lines + if ( !( substr( $line, 0, 1 ) eq '#' ) ) { + + # Name of output file w/ Fortran code + if ( $line =~ 'Fortran Read File' ) { + ( $name, $cmdFile ) = &splitLine( $line, '=' ); + } + + # NetCDF file ID (aka filehandle) + if ( $line =~ 'netCDF FileHandle' ) { + ( $name, $F_ID ) = &splitLine( $line, '=' ); + } + } + } + + # Open the file that will ho + open( O, ">$cmdFile" ) or die "Cannot open $cmdFile\n"; + + # Pass thru @lines array so that we can declare Fortran variables + &writeFortranVars( \*O, @lines ); + + # Pass thru @lines array again to write + &writeFortranCalls( \*O, @lines ); + + #-------------------------------------------------- + # Cleanup and quit + #-------------------------------------------------- + + # Close output file + close( O ); + + # Return + return( 0 ); +} +#EOC +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !IROUTINE: writeFortranVars +# +# !DESCRIPTION: Routine writeFortranVars generates the proper Fortran +# variable declarations that are needed for use with the NcdfUtilities +# library routines. +#\\ +#\\ +# !INTERFACE: +# +sub writeFortranVars($@) { +# +# !INPUT PARAMETERS: +# + # $O : File handle + # @lines : Contents of the resource file + my ( $O, @lines ) = @_; +# +# !CALLING SEQUENCE: +# &writeFortranVars( \*O, @lines ); +# +# !REVISION HISTORY: +# 30 Jan 2012 - R. Yantosca - Initial version +# 31 Jan 2012 - R. Yantosca - Minor edits for consistency +# 01 Feb 2012 - R. Yantosca - Fix typo in output ProTeX header +# 09 Jul 2012 - R. Yantosca - Now make fId a local variable +#EOP +#------------------------------------------------------------------------------ +#BOC +# +# !LOCAL VARIABLES: +# + my @subStr = (); + my $name = ""; + my $value = ""; + my $varName = ""; + my $varSize = ""; + my $varType = ""; + my $varDim = ""; + my $nDims = ""; + my @dims = (); + my $dimDef = ""; + my $txt = ""; + + #------------------------------------------------------- + # Write USE statements + #------------------------------------------------------- + $txt .= < ); + close( I ); + + #---------------------------------------------- + # Write Fortran commands to the output file + #---------------------------------------------- + + # Parse the file first to pre-get a few quantities + foreach $line ( @lines ) { + + # Skip comment lines + if ( !( substr( $line, 0, 1 ) eq '#' ) ) { + + # Name of output file w/ Fortran code + if ( $line =~ 'Fortran Write File' ) { + ( $name, $cmdFile ) = &splitLine( $line, '=' ); + } + + # NetCDF file ID (aka filehandle) + if ( $line =~ 'netCDF FileHandle' ) { + ( $name, $F_ID ) = &splitLine( $line, '=' ); + } + } + } + + # Open the file that will ho + open( O, ">$cmdFile" ) or die "Cannot open output file $cmdFile!\n"; + + # Pass thru @lines array so that we can declare Fortran variables + &writeFortranVars( \*O, @lines ); + + # Pass thru @lines array again to write + &writeFortranCalls( \*O, @lines ); + + #---------------------------------------------- + # Cleanup and quit + #---------------------------------------------- + + # Close output file + close( O ); + + # Return + return( 0 ); +} +#EOC +#------------------------------------------------------------------------------ +# Harvard University Atmospheric Chemistry Modeling Group ! +#------------------------------------------------------------------------------ +#BOP +# +# !IROUTINE: writeFortranVars +# +# !DESCRIPTION: Routine writeFortranVars generates the proper Fortran +# variable declarations that are needed for use with the NcdfUtilities +# library routines. +#\\ +#\\ +# !INTERFACE: +# +sub writeFortranVars($@) { +# +# !INPUT PARAMETERS: +# + # $O : File handle + # @lines : Contents of the resource file + my ( $O, @lines ) = @_; +# +# !CALLING SEQUENCE: +# &writeFortranVars( \*O, @lines ); +# +# !REVISION HISTORY: +# 30 Jan 2012 - R. Yantosca - Initial version +#EOP +#------------------------------------------------------------------------------ +#BOC +# +# !LOCAL VARIABLES: +# + my @subStr = (); + my $name = ""; + my $value = ""; + my $varName = ""; + my $varSize = ""; + my $varType = ""; + my $varDim = ""; + my $nDims = ""; + my @dims = (); + my $dimDef = ""; + my $txt = ""; + + #------------------------------------------------------- + # Write USE statements + #------------------------------------------------------- + $txt .= <