module mkncdio !----------------------------------------------------------------------- !BOP ! ! !MODULE: mkncdio ! ! !DESCRIPTION: ! Generic interfaces to write fields to netcdf files, and other useful netcdf operations ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use shr_sys_mod , only : shr_sys_flush ! ! !PUBLIC TYPES: implicit none include 'netcdf.inc' save private public :: check_ret ! checks return status of netcdf calls public :: ncd_defvar ! define netCDF input variable public :: ncd_def_spatial_var ! define spatial netCDF variable (convenience wrapper to ncd_defvar) public :: ncd_put_time_slice ! write a single time slice of a variable public :: get_dim_lengths ! get dimension lengths of a netcdf variable interface ncd_def_spatial_var module procedure ncd_def_spatial_var_0lev module procedure ncd_def_spatial_var_1lev module procedure ncd_def_spatial_var_2lev end interface ncd_def_spatial_var interface ncd_put_time_slice module procedure ncd_put_time_slice_1d module procedure ncd_put_time_slice_2d end interface ncd_put_time_slice public :: convert_latlon ! convert a latitude or longitude variable to degrees E / N ! ! !REVISION HISTORY: ! ! ! !PRIVATE MEMBER FUNCTIONS: ! private :: get_time_slice_beg_and_len ! determine beg and len vectors for writing a time slice logical :: masterproc = .true. ! always use 1 proc real(r8) :: spval = 1.e36 ! special value public :: nf_open public :: nf_close public :: nf_write public :: nf_sync public :: nf_inq_attlen public :: nf_inq_dimlen public :: nf_inq_dimname public :: nf_inq_varid public :: nf_inq_varndims public :: nf_inq_vardimid public :: nf_get_att_double public :: nf_get_att_text public :: nf_get_var_double public :: nf_get_vara_double public :: nf_get_var_int public :: nf_get_vara_int public :: nf_put_var_double public :: nf_put_vara_double public :: nf_put_var_int public :: nf_put_vara_int public :: nf_inq_dimid public :: nf_max_name public :: nf_max_var_dims public :: nf_noerr public :: nf_nowrite public :: nf_enotatt public :: nf_strerror !EOP !----------------------------------------------------------------------- contains !----------------------------------------------------------------------- !BOP ! ! !IROUTINE: check_ret ! ! !INTERFACE: subroutine check_ret(ret, calling, varexists) ! ! !DESCRIPTION: ! Check return status from netcdf call ! ! !ARGUMENTS: implicit none integer, intent(in) :: ret character(len=*) :: calling logical, intent(out), optional :: varexists ! ! !REVISION HISTORY: ! !EOP !----------------------------------------------------------------------- if ( present(varexists) ) varexists = .true. if ( present(varexists) .and. ret == NF_ENOTVAR )then varexists = .false. else if (ret /= NF_NOERR) then write(6,*)'netcdf error from ',trim(calling), ' rcode = ', ret, & ' error = ', NF_STRERROR(ret) call abort() end if end subroutine check_ret !----------------------------------------------------------------------- !BOP ! ! !IROUTINE: ncd_defvar ! ! !INTERFACE: subroutine ncd_defvar(ncid, varname, xtype, & dim1name, dim2name, dim3name, dim4name, dim5name, & long_name, units, cell_method, missing_value, fill_value, & imissing_value, ifill_value) ! ! !DESCRIPTION: ! Define a netcdf variable ! ! !ARGUMENTS: implicit none integer , intent(in) :: ncid ! input unit character(len=*), intent(in) :: varname ! variable name integer , intent(in) :: xtype ! external type character(len=*), intent(in), optional :: dim1name ! dimension name character(len=*), intent(in), optional :: dim2name ! dimension name character(len=*), intent(in), optional :: dim3name ! dimension name character(len=*), intent(in), optional :: dim4name ! dimension name character(len=*), intent(in), optional :: dim5name ! dimension name character(len=*), intent(in), optional :: long_name ! attribute character(len=*), intent(in), optional :: units ! attribute character(len=*), intent(in), optional :: cell_method ! attribute real(r8) , intent(in), optional :: missing_value ! attribute for real real(r8) , intent(in), optional :: fill_value ! attribute for real integer , intent(in), optional :: imissing_value ! attribute for int integer , intent(in), optional :: ifill_value ! attribute for int ! ! !REVISION HISTORY: ! ! ! !LOCAL VARIABLES: !EOP integer :: n ! indices integer :: ndims ! dimension counter integer :: dimid(5) ! dimension ids integer :: varid ! variable id integer :: itmp ! temporary character(len=256) :: str ! temporary character(len=32) :: subname='NCD_DEFVAR_REAL' ! subroutine name !----------------------------------------------------------------------- if (.not. masterproc) return ! Determine dimension ids for variable dimid(:) = 0 if (present(dim1name)) then call check_ret(nf_inq_dimid(ncid, dim1name, dimid(1)), subname) end if if (present(dim2name)) then call check_ret(nf_inq_dimid(ncid, dim2name, dimid(2)), subname) end if if (present(dim3name)) then call check_ret(nf_inq_dimid(ncid, dim3name, dimid(3)), subname) end if if (present(dim4name)) then call check_ret(nf_inq_dimid(ncid, dim4name, dimid(4)), subname) end if if (present(dim5name)) then call check_ret(nf_inq_dimid(ncid, dim5name, dimid(5)), subname) end if ! Define variable if (present(dim1name)) then ndims = 0 do n = 1, size(dimid) if (dimid(n) /= 0) ndims = ndims + 1 end do call check_ret(nf_def_var(ncid, trim(varname), xtype, ndims, dimid(1:ndims), varid), subname) else call check_ret(nf_def_var(ncid, varname, xtype, 0, 0, varid), subname) end if if (present(long_name)) then call check_ret(nf_put_att_text(ncid, varid, 'long_name', len_trim(long_name), trim(long_name)), subname) end if if (present(units)) then call check_ret(nf_put_att_text(ncid, varid, 'units', len_trim(units), trim(units)), subname) end if if (present(cell_method)) then str = 'time: ' // trim(cell_method) call check_ret(nf_put_att_text(ncid, varid, 'cell_method', len_trim(str), trim(str)), subname) end if if (present(fill_value)) then call check_ret(nf_put_att_double(ncid, varid, '_FillValue', xtype, 1, fill_value), subname) end if if (present(missing_value)) then call check_ret(nf_put_att_double(ncid, varid, 'missing_value', xtype, 1, missing_value), subname) end if if (present(ifill_value)) then call check_ret(nf_put_att_int(ncid, varid, '_FillValue', xtype, 1, ifill_value), subname) end if if (present(imissing_value)) then call check_ret(nf_put_att_int(ncid, varid, 'missing_value', xtype, 1, imissing_value), subname) end if end subroutine ncd_defvar ! ======================================================================== ! ncd_def_spatial_var routines: define a spatial netCDF variable (convenience wrapper to ! ncd_defvar) ! ======================================================================== !----------------------------------------------------------------------- subroutine ncd_def_spatial_var_0lev(ncid, varname, xtype, long_name, units) ! ! !DESCRIPTION: ! Define a spatial netCDF variable (convenience wrapper to ncd_defvar) ! ! The variable in question has ONLY spatial dimensions (no level or time dimensions) ! ! !USES: use mkvarctl, only : outnc_1d ! ! !ARGUMENTS: integer , intent(in) :: ncid ! input unit character(len=*) , intent(in) :: varname ! variable name integer , intent(in) :: xtype ! external type character(len=*) , intent(in) :: long_name ! attribute character(len=*) , intent(in) :: units ! attribute ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'ncd_def_spatial_var_0lev' !----------------------------------------------------------------------- if (outnc_1d) then call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & dim1name='gridcell', & long_name=long_name, units=units) else call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & dim1name='lsmlon', dim2name='lsmlat', & long_name=long_name, units=units) end if end subroutine ncd_def_spatial_var_0lev !----------------------------------------------------------------------- subroutine ncd_def_spatial_var_1lev(ncid, varname, xtype, lev1name, long_name, units) ! ! !DESCRIPTION: ! Define a spatial netCDF variable (convenience wrapper to ncd_defvar) ! ! The variable in question has one level (or time) dimension in addition to its ! spatial dimensions ! ! !USES: use mkvarctl, only : outnc_1d ! ! !ARGUMENTS: integer , intent(in) :: ncid ! input unit character(len=*) , intent(in) :: varname ! variable name integer , intent(in) :: xtype ! external type character(len=*) , intent(in) :: lev1name ! name of level (or time) dimension character(len=*) , intent(in) :: long_name ! attribute character(len=*) , intent(in) :: units ! attribute ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'ncd_def_spatial_var_1lev' !----------------------------------------------------------------------- if (outnc_1d) then call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & dim1name='gridcell', dim2name=lev1name, & long_name=long_name, units=units) else call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & dim1name='lsmlon', dim2name='lsmlat',dim3name=lev1name, & long_name=long_name, units=units) end if end subroutine ncd_def_spatial_var_1lev !----------------------------------------------------------------------- subroutine ncd_def_spatial_var_2lev(ncid, varname, xtype, lev1name, lev2name, long_name, units) ! ! !DESCRIPTION: ! Define a spatial netCDF variable (convenience wrapper to ncd_defvar) ! ! The variable in question has two level (or time) dimensions in addition to its ! spatial dimensions ! ! !USES: use mkvarctl, only : outnc_1d ! ! !ARGUMENTS: integer , intent(in) :: ncid ! input unit character(len=*) , intent(in) :: varname ! variable name integer , intent(in) :: xtype ! external type character(len=*) , intent(in) :: lev1name ! name of first level (or time) dimension character(len=*) , intent(in) :: lev2name ! name of second level (or time) dimension character(len=*) , intent(in) :: long_name ! attribute character(len=*) , intent(in) :: units ! attribute ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'ncd_def_spatial_var_2lev' !----------------------------------------------------------------------- if (outnc_1d) then call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & dim1name='gridcell', dim2name=lev1name, dim3name=lev2name, & long_name=long_name, units=units) else call ncd_defvar(ncid=ncid, varname=varname, xtype=xtype, & dim1name='lsmlon', dim2name='lsmlat', dim3name=lev1name, dim4name=lev2name, & long_name=long_name, units=units) end if end subroutine ncd_def_spatial_var_2lev ! ======================================================================== ! ncd_put_time_slice routines: write a single time slice of a variable ! ======================================================================== !----------------------------------------------------------------------- subroutine ncd_put_time_slice_1d(ncid, varid, time_index, data) ! ! !DESCRIPTION: ! Write a single time slice of a 1-d variable ! ! !USES: ! ! !ARGUMENTS: integer , intent(in) :: ncid ! netCDF id integer , intent(in) :: varid ! variable id integer , intent(in) :: time_index ! time index in file real(r8), intent(in) :: data(:) ! data to write (a single time slice) ! ! !LOCAL VARIABLES: integer, allocatable :: beg(:) ! begin indices for each dimension integer, allocatable :: len(:) ! length along each dimension character(len=*), parameter :: subname = 'ncd_put_time_slice_1d' !----------------------------------------------------------------------- call get_time_slice_beg_and_len(ncid, varid, time_index, beg, len) call check_ret(nf_put_vara_double(ncid, varid, beg, len, data), subname) deallocate(beg, len) end subroutine ncd_put_time_slice_1d !----------------------------------------------------------------------- subroutine ncd_put_time_slice_2d(ncid, varid, time_index, data) ! ! !DESCRIPTION: ! Write a single time slice of a 2-d variable ! ! !USES: ! ! !ARGUMENTS: integer , intent(in) :: ncid ! netCDF id integer , intent(in) :: varid ! variable id integer , intent(in) :: time_index ! time index in file real(r8), intent(in) :: data(:,:) ! data to write (a single time slice) ! ! !LOCAL VARIABLES: integer, allocatable :: beg(:) ! begin indices for each dimension integer, allocatable :: len(:) ! length along each dimension character(len=*), parameter :: subname = 'ncd_put_time_slice_2d' !----------------------------------------------------------------------- call get_time_slice_beg_and_len(ncid, varid, time_index, beg, len) call check_ret(nf_put_vara_double(ncid, varid, beg, len, data), subname) deallocate(beg, len) end subroutine ncd_put_time_slice_2d !----------------------------------------------------------------------- subroutine get_time_slice_beg_and_len(ncid, varid, time_index, beg, len) ! ! !DESCRIPTION: ! Determine beg and len vectors for writing a time slice. ! ! Assumes time is the last dimension of the given variable. ! ! Allocates memory for beg & len. ! ! !USES: ! ! !ARGUMENTS: integer , intent(in) :: ncid ! netcdf ID integer , intent(in) :: varid ! variable ID integer , intent(in) :: time_index ! time index in file integer, allocatable, intent(out) :: beg(:) ! begin indices for each dimension integer, allocatable, intent(out) :: len(:) ! length along each dimension ! ! !LOCAL VARIABLES: integer :: n ! index integer :: ndims ! number of dimensions integer, allocatable :: dimids(:) ! dimension IDs character(len=*), parameter :: subname = 'get_time_slice_beg_and_len' !----------------------------------------------------------------------- call check_ret(nf_inq_varndims(ncid, varid, ndims), subname) allocate(beg(ndims)) allocate(len(ndims)) allocate(dimids(ndims)) call check_ret(nf_inq_vardimid(ncid, varid, dimids), subname) beg(1:ndims-1) = 1 do n = 1,ndims-1 call check_ret(nf_inq_dimlen(ncid, dimids(n), len(n)), subname) end do len(ndims) = 1 beg(ndims) = time_index deallocate(dimids) end subroutine get_time_slice_beg_and_len !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: get_dim_lengths ! ! !INTERFACE: subroutine get_dim_lengths(ncid, varname, ndims, dim_lengths) ! ! !DESCRIPTION: ! Returns the number of dimensions and an array containing the dimension lengths of a ! variable in an open netcdf file. ! ! Entries 1:ndims in the returned dim_lengths array contain the dimension lengths; the ! remaining entries in that vector are meaningless. The dim_lengths array must be large ! enough to hold all ndims values; if not, the code aborts (this can be ensured by passing ! in an array of length nf_max_var_dims). ! ! !USES: ! ! !ARGUMENTS: implicit none integer , intent(in) :: ncid ! netcdf id of an open netcdf file character(len=*), intent(in) :: varname ! name of variable of interest integer , intent(out):: ndims ! number of dimensions of variable integer , intent(out):: dim_lengths(:) ! lengths of dimensions of variable ! ! !REVISION HISTORY: ! Author: Bill Sacks ! ! ! !LOCAL VARIABLES: integer :: varid integer :: dimids(size(dim_lengths)) integer :: i character(len=*), parameter :: subname = 'get_dim_lengths' !EOP !------------------------------------------------------------------------------ call check_ret(nf_inq_varid(ncid, varname, varid), subname) call check_ret(nf_inq_varndims(ncid, varid, ndims), subname) if (ndims > size(dim_lengths)) then write(6,*) trim(subname), ' ERROR: dim_lengths too small' call abort() end if call check_ret(nf_inq_vardimid(ncid, varid, dimids), subname) dim_lengths(:) = 0 ! pre-fill with 0 so we won't have garbage in elements past ndims do i = 1, ndims call check_ret(nf_inq_dimlen(ncid, dimids(i), dim_lengths(i)), subname) end do end subroutine get_dim_lengths !---------------------------------------------------------------------------- !BOP ! ! !IROUTINE: convert_latlon ! ! !INTERFACE: subroutine convert_latlon(ncid, varname, data) ! ! !DESCRIPTION: ! Convert a latitude or longitude variable from its units in the input file to degrees E / ! degrees N. Currently, this just handles conversions from radians to degrees. ! ! Assumes that the longitude / latitude variable has already been read from file, into ! the variable given by 'data'. ncid & varname give the file ID and variable name from ! which this variable was read (needed to obtain the variable's units). ! ! !USES: use shr_const_mod, only : SHR_CONST_PI ! ! !ARGUMENTS: implicit none integer , intent(in) :: ncid ! ID of open netcdf file character(len=*), intent(in) :: varname ! name of lat or lon variable that was read into 'data' real(r8) , intent(inout):: data(:) ! latitude or longitude data ! ! !REVISION HISTORY: ! Author: Bill Sacks ! ! ! !LOCAL VARIABLES: !EOP integer :: ier ! error return code integer :: varid ! netCDF variable id integer :: units_len ! length of units attribute on file character(len=256) :: units ! units attribute character(len= 32) :: subname = 'convert_latlon' !----------------------------------------------------------------- call check_ret(nf_inq_varid (ncid, varname, varid), subname) ier = nf_inq_attlen(ncid, varid, 'units', units_len) ! Only do the following processing if there is no error; if ier /= NF_NOERR, that ! probably means there isn't a units attribute -- in that case, assume units are ! degrees and need no conversion if (ier == NF_NOERR) then if (units_len > len(units)) then write(6,*) trim(subname), ' ERROR: units variable not long enough to hold attributue' call abort() end if call check_ret(nf_get_att_text(ncid, varid, 'units', units), subname) if (units(1:7) == 'radians') then ! convert from radians to degrees data(:) = data(:) * 180._r8 / SHR_CONST_PI end if end if end subroutine convert_latlon !------------------------------------------------------------------------------ end module mkncdio