module wrap_nf 1,3
use shr_kind_mod
, only: r8 => shr_kind_r8, r4 => shr_kind_r4
use abortutils
, only: endrun
use cam_logfile
, only: iulog
#include <netcdf.inc>
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Wrapper routines for the netCDF library for input and output data.
!
! Author: Jim Rosinski
!
! $Id$
!
!-------------------------------------------------------------------------------
contains
!===============================================================================
!===============================================================================
subroutine wrap_redef (nfid),1
implicit none
integer, intent(in):: nfid
integer ret ! NetCDF return code
ret = nf_redef (nfid)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_redef
!===============================================================================
subroutine wrap_enddef (nfid),1
implicit none
integer, intent(in):: nfid
integer ret ! NetCDF return code
ret = nf_enddef (nfid)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_enddef
subroutine wrap_create (path, cmode, ncid),1
implicit none
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Create a netCDF file for reading and/or writing
!
!-------------------------------------------------------------------------------
character*(*), intent(in):: path
integer, intent(in):: cmode
integer, intent(out):: ncid
integer ret ! NetCDF return code
ret = nf_create (path, cmode, ncid)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_create
!===============================================================================
subroutine wrap_inq_unlimdim (nfid, dimid),1
implicit none
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets dimension name for a given dimension id
!
!-------------------------------------------------------------------------------
integer, intent(in):: nfid
integer, intent(in):: dimid
integer ret ! NetCDF return code
ret = nf_inq_unlimdim (nfid, dimid)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_unlimdim
subroutine wrap_inq_dim (nfid, dimid, dimname, dimlen),1
implicit none
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets dimension name for a given dimension id
!
!-------------------------------------------------------------------------------
integer, intent(in):: nfid
integer, intent(in):: dimid
integer, intent(out):: dimlen
character*(*), intent(out):: dimname
integer ret ! NetCDF return code
ret = nf_inq_dim (nfid, dimid, dimname, dimlen)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_dim
subroutine wrap_inq_nvars (nfid, nvars),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets number of variables in file
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(out):: nvars
integer ret ! NetCDF return code
ret = nf_inq_nvars (nfid, nvars)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_nvars
subroutine wrap_inq_ndims (nfid, ndims),1
implicit none
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets number of dimensions in file
!
!-------------------------------------------------------------------------------
integer, intent(in):: nfid
integer, intent(out):: ndims
integer ret ! NetCDF return code
ret = nf_inq_ndims (nfid, ndims)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_ndims
!===============================================================================
subroutine wrap_inq_dimid (nfid, dimname, dimid) 2,1
implicit none
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets the dimension id
!
!-------------------------------------------------------------------------------
integer, intent(in):: nfid
integer, intent(out):: dimid
character*(*), intent(in):: dimname
integer ret ! NetCDF return code
ret = nf_inq_dimid (nfid, dimname, dimid)
if(ret==NF_NOERR) return
if (ret/=NF_EBADDIM) call handle_error
(ret)
dimid=-1 ! do not exist on bad dim. This allows the user to check for dims that may not
! be in the file
end subroutine wrap_inq_dimid
!===============================================================================
subroutine wrap_inq_dimlen (nfid, dimid, dimlen) 2,1
implicit none
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets the dimension length for a given dimension
!
!-------------------------------------------------------------------------------
integer, intent(in):: nfid
integer, intent(in):: dimid
integer, intent(out):: dimlen
integer ret ! NetCDF return code
ret = nf_inq_dimlen (nfid, dimid, dimlen)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_dimlen
!===============================================================================
subroutine wrap_inq_vardimid (nfid, varid, dimids),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Returns the dimension Id's from a variable
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(out):: dimids(*)
integer ret ! NetCDF return code
ret = nf_inq_vardimid (nfid, varid, dimids)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_vardimid
!===============================================================================
subroutine wrap_inq_varndims (nfid, varid, ndims),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Returns the dimension Id's from a variable
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(out):: ndims
integer ret ! NetCDF return code
ret = nf_inq_varndims (nfid, varid, ndims)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_varndims
!===============================================================================
subroutine wrap_inq_varid (nfid, varname, varid, abort) 2,1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Returns the variable ID
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(out):: varid
character*(*), intent(in):: varname
logical, optional :: abort
integer ret ! NetCDF return code
logical :: call_endrun
ret = nf_inq_varid (nfid, varname, varid)
if (ret/=NF_NOERR ) then
call_endrun = .true.
if ( present(abort) ) then
call_endrun = abort
endif
if ( call_endrun ) then
write(iulog,*)'wrap_inq_varid: id for ',trim(varname),' not found'
call handle_error
(ret)
else
varid = -1
endif
end if
end subroutine wrap_inq_varid
!===============================================================================
subroutine wrap_inq_var (nfid, varid, varname, xtype, ndims, &,1
dimids, natts)
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Returns the variable name, type, number of dimensions, dimension ID's, and number of attributes
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(out):: xtype
integer, intent(out):: ndims
integer, intent(out):: dimids(*)
integer, intent(out):: natts
character*(*), intent(out):: varname
integer ret ! NetCDF return code
ret = nf_inq_var (nfid, varid, varname, xtype, ndims, dimids, &
natts)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_var
!===============================================================================
subroutine wrap_inq_varname (nfid, varid, varname),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Returns the variable name from the dimension ID
!
!-------------------------------------------------------------------------------
implicit none
integer ret ! NetCDF return code
integer, intent(in):: nfid
integer, intent(in):: varid
character*(*), intent(out):: varname
ret = nf_inq_varname (nfid, varid, varname)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_inq_varname
!===============================================================================
subroutine wrap_get_att_text (nfid, varid, attname, atttext),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Returns the attribute text from the given variable ID and attribute name
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
character*(*), intent(in):: attname
character*(*), intent(out):: atttext
integer ret ! NetCDF return code
ret = nf_get_att_text (nfid, varid, attname, atttext)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_GET_ATT_TEXT: error reading attribute '//trim(attname)
call handle_error
(ret)
endif
end subroutine wrap_get_att_text
!===============================================================================
subroutine wrap_put_att_text (nfid, varid, attname, atttext),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Puts the given attribute text to variable ID.
!
! This routine violates the convetion that the wrapper codes take an identical
! set of arguments as the netcdf library code. The length of the character
! argument is computed inside the wrapper.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
character*(*), intent(in):: attname
character*(*), intent(in):: atttext
integer ret ! NetCDF return code
integer siz
siz = len_trim(atttext)
ret = nf_put_att_text (nfid, varid, attname, siz, atttext)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_att_text
!===============================================================================
subroutine wrap_put_att_realx (nfid, varid, attname, xtype, len, &,1
attval)
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Puts the given real attribute to the variable id
!
!-------------------------------------------------------------------------------
implicit none
integer , intent(in):: nfid
integer , intent(in):: varid
integer , intent(in):: xtype
integer , intent(in):: len
character*(*) , intent(in):: attname
real(r8) , intent(in):: attval(len)
integer ret ! NetCDF return code
ret = nf_put_att_double (nfid, varid, attname, xtype, len, attval)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_att_realx
!===============================================================================
subroutine wrap_def_dim (nfid, dimname, len, dimid),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Defines the input dimension
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: len
integer, intent(out):: dimid
character*(*), intent(in):: dimname
integer ret ! NetCDF return code
ret = nf_def_dim (nfid, dimname, len, dimid)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_def_dim
!===============================================================================
subroutine wrap_def_var (nfid, name, xtype, nvdims, vdims, varid),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Defines the given variable
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in)::xtype
integer, intent(in)::nvdims
integer, intent(out)::varid
integer, intent(in):: vdims(nvdims+1)
character*(*), intent(in):: name
integer ret ! NetCDF return code
ret = nf_def_var (nfid, name, xtype, nvdims, vdims, varid)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_def_var
!===============================================================================
subroutine wrap_get_var_realx (nfid, varid, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets the given real variable from a input file
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
real(r8), intent(out):: arr(*)
integer ret ! NetCDF return code
ret = nf_get_var_double (nfid, varid, arr)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_GET_VAR_REALX: error reading varid =', varid
call handle_error
(ret)
end if
end subroutine wrap_get_var_realx
!===============================================================================
subroutine wrap_get_var_real4 (nfid, varid, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets the given real variable from a input file
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
real(r4), intent(out):: arr(*)
integer ret ! NetCDF return code
ret = nf_get_var_real (nfid, varid, arr)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_GET_VAR_REAL4: error reading varid =', varid
call handle_error
(ret)
end if
end subroutine wrap_get_var_real4
!===============================================================================
subroutine wrap_get_scalar_realx (nfid, varid, x),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets the given real variable from a input file
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
real(r8), intent(out):: x
integer ret ! NetCDF return code
ret = nf_get_var_double (nfid, varid, x)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_GET_SCALAR_REALX: error reading varid =', varid
call handle_error
(ret)
end if
end subroutine wrap_get_scalar_realx
!===============================================================================
subroutine wrap_get_var_int (nfid, varid, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets the given integer variable from a input file
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(out):: arr(*)
integer ret ! NetCDF return code
ret = nf_get_var_int (nfid, varid, arr)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_GET_VAR_INT: error reading varid =', varid
call handle_error
(ret)
end if
end subroutine wrap_get_var_int
!===============================================================================
subroutine wrap_get_scalar_int (nfid, varid, x),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets the given integer variable from a input file
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(out):: x
integer ret ! NetCDF return code
ret = nf_get_var_int (nfid, varid, x)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_GET_SCALAR_INT: error reading varid =', varid
call handle_error
(ret)
end if
end subroutine wrap_get_scalar_int
!===============================================================================
subroutine wrap_get_vara_realx (nfid, varid, start, count, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets a range of the given real variable from a input file
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in)::varid
integer, intent(in)::start(*)
integer, intent(in)::count(*)
real(r8), intent(out):: arr(*)
integer ret ! NetCDF return code
ret = nf_get_vara_double (nfid, varid, start, count, arr)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_GET_VARA_REALX: error reading varid =', varid
call handle_error
(ret)
end if
end subroutine wrap_get_vara_realx
!===============================================================================
subroutine wrap_get_vara_int (nfid, varid, start, count, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets a range of the given integer variable from a input file.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: start(*)
integer, intent(in):: count(*)
integer, intent(out):: arr(*)
integer ret ! NetCDF return code
ret = nf_get_vara_int (nfid, varid, start, count, arr)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_GET_VARA_INT: error reading varid =', varid
call handle_error
(ret)
end if
end subroutine wrap_get_vara_int
!===============================================================================
subroutine wrap_get_vara_text (nfid, varid, start, count, text),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Gets a range of the given text variable to input file.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: start(*)
integer, intent(in):: count(*)
character*(*), intent(out):: text(*)
integer ret ! NetCDF return code
ret = nf_get_vara_text (nfid, varid, start, count, text)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_get_vara_text
!===============================================================================
subroutine wrap_open (path, omode, ncid) 1,1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Open a netCDF file
!
!-------------------------------------------------------------------------------
implicit none
character*(*), intent(in):: path
integer, intent(in):: omode
integer, intent(out):: ncid
integer ret ! NetCDF return code
ret = nf_open (path, omode, ncid)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_OPEN: nf_open failed for file ',path
call handle_error
(ret)
end if
end subroutine wrap_open
!===============================================================================
subroutine wrap_close (ncid),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Close netCDF file
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: ncid
integer ret ! NetCDF return code
ret = nf_close (ncid)
if (ret/=NF_NOERR) then
write(iulog,*)'WRAP_CLOSE: nf_close failed for id ',ncid
call handle_error
(ret)
end if
end subroutine wrap_close
!===============================================================================
subroutine wrap_put_var_int (nfid, varid, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Put a integer variable on output file.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: arr(*)
integer ret ! NetCDF return code
ret = nf_put_var_int (nfid, varid, arr)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_var_int
!===============================================================================
subroutine wrap_put_var1_int (nfid, varid, index, ival),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Put a variable on output file at a given index.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: index(*)
integer, intent(in):: ival
integer ret ! NetCDF return code
ret = nf_put_var1_int (nfid, varid, index, ival)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_var1_int
!===============================================================================
subroutine wrap_put_vara_int (nfid, varid, start, count, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Put a range of a integer variable on a output file.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: start(*)
integer, intent(in):: count(*)
integer, intent(in):: arr(*)
integer ret ! NetCDF return code
ret = nf_put_vara_int (nfid, varid, start, count, arr)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_vara_int
!===============================================================================
subroutine wrap_put_vara_text (nfid, varid, start, count, text),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Put a range of the given text variable to output file.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: start(*)
integer, intent(in):: count(*)
character*(*), intent(in):: text(*)
integer ret ! NetCDF return code
ret = nf_put_vara_text (nfid, varid, start, count, text)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_vara_text
!===============================================================================
subroutine wrap_put_var1_realx (nfid, varid, index, val),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Put the given real variable to output file at given index.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: index(*)
real(r8), intent(in):: val
integer ret ! NetCDF return code
ret = nf_put_var1_double (nfid, varid, index, val)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_var1_realx
!===============================================================================
subroutine wrap_put_vara_realx (nfid, varid, start, count, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Output the given portion of the real array.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: start(*)
integer, intent(in):: count(*)
real(r8), intent(in):: arr(*)
integer ret ! NetCDF return code
ret = nf_put_vara_double (nfid, varid, start, count, arr)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_vara_realx
!===============================================================================
subroutine wrap_put_vara_real (nfid, varid, start, count, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Output the given portion of the real array.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
integer, intent(in):: start(*)
integer, intent(in):: count(*)
real(r4), intent(in):: arr(*)
integer ret ! NetCDF return code
ret = nf_put_vara_real (nfid, varid, start, count, arr)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_vara_real
!===============================================================================
subroutine wrap_put_var_realx (nfid, varid, arr),1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Put the given real variable to output file.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: nfid
integer, intent(in):: varid
real(r8), intent(in):: arr(*)
integer ret ! NetCDF return code
ret = nf_put_var_double (nfid, varid, arr)
if (ret/=NF_NOERR) call handle_error
(ret)
end subroutine wrap_put_var_realx
!===============================================================================
subroutine handle_error(ret) 37,1
!-------------------------------------------------------------------------------
!
! Purpose:
!
! Handle netCDF errors.
!
!-------------------------------------------------------------------------------
implicit none
integer, intent(in):: ret
write(iulog,*)nf_strerror(ret)
call endrun
('HANDLE_ERROR')
end subroutine handle_error
!===============================================================================
end module wrap_nf