#include "dtypes.h" !=================================================== ! DO NOT EDIT THIS FILE, it was generated using ./tools/genf90/genf90.pl ! Any changes you make to this file may be lost !=================================================== module ncdio_pio !----------------------------------------------------------------------- !BOP ! ! !MODULE: ncdio_pioMod ! ! !DESCRIPTION: ! Generic interfaces to write fields to netcdf files for CLM ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8, i4=>shr_kind_i4, shr_kind_cl, r4 => shr_kind_r4 use shr_infnan_mod , only : nan => shr_infnan_nan, isnan => shr_infnan_isnan, assignment(=) use shr_sys_mod , only : shr_sys_abort use shr_file_mod , only : shr_file_getunit, shr_file_freeunit use shr_string_mod , only : shr_string_toUpper use shr_log_mod , only : errMsg => shr_log_errMsg use spmdMod , only : masterproc, mpicom, iam, npes use spmdMod , only : MPI_REAL8, MPI_INTEGER, MPI_LOGICAL use clm_varcon , only : spval,ispval, grlnd, nameg, namel, namec, namep use clm_varctl , only : single_column, iulog use shr_sys_mod , only : shr_sys_flush use decompMod , only : get_clmlevel_gsize,get_clmlevel_gsmap use perf_mod , only : t_startf, t_stopf use fileutils , only : getavu, relavu use mct_mod , only : mct_gsMap, mct_gsMap_lsize, mct_gsMap_gsize, mct_gsMap_orderedPoints use pio , only : file_desc_t, io_desc_t, iosystem_desc_t use pio , only : pio_bcast_error, pio_char, pio_clobber, pio_closefile, pio_createfile, pio_def_dim use pio , only : pio_def_var, pio_double, pio_redef, pio_enddef, pio_get_att, pio_get_var, pio_global, pio_initdecomp use pio , only : pio_inq_att, pio_inq_dimid, pio_inq_dimlen, pio_inq_dimname, pio_inq_vardimid, pio_inq_varid use pio , only : pio_inq_attname, pio_inq_varname, pio_inq_varndims, pio_inquire, pio_int, pio_internal_error use pio , only : pio_noclobber, pio_noerr, pio_nofill, pio_nowrite, pio_offset_kind, pio_openfile use pio , only : pio_put_att, pio_put_var, pio_read_darray, pio_real, pio_seterrorhandling use pio , only : pio_setframe, pio_unlimited, pio_write, pio_write_darray, var_desc_t use pio , only : pio_iotask_rank, PIO_REARR_SUBSET, PIO_REARR_BOX, PIO_64BIT_OFFSET use pio , only : pio_inq_vartype, pio_real use array_utils , only : convert_to_logical ! ! !PUBLIC TYPES: implicit none private save ! ! !PUBLIC MEMBER FUNCTIONS: ! public :: check_var ! determine if variable is on netcdf file public :: check_dim ! determine if dimension is on netcdf file public :: check_var_or_dim ! determine if variable or dimension is on netcdf file public :: check_att ! check if attribute is on file public :: check_dim_size ! validity check on dimension public :: ncd_pio_openfile ! open a file public :: ncd_pio_createfile ! create a new file public :: ncd_pio_closefile ! close a file public :: ncd_pio_init ! called from clm_comp public :: ncd_redef ! re-enter define mode public :: ncd_enddef ! end define mode public :: ncd_inqnatts ! inquire number of global attributes public :: ncd_inqattname ! inquire attribute name, given attribute number public :: ncd_putatt ! put attribute public :: ncd_getatt ! get attribute public :: ncd_defdim ! define dimension public :: ncd_inqdid ! inquire dimension id public :: ncd_inqdname ! inquire dimension name public :: ncd_inqdlen ! inquire dimension length public :: ncd_inqfdims ! inquire file dimnesions public :: ncd_defvar ! define variables public :: ncd_inqvid ! inquire variable id public :: ncd_inqvname ! inquire variable name public :: ncd_inqvtype ! inquire variable type public :: ncd_inqvdims ! inquire variable ndims public :: ncd_inqvdids ! inquire variable dimids public :: ncd_inqvdlen ! inquire variable dimension size public :: ncd_inqvdname ! inquire variable dimension name public :: ncd_io ! write local data integer,parameter,public :: ncd_int = pio_int integer,parameter,public :: ncd_log =-pio_int integer,parameter,public :: ncd_float = pio_real integer,parameter,public :: ncd_double = pio_double integer,parameter,public :: ncd_char = pio_char integer,parameter,public :: ncd_global = pio_global integer,parameter,public :: ncd_write = pio_write integer,parameter,public :: ncd_nowrite = pio_nowrite integer,parameter,public :: ncd_clobber = pio_clobber integer,parameter,public :: ncd_noclobber = pio_noclobber integer,parameter,public :: ncd_nofill = pio_nofill integer,parameter,public :: ncd_unlimited = pio_unlimited ! PIO types needed for ncdio_pio interface calls public file_desc_t public var_desc_t ! ! !PRIVATE MEMBER FUNCTIONS: ! # 96 "src/main/ncdio_pio.F90.in" interface ncd_defvar module procedure ncd_defvar_bynf module procedure ncd_defvar_bygrid end interface # 101 "src/main/ncdio_pio.F90.in" interface ncd_putatt module procedure ncd_putatt_int module procedure ncd_putatt_real module procedure ncd_putatt_char end interface # 107 "src/main/ncdio_pio.F90.in" interface ncd_getatt module procedure ncd_getatt_char module procedure ncd_getatt_int end interface ncd_getatt # 112 "src/main/ncdio_pio.F90.in" interface ncd_io module procedure ncd_io_char_var0_start_glob !DIMS 0,1 module procedure ncd_io_0d_log_glob !DIMS 0,1 module procedure ncd_io_1d_log_glob !TYPE int,double !DIMS 0,1,2,3 module procedure ncd_io_0d_int_glob !TYPE int,double !DIMS 0,1,2,3 module procedure ncd_io_1d_int_glob !TYPE int,double !DIMS 0,1,2,3 module procedure ncd_io_2d_int_glob !TYPE int,double !DIMS 0,1,2,3 module procedure ncd_io_3d_int_glob !TYPE int,double !DIMS 0,1,2,3 module procedure ncd_io_0d_double_glob !TYPE int,double !DIMS 0,1,2,3 module procedure ncd_io_1d_double_glob !TYPE int,double !DIMS 0,1,2,3 module procedure ncd_io_2d_double_glob !TYPE int,double !DIMS 0,1,2,3 module procedure ncd_io_3d_double_glob !TYPE text !DIMS 0,1,2 module procedure ncd_io_0d_text_glob !TYPE text !DIMS 0,1,2 module procedure ncd_io_1d_text_glob !TYPE text !DIMS 0,1,2 module procedure ncd_io_2d_text_glob !TYPE int,double !DIMS 1,2,3 module procedure ncd_io_1d_int !TYPE int,double !DIMS 1,2,3 module procedure ncd_io_2d_int !TYPE int,double !DIMS 1,2,3 module procedure ncd_io_3d_int !TYPE int,double !DIMS 1,2,3 module procedure ncd_io_1d_double !TYPE int,double !DIMS 1,2,3 module procedure ncd_io_2d_double !TYPE int,double !DIMS 1,2,3 module procedure ncd_io_3d_double !TYPE logical !DIMS 1 module procedure ncd_io_1d_logical end interface # 135 "src/main/ncdio_pio.F90.in" interface ncd_inqvdlen module procedure ncd_inqvdlen_byDesc module procedure ncd_inqvdlen_byName end interface # 140 "src/main/ncdio_pio.F90.in" interface ncd_inqvdname module procedure ncd_inqvdname_byDesc module procedure ncd_inqvdname_byName end interface # 145 "src/main/ncdio_pio.F90.in" interface read_darray_dispatcher !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_int_dispatcher_1 !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_int_dispatcher_2 !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_int_dispatcher_3 !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_double_dispatcher_1 !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_double_dispatcher_2 !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_double_dispatcher_3 !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_logical_dispatcher_1 !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_logical_dispatcher_2 !TYPE int,double,logical !DIMS 1,2,3 module procedure read_darray_logical_dispatcher_3 end interface read_darray_dispatcher private :: ncd_getiodesc ! obtain iodesc private :: scam_field_offsets ! get offset to proper lat/lon gridcell for SCAM integer,parameter,private :: debug = 0 ! local debug level integer , parameter , public :: max_string_len = 256 ! length of strings real(r8), parameter , public :: fillvalue = 1.e36_r8 ! fill value for netcdf fields integer, public :: io_type integer :: io_netcdf_format type(iosystem_desc_t), pointer, public :: pio_subsystem type iodesc_plus_type character(len=64) :: name type(IO_desc_t) :: iodesc integer :: type integer :: ndims integer :: dims(4) integer :: dimids(4) end type iodesc_plus_type integer,parameter ,private :: max_iodesc = 100 integer ,private :: num_iodesc = 0 type(iodesc_plus_type) ,private, target :: iodesc_list(max_iodesc) character(len=*), parameter, private :: sourcefile = & __FILE__ !----------------------------------------------------------------------- # 179 "src/main/ncdio_pio.F90.in" contains !----------------------------------------------------------------------- # 182 "src/main/ncdio_pio.F90.in" subroutine ncd_pio_init() ! ! !DESCRIPTION: ! Initial PIO ! ! !USES: use shr_pio_mod , only : shr_pio_getiosys, shr_pio_getiotype ! tcx , shr_pio_getioformat use clm_varctl , only : inst_name !----------------------------------------------------------------------- PIO_subsystem => shr_pio_getiosys(inst_name) io_type = shr_pio_getiotype(inst_name) !tcx io_netcdf_format = shr_pio_getioformat(inst_name) io_netcdf_format = PIO_64BIT_OFFSET # 196 "src/main/ncdio_pio.F90.in" end subroutine ncd_pio_init !----------------------------------------------------------------------- # 199 "src/main/ncdio_pio.F90.in" subroutine ncd_pio_openfile(file, fname, mode) ! ! !DESCRIPTION: ! Open a NetCDF PIO file ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: file ! Output PIO file handle character(len=*) , intent(in) :: fname ! Input filename to open integer , intent(in) :: mode ! file mode ! ! !LOCAL VARIABLES: integer :: ierr !----------------------------------------------------------------------- ierr = pio_openfile(pio_subsystem, file, io_type, fname, mode) if(ierr/= PIO_NOERR) then call shr_sys_abort('ncd_pio_openfile ERROR: Failed to open file') else if(pio_iotask_rank(pio_subsystem)==0 .and. masterproc) then write(iulog,*) 'Opened existing file ', trim(fname), file%fh end if # 221 "src/main/ncdio_pio.F90.in" end subroutine ncd_pio_openfile !----------------------------------------------------------------------- # 224 "src/main/ncdio_pio.F90.in" subroutine ncd_pio_closefile(file) ! ! !DESCRIPTION: ! Close a NetCDF PIO file ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: file ! PIO file handle to close !----------------------------------------------------------------------- call pio_closefile(file) # 235 "src/main/ncdio_pio.F90.in" end subroutine ncd_pio_closefile !----------------------------------------------------------------------- # 238 "src/main/ncdio_pio.F90.in" subroutine ncd_pio_createfile(file, fname) ! ! !DESCRIPTION: ! Create a new NetCDF file with PIO ! ! !USES: use pio, only : pio_iotype_pnetcdf, pio_iotype_netcdf,pio_iotask_rank ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: file ! PIO file descriptor character(len=*) , intent(in) :: fname ! File name to create ! ! !LOCAL VARIABLES: integer :: ierr !----------------------------------------------------------------------- ierr = pio_createfile(pio_subsystem, file, io_type, fname, ior(PIO_CLOBBER,io_netcdf_format)) if(ierr/= PIO_NOERR) then call shr_sys_abort( ' ncd_pio_createfile ERROR: Failed to open file to write: '//trim(fname)) else if(pio_iotask_rank(pio_subsystem)==0 .and. masterproc) then write(iulog,*) 'Opened file ', trim(fname), ' to write', file%fh end if # 263 "src/main/ncdio_pio.F90.in" end subroutine ncd_pio_createfile !----------------------------------------------------------------------- # 266 "src/main/ncdio_pio.F90.in" subroutine check_var(ncid, varname, readvar, vardesc, print_err ) ! ! !DESCRIPTION: ! Check if variable is on netcdf file ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor character(len=*) , intent(in) :: varname ! Varible name to check logical , intent(out) :: readvar ! If variable exists or not type(Var_desc_t) , optional, intent(out) :: vardesc ! Output variable descriptor (if desired) logical , optional, intent(in) :: print_err ! If should print about error ! ! !LOCAL VARIABLES: integer :: ret ! return value logical :: log_err ! if should log error type(Var_desc_t) :: vardesc_local character(len=*),parameter :: subname='check_var' ! subroutine name !----------------------------------------------------------------------- if ( present(print_err) )then log_err = print_err else log_err = .true. end if readvar = .true. call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) ret = PIO_inq_varid (ncid, varname, vardesc_local) if (present(vardesc)) then vardesc = vardesc_local end if if (ret /= PIO_noerr) then readvar = .false. if (masterproc .and. log_err) & write(iulog,*) subname//': variable ',trim(varname),' is not on dataset' end if call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) # 304 "src/main/ncdio_pio.F90.in" end subroutine check_var !----------------------------------------------------------------------- # 307 "src/main/ncdio_pio.F90.in" subroutine check_dim(ncid, dimname, dimexist) ! ! !DESCRIPTION: ! Check if dimension is on netcdf file ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor character(len=*) , intent(in) :: dimname ! dimension name logical , intent(out) :: dimexist ! if this dimension exists or not ! ! !LOCAL VARIABLES: integer :: dimid character(len=*), parameter :: subname = 'check_dim' !----------------------------------------------------------------------- call ncd_inqdid(ncid, dimname, dimid, dimexist) # 325 "src/main/ncdio_pio.F90.in" end subroutine check_dim !----------------------------------------------------------------------- # 328 "src/main/ncdio_pio.F90.in" subroutine check_var_or_dim(ncid, name, is_dim, exists) ! ! !DESCRIPTION: ! Check if variable or dimension is on netcdf file ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor character(len=*) , intent(in) :: name ! variable or dimension name to check logical , intent(in) :: is_dim ! if true, check for dimension; if false, check for variable logical , intent(out) :: exists ! whether the given variable or dimension exists on file ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'check_var_or_dim' !----------------------------------------------------------------------- if (is_dim) then call check_dim(ncid, name, exists) else call check_var(ncid, name, exists, print_err=.false.) end if # 350 "src/main/ncdio_pio.F90.in" end subroutine check_var_or_dim !----------------------------------------------------------------------- # 353 "src/main/ncdio_pio.F90.in" subroutine check_att(ncid, varid, attrib, att_found) ! ! !DESCRIPTION: ! Check if attribute is on file ! ! !USES: ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id integer ,intent(in) :: varid ! netcdf var id character(len=*) ,intent(in) :: attrib ! netcdf attrib logical ,intent(out) :: att_found ! true if the attribute was found ! ! !LOCAL VARIABLES: integer :: att_type ! attribute type integer(pio_offset_kind) :: att_len ! attribute length integer :: status character(len=*), parameter :: subname = 'check_att' !----------------------------------------------------------------------- att_found = .true. call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) status = PIO_inq_att(ncid, varid, trim(attrib), att_type, att_len) if (status /= PIO_noerr) then att_found = .false. end if call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) # 382 "src/main/ncdio_pio.F90.in" end subroutine check_att !----------------------------------------------------------------------- # 385 "src/main/ncdio_pio.F90.in" subroutine check_dim_size(ncid, dimname, value, msg) ! ! !DESCRIPTION: ! Validity check on dimension ! ! !ARGUMENTS: class(file_desc_t),intent(in) :: ncid ! PIO file handle character(len=*) , intent(in) :: dimname ! Dimension name integer, intent(in) :: value ! Expected dimension size character(len=*), intent(in), optional :: msg ! Optional additional message printed upon error ! ! !LOCAL VARIABLES: integer :: dimid, dimlen ! temporaries integer :: status ! error code character(len=*),parameter :: subname='check_dim_size' ! subroutine name !----------------------------------------------------------------------- status = pio_inq_dimid (ncid, trim(dimname), dimid) status = pio_inq_dimlen (ncid, dimid, dimlen) if (dimlen /= value) then write(iulog,*) subname//' ERROR: mismatch of input dimension ',dimlen, & ' with expected value ',value,' for variable ',trim(dimname) if (present(msg)) then write(iulog,'(a)') msg end if call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if # 414 "src/main/ncdio_pio.F90.in" end subroutine check_dim_size !----------------------------------------------------------------------- # 417 "src/main/ncdio_pio.F90.in" subroutine ncd_redef(ncid) ! ! !DESCRIPTION: ! Re-enter define mode for this netcdf file ! ! Remember to call ncd_enddef when finished ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id ! ! !LOCAL VARIABLES: integer :: status ! error status !----------------------------------------------------------------------- status = PIO_redef(ncid) # 433 "src/main/ncdio_pio.F90.in" end subroutine ncd_redef !----------------------------------------------------------------------- # 436 "src/main/ncdio_pio.F90.in" subroutine ncd_enddef(ncid) ! ! !DESCRIPTION: ! enddef netcdf file ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id ! ! !LOCAL VARIABLES: integer :: status ! error status !----------------------------------------------------------------------- status = PIO_enddef(ncid) # 450 "src/main/ncdio_pio.F90.in" end subroutine ncd_enddef !----------------------------------------------------------------------- # 453 "src/main/ncdio_pio.F90.in" subroutine ncd_inqdid(ncid,name,dimid,dimexist) ! ! !DESCRIPTION: ! inquire on a dimension id ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: name ! dimension name integer , intent(out):: dimid ! dimension id logical,optional , intent(out):: dimexist ! if this dimension exists or not ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- if ( present(dimexist) )then call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) end if status = PIO_inq_dimid(ncid,name,dimid) if ( present(dimexist) )then if ( status == PIO_NOERR)then dimexist = .true. else dimexist = .false. end if call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) end if # 481 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqdid !----------------------------------------------------------------------- # 484 "src/main/ncdio_pio.F90.in" subroutine ncd_inqdlen(ncid,dimid,len,name) ! ! !DESCRIPTION: ! Gets the length of the given dimension ! ! If 'name' is absent, then 'dimid' is used as an input: the dimension id to inquire. ! If 'name' is present, then it gives the name of the dimension to inquire, and ! 'dimid' is set to the ID associated with this dimension. ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id integer , intent(inout) :: dimid ! dimension id integer , intent(out) :: len ! dimension len character(len=*), optional, intent(in) :: name ! dimension name ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- if ( present(name) )then call ncd_inqdid(ncid,name,dimid) end if len = -1 status = PIO_inq_dimlen(ncid,dimid,len) # 509 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqdlen !----------------------------------------------------------------------- # 512 "src/main/ncdio_pio.F90.in" subroutine ncd_inqdname(ncid,dimid,dname) ! ! !DESCRIPTION: ! inquire dim name ! ! !ARGUMENTS: class(file_desc_t), intent(in) :: ncid ! netcdf file id integer , intent(in) :: dimid ! dimension id character(len=*) , intent(out):: dname ! dimension name ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- status = PIO_inq_dimname(ncid,dimid,dname) # 528 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqdname !----------------------------------------------------------------------- # 531 "src/main/ncdio_pio.F90.in" subroutine ncd_inqfdims(ncid, isgrid2d, ni, nj, ns) ! ! !ARGUMENTS: class(file_desc_t), intent(inout):: ncid logical , intent(out) :: isgrid2d integer , intent(out) :: ni integer , intent(out) :: nj integer , intent(out) :: ns ! ! !LOCAL VARIABLES: integer :: dimid ! netCDF id integer :: ier ! error status character(len=32) :: subname = 'ncd_inqfdims' ! subroutine name !----------------------------------------------------------------------- if (single_column) then ni = 1 nj = 1 ns = 1 isgrid2d = .true. RETURN end if ni = 0 nj = 0 call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) ier = pio_inq_dimid (ncid, 'lon', dimid) if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) ier = pio_inq_dimid (ncid, 'lat', dimid) if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) ier = pio_inq_dimid (ncid, 'lsmlon', dimid) if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) ier = pio_inq_dimid (ncid, 'lsmlat', dimid) if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) ier = pio_inq_dimid (ncid, 'ni', dimid) if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, ni) ier = pio_inq_dimid (ncid, 'nj', dimid) if (ier == PIO_NOERR) ier = pio_inq_dimlen(ncid, dimid, nj) ier = pio_inq_dimid (ncid, 'gridcell', dimid) if (ier == PIO_NOERR) then ier = pio_inq_dimlen(ncid, dimid, ni) if (ier == PIO_NOERR) nj = 1 end if call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (ni == 0 .or. nj == 0) then write(iulog,*) trim(subname),' ERROR: ni,nj = ',ni,nj,' cannot be zero ' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if if (nj == 1) then isgrid2d = .false. else isgrid2d = .true. end if ns = ni*nj # 594 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqfdims !----------------------------------------------------------------------- # 597 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvid(ncid,name,varid,vardesc,readvar) ! ! !DESCRIPTION: ! Inquire on a variable ID ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: name ! variable name integer , intent(out) :: varid ! variable id type(Var_desc_t) , intent(out) :: vardesc ! variable descriptor logical, optional , intent(out) :: readvar ! does variable exist ! ! !LOCAL VARIABLES: integer :: ret ! return code character(len=*),parameter :: subname='ncd_inqvid' ! subroutine name !----------------------------------------------------------------------- if (present(readvar)) then readvar = .false. call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) ret = PIO_inq_varid(ncid,name,vardesc) if (ret /= PIO_noerr) then if (masterproc) write(iulog,*) subname//': variable ',trim(name),' is not on dataset' readvar = .false. else readvar = .true. end if call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) else ret = PIO_inq_varid(ncid,name,vardesc) endif varid = vardesc%varid # 630 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvid !----------------------------------------------------------------------- # 633 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvtype(ncid, vardesc, vartype) ! ! !DESCRIPTION: ! Inquire variable type ! ! !ARGUMENTS: class(file_desc_t) , intent(in) :: ncid ! netcdf file id type(var_desc_t) , intent(in) :: vardesc ! variable descriptor integer , intent(out) :: vartype ! type of var in file (ncd_int, ncd_float, ncd_double, etc.) ! ! !LOCAL VARIABLES: integer :: status character(len=*), parameter :: subname = 'ncd_inqvtype' !----------------------------------------------------------------------- vartype = -9999 status = pio_inq_vartype(ncid, vardesc, vartype) # 652 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvtype !----------------------------------------------------------------------- # 655 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvdims(ncid,ndims,vardesc) ! ! !DESCRIPTION: ! inquire variable dimensions ! ! !ARGUMENTS: class(file_desc_t), intent(in) :: ncid ! netcdf file id integer , intent(out) :: ndims ! variable ndims type(Var_desc_t) , intent(inout):: vardesc ! variable descriptor ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- ndims = -1 status = PIO_inq_varndims(ncid,vardesc,ndims) # 672 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvdims !----------------------------------------------------------------------- # 675 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvname(ncid,varid,vname,vardesc) ! ! !DESCRIPTION: ! inquire variable name ! ! !ARGUMENTS: class(file_desc_t), intent(in) :: ncid ! netcdf file id integer , intent(in) :: varid ! variable id character(len=*) , intent(out) :: vname ! variable vname type(Var_desc_t) , intent(inout):: vardesc ! variable descriptor ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- vname = '' status = PIO_inq_varname(ncid,vardesc,vname) # 693 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvname !----------------------------------------------------------------------- # 696 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvdids(ncid,dids,vardesc) ! ! !DESCRIPTION: ! inquire variable dimension ids ! ! !ARGUMENTS: class(file_desc_t),intent(in) :: ncid ! netcdf file id integer ,intent(out) :: dids(:) ! variable dids type(Var_desc_t) ,intent(inout):: vardesc ! variable descriptor ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- dids = -1 status = PIO_inq_vardimid(ncid,vardesc,dids) # 713 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvdids !----------------------------------------------------------------------- # 716 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvdlen_byDesc(ncid,vardesc,dimnum,dlen,err_code) ! ! !DESCRIPTION: ! inquire size of one of a variable's dimensions, given a vardesc ! ! If the variable has n dimensions, then dimnum should be between 1 and n; this routine ! returns the size of the dimnum'th dimension. ! ! If there is an error condition, dlen will be -1, and err_code will hold the error ! code; possible error codes are: ! 0: no error ! 1: dimnum out of range ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id type(Var_desc_t) ,intent(inout) :: vardesc ! variable descriptor integer ,intent(in) :: dimnum ! dimension number to query integer ,intent(out) :: dlen ! length of the dimension integer ,intent(out) :: err_code ! error code (0 means no error) ! ! !LOCAL VARIABLES: integer :: ndims ! number of dimensions integer, allocatable :: dimids(:) ! dimension IDs integer, parameter :: dlen_invalid = -1 integer, parameter :: error_none = 0 integer, parameter :: error_dimnum_out_of_range = 1 !----------------------------------------------------------------------- err_code = error_none call ncd_inqvdims(ncid, ndims, vardesc) if (dimnum > 0 .and. dimnum <= ndims) then allocate(dimids(ndims)) call ncd_inqvdids(ncid, dimids, vardesc) call ncd_inqdlen(ncid, dimids(dimnum), dlen) deallocate(dimids) else dlen = dlen_invalid err_code = error_dimnum_out_of_range end if # 759 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvdlen_byDesc !----------------------------------------------------------------------- # 763 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvdlen_byName(ncid,varname,dimnum,dlen,err_code) ! ! !DESCRIPTION: ! inquire size of one of a variable's dimensions, given a variable name ! ! If the variable has n dimensions, then dimnum should be between 1 and n; this routine ! returns the size of the dimnum'th dimension. ! ! If there is an error condition, dlen will be -1, and err_code will hold the error ! code; possible error codes are: ! 0: no error ! 1: dimnum out of range ! 11: variable not found ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id character(len=*) ,intent(in) :: varname ! variable name integer ,intent(in) :: dimnum ! dimension number to query integer ,intent(out) :: dlen ! length of the dimension integer ,intent(out) :: err_code ! error code (0 means no error) ! ! !LOCAL VARIABLES: type(Var_desc_t) :: vardesc ! variable descriptor logical :: readvar ! whether the variable was found integer, parameter :: dlen_invalid = -1 integer, parameter :: error_variable_not_found = 11 !----------------------------------------------------------------------- call check_var(ncid, varname, readvar, vardesc=vardesc) if (readvar) then call ncd_inqvdlen_byDesc(ncid, vardesc, dimnum, dlen, err_code) else dlen = dlen_invalid err_code = error_variable_not_found end if # 799 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvdlen_byName !----------------------------------------------------------------------- # 802 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvdname_byDesc(ncid,vardesc,dimnum,dname,err_code) ! ! !DESCRIPTION: ! Inquire name of one of a variable's dimensions, given a vardesc ! ! If the variable has n dimensions, then dimnum should be between 1 and n; this ! routine returns the name of the dimnum'th dimension. ! ! If there is an error condition, dname will be ' ', and err_code will hold the error ! code; possible error codes are: ! 0: no error ! 1: dimnum out of range ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id type(Var_desc_t) ,intent(inout) :: vardesc ! variable descriptor integer ,intent(in) :: dimnum ! dimension number to query character(len=*) ,intent(out) :: dname ! name of the dimension integer ,intent(out) :: err_code ! error code (0 means no error) ! ! !LOCAL VARIABLES: integer :: ndims ! number of dimensions integer, allocatable :: dimids(:) ! dimension IDs character(len=*), parameter :: dname_invalid = ' ' integer, parameter :: error_none = 0 integer, parameter :: error_dimnum_out_of_range = 1 character(len=*), parameter :: subname = 'ncd_inqvdname_byDesc' !----------------------------------------------------------------------- err_code = error_none call ncd_inqvdims(ncid, ndims, vardesc) if (dimnum > 0 .and. dimnum <= ndims) then allocate(dimids(ndims)) call ncd_inqvdids(ncid, dimids, vardesc) call ncd_inqdname(ncid, dimids(dimnum), dname) deallocate(dimids) else dname = dname_invalid err_code = error_dimnum_out_of_range end if # 847 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvdname_byDesc !----------------------------------------------------------------------- # 850 "src/main/ncdio_pio.F90.in" subroutine ncd_inqvdname_byName(ncid,varname,dimnum,dname,err_code) ! ! !DESCRIPTION: ! Inquire name of one of a variable's dimensions, given a variable name ! ! If the variable has n dimensions, then dimnum should be between 1 and n; this ! routine returns the name of the dimnum'th dimension. ! ! If there is an error condition, dname will be ' ', and err_code will hold the error ! code; possible error codes are: ! 0: no error ! 1: dimnum out of range ! 11: variable not found ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id character(len=*) ,intent(in) :: varname ! variable name integer ,intent(in) :: dimnum ! dimension number to query character(len=*) ,intent(out) :: dname ! name of the dimension integer ,intent(out) :: err_code ! error code (0 means no error) ! ! !LOCAL VARIABLES: type(Var_desc_t) :: vardesc ! variable descriptor logical :: readvar ! whether the variable was found character(len=*), parameter :: dname_invalid = ' ' integer, parameter :: error_variable_not_found = 11 character(len=*), parameter :: subname = 'ncd_inqvdname_byName' !----------------------------------------------------------------------- call check_var(ncid, varname, readvar, vardesc=vardesc) if (readvar) then call ncd_inqvdname_byDesc(ncid, vardesc, dimnum, dname, err_code) else dname = dname_invalid err_code = error_variable_not_found end if # 888 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqvdname_byName !----------------------------------------------------------------------- # 891 "src/main/ncdio_pio.F90.in" subroutine ncd_inqnatts(ncid, nattributes) ! ! !DESCRIPTION: ! Inquire number of global attributes ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id integer , intent(out) :: nattributes ! number of global attributes ! ! !LOCAL VARIABLES: integer :: status character(len=*), parameter :: subname = 'ncd_inqnatts' !----------------------------------------------------------------------- status = PIO_inquire(ncid, nattributes=nattributes) # 908 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqnatts !----------------------------------------------------------------------- # 911 "src/main/ncdio_pio.F90.in" subroutine ncd_inqattname(ncid, varid, attnum, attname) ! ! !DESCRIPTION: ! Inquire attribute name, given attribute number ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! netcdf file id integer , intent(in) :: varid ! netcdf var id (can be ncd_global) integer , intent(in) :: attnum ! attribute number character(len=*) , intent(out) :: attname ! ! !LOCAL VARIABLES: integer :: status character(len=*), parameter :: subname = 'ncd_inqattname' !----------------------------------------------------------------------- status = PIO_inq_attname(ncid, varid, attnum, attname) # 930 "src/main/ncdio_pio.F90.in" end subroutine ncd_inqattname !----------------------------------------------------------------------- # 933 "src/main/ncdio_pio.F90.in" subroutine ncd_putatt_int(ncid,varid,attrib,value,xtype) ! ! !DESCRIPTION: ! put integer attributes ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id integer ,intent(in) :: varid ! netcdf var id character(len=*) ,intent(in) :: attrib ! netcdf attrib integer ,intent(in) :: value ! netcdf attrib value integer,optional ,intent(in) :: xtype ! netcdf data type ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- status = PIO_put_att(ncid,varid,trim(attrib),value) # 951 "src/main/ncdio_pio.F90.in" end subroutine ncd_putatt_int !----------------------------------------------------------------------- # 954 "src/main/ncdio_pio.F90.in" subroutine ncd_putatt_char(ncid,varid,attrib,value,xtype) ! ! !DESCRIPTION: ! put character attributes ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id integer ,intent(in) :: varid ! netcdf var id character(len=*) ,intent(in) :: attrib ! netcdf attrib character(len=*) ,intent(in) :: value ! netcdf attrib value integer,optional ,intent(in) :: xtype ! netcdf data type ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- status = PIO_put_att(ncid,varid,trim(attrib),value) # 972 "src/main/ncdio_pio.F90.in" end subroutine ncd_putatt_char !----------------------------------------------------------------------- # 975 "src/main/ncdio_pio.F90.in" subroutine ncd_putatt_real(ncid,varid,attrib,value,xtype) ! ! !DESCRIPTION: ! put real attributes ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id integer ,intent(in) :: varid ! netcdf var id character(len=*) ,intent(in) :: attrib ! netcdf attrib real(r8) ,intent(in) :: value ! netcdf attrib value integer ,intent(in) :: xtype ! netcdf data type ! ! !LOCAL VARIABLES: integer :: status real*4 :: value4 !----------------------------------------------------------------------- value4 = value if (xtype == pio_double) then status = PIO_put_att(ncid,varid,trim(attrib),value) else status = PIO_put_att(ncid,varid,trim(attrib),value4) endif # 1000 "src/main/ncdio_pio.F90.in" end subroutine ncd_putatt_real !----------------------------------------------------------------------- # 1003 "src/main/ncdio_pio.F90.in" subroutine ncd_getatt_char(ncid,varid,attrib,value) ! ! !DESCRIPTION: ! get a character attribute ! ! !USES: ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id integer ,intent(in) :: varid ! netcdf var id character(len=*) ,intent(in) :: attrib ! netcdf attrib character(len=*) ,intent(out) :: value ! netcdf attrib value ! ! !LOCAL VARIABLES: integer :: status character(len=*), parameter :: subname = 'ncd_getatt_char' !----------------------------------------------------------------------- status = PIO_get_att(ncid,varid,trim(attrib),value) # 1024 "src/main/ncdio_pio.F90.in" end subroutine ncd_getatt_char !----------------------------------------------------------------------- # 1027 "src/main/ncdio_pio.F90.in" subroutine ncd_getatt_int(ncid,varid,attrib,value) ! ! !DESCRIPTION: ! get an integer attribute ! ! !USES: ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id integer ,intent(in) :: varid ! netcdf var id character(len=*) ,intent(in) :: attrib ! netcdf attrib integer ,intent(out) :: value ! netcdf attrib value ! ! !LOCAL VARIABLES: integer :: status character(len=*), parameter :: subname = 'ncd_getatt_int' !----------------------------------------------------------------------- status = PIO_get_att(ncid,varid,trim(attrib),value) # 1048 "src/main/ncdio_pio.F90.in" end subroutine ncd_getatt_int !----------------------------------------------------------------------- # 1052 "src/main/ncdio_pio.F90.in" subroutine ncd_defdim(ncid,attrib,value,dimid) ! ! !DESCRIPTION: ! define dimension ! ! !ARGUMENTS: class(file_desc_t), intent(in) :: ncid ! netcdf file id character(len=*) , intent(in) :: attrib ! netcdf attrib integer , intent(in) :: value ! netcdf attrib value integer , intent(out):: dimid ! netcdf dimension id ! ! !LOCAL VARIABLES: integer :: status !----------------------------------------------------------------------- status = pio_def_dim(ncid,attrib,value,dimid) # 1069 "src/main/ncdio_pio.F90.in" end subroutine ncd_defdim !----------------------------------------------------------------------- # 1072 "src/main/ncdio_pio.F90.in" subroutine ncd_defvar_bynf(ncid, varname, xtype, ndims, dimid, varid, & long_name, units, cell_method, missing_value, fill_value, & imissing_value, ifill_value, comment, flag_meanings, & flag_values, nvalid_range ) ! ! !DESCRIPTION: ! Define a netcdf variable ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: varname ! variable name integer , intent(in) :: xtype ! external type integer , intent(in) :: ndims ! number of dims integer , intent(inout) :: varid ! returned var id integer , intent(in), optional :: dimid(:) ! dimids character(len=*) , intent(in), optional :: long_name ! attribute character(len=*) , intent(in), optional :: units ! attribute character(len=*) , intent(in), optional :: cell_method ! attribute character(len=*) , intent(in), optional :: comment ! attribute character(len=*) , intent(in), optional :: flag_meanings(:) ! 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 integer , intent(in), optional :: flag_values(:) ! attribute for int integer , intent(in), optional :: nvalid_range(2) ! attribute for int ! ! !LOCAL VARIABLES: integer :: n ! indices integer :: ldimid(4) ! local dimid integer :: dimid0(1) ! local dimid integer :: status ! error status integer :: lxtype ! local external type (in case logical variable) type(var_desc_t) :: vardesc ! local vardesc character(len=128) :: dimname ! temporary character(len=256) :: str ! temporary character(len=*),parameter :: subname='ncd_defvar_bynf' ! subroutine name !----------------------------------------------------------------------- varid = -1 dimid0 = 0 ldimid = 0 if (present(dimid)) then ldimid(1:ndims) = dimid(1:ndims) else ! ndims must be zero if dimid not present if (ndims /= 0) then write(iulog,*) subname//' ERROR: dimid not supplied and ndims ne 0 ',trim(varname),ndims call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif endif if ( xtype == ncd_log )then lxtype = ncd_int else lxtype = xtype end if if (masterproc .and. debug > 1) then write(iulog,*) 'Error in defining variable = ', trim(varname) write(iulog,*) subname//' ',trim(varname),lxtype,ndims,ldimid(1:ndims) endif if (ndims > 0) then status = pio_inq_dimname(ncid,ldimid(ndims),dimname) end if ! Define variable if (present(dimid)) then status = PIO_def_var(ncid,trim(varname),lxtype,dimid(1:ndims),vardesc) else status = PIO_def_var(ncid,trim(varname),lxtype,dimid0 ,vardesc) endif varid = vardesc%varid ! ! Add attributes ! if (present(long_name)) then call ncd_putatt(ncid, varid, 'long_name', trim(long_name)) end if if (present(flag_values)) then status = PIO_put_att(ncid,varid,'flag_values',flag_values) if ( .not. present(flag_meanings)) then write(iulog,*) 'Error in defining variable = ', trim(varname) call shr_sys_abort(" ERROR:: flag_values set -- but not flag_meanings"//errMsg(sourcefile, __LINE__)) end if end if if (present(flag_meanings)) then if ( .not. present(flag_values)) then write(iulog,*) 'Error in defining variable = ', trim(varname) call shr_sys_abort(" ERROR:: flag_meanings set -- but not flag_values"//errMsg(sourcefile, __LINE__) ) end if if ( size(flag_values) /= size(flag_meanings) ) then write(iulog,*) 'Error in defining variable = ', trim(varname) call shr_sys_abort(" ERROR:: flag_meanings and flag_values dimension different"//errMsg(sourcefile, __LINE__)) end if str = flag_meanings(1) do n = 1, size(flag_meanings) if ( index(flag_meanings(n), ' ') /= 0 )then write(iulog,*) 'Error in defining variable = ', trim(varname) call shr_sys_abort(" ERROR:: flag_meanings has an invalid space in it"//errMsg(sourcefile, __LINE__) ) end if if ( n > 1 ) str = trim(str)//" "//flag_meanings(n) end do status = PIO_put_att(ncid,varid,'flag_meanings', trim(str) ) end if if (present(comment)) then call ncd_putatt(ncid, varid, 'comment', trim(comment)) end if if (present(units)) then call ncd_putatt(ncid, varid, 'units', trim(units)) end if if (present(cell_method)) then str = 'time: ' // trim(cell_method) call ncd_putatt(ncid, varid, 'cell_methods', trim(str)) end if if (present(fill_value)) then call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype) end if if (present(missing_value)) then call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype) end if if (present(ifill_value)) then call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype) end if if (present(imissing_value)) then call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype) end if if (present(nvalid_range)) then status = PIO_put_att(ncid,varid,'valid_range', nvalid_range ) end if if ( xtype == ncd_log )then status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) ) status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" ) status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) ) end if # 1209 "src/main/ncdio_pio.F90.in" end subroutine ncd_defvar_bynf !----------------------------------------------------------------------- # 1212 "src/main/ncdio_pio.F90.in" subroutine ncd_defvar_bygrid(ncid, varname, xtype, & dim1name, dim2name, dim3name, dim4name, dim5name, & long_name, units, cell_method, missing_value, fill_value, & imissing_value, ifill_value, switchdim, comment, & flag_meanings, flag_values, nvalid_range ) ! ! !DESCRIPTION: ! Define a netcdf variable ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! netcdf file id 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 character(len=*) , intent(in), optional :: comment ! attribute character(len=*) , intent(in), optional :: flag_meanings(:) ! 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 logical , intent(in), optional :: switchdim ! true=> permute dim1 and dim2 for output integer , intent(in), optional :: flag_values(:) ! attribute for int integer , intent(in), optional :: nvalid_range(2) ! attribute for int ! ! !LOCAL VARIABLES: 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=*),parameter :: subname='ncd_defvar_bygrid' ! subroutine name !----------------------------------------------------------------------- dimid(:) = 0 ! Determine dimension ids for variable if (present(dim1name)) call ncd_inqdid(ncid, dim1name, dimid(1)) if (present(dim2name)) call ncd_inqdid(ncid, dim2name, dimid(2)) if (present(dim3name)) call ncd_inqdid(ncid, dim3name, dimid(3)) if (present(dim4name)) call ncd_inqdid(ncid, dim4name, dimid(4)) if (present(dim5name)) call ncd_inqdid(ncid, dim5name, dimid(5)) ! Permute dim1 and dim2 if necessary if (present(switchdim)) then itmp = dimid(2) dimid(2) = dimid(1) dimid(1) = itmp end if ! Define variable ndims = 0 if (present(dim1name)) then do n = 1, size(dimid) if (dimid(n) /= 0) ndims = ndims + 1 end do end if call ncd_defvar_bynf(ncid,varname,xtype,ndims,dimid,varid, & long_name=long_name, units=units, cell_method=cell_method, & missing_value=missing_value, fill_value=fill_value, & imissing_value=imissing_value, ifill_value=ifill_value, & comment=comment, flag_meanings=flag_meanings, & flag_values=flag_values, nvalid_range=nvalid_range ) # 1287 "src/main/ncdio_pio.F90.in" end subroutine ncd_defvar_bygrid !------------------------------------------------------------------------ # 1290 "src/main/ncdio_pio.F90.in" subroutine ncd_io_char_var0_start_glob(vardesc, data, flag, ncid, start ) ! ! !DESCRIPTION: ! netcdf I/O of global character array with start indices input ! ! !ARGUMENTS: class(file_desc_t),intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' type(var_desc_t) , intent(in) :: vardesc ! local vardesc pointer character(len=*) , intent(inout) :: data ! raw data for this index integer , intent(in) :: start(:) ! output bounds ! ! !LOCAL VARIABLES: integer :: status ! error code character(len=*),parameter :: subname='ncd_io_char_var0_start_glob' !----------------------------------------------------------------------- if (flag == 'read') then status = pio_get_var(ncid, vardesc, start, data ) elseif (flag == 'write') then status = pio_put_var(ncid, vardesc, start, data ) endif # 1317 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_char_var0_start_glob !------------------------------------------------------------------------ !DIMS 0,1 # 1321 "src/main/ncdio_pio.F90.in" subroutine ncd_io_0d_log_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global logical variable ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name logical , intent(inout) :: data ! raw data logical, optional , intent(out) :: readvar ! was var read? integer, optional , intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(2), count(2) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file integer :: idata integer, pointer :: idata1d(:) ! Temporary integer data to send to file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims character(len=*),parameter :: subname='ncd_io_0d_log_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (0==0) if (varpresent) then status = pio_get_var(ncid, vardesc, idata) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if if ( idata == 0 )then data = .false. else if ( idata == 1 )then data = .true. else call shr_sys_abort(' ERROR: bad integer value for logical data'//errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then allocate(idata1d(size(data))) if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), idata1d) else status = pio_get_var(ncid, varid, idata1d) end if else status = pio_get_var(ncid, varid, idata1d) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if if ( any(idata1d /= 0 .and. idata1d /= 1) )then call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(sourcefile, __LINE__)) end if data = (idata1d == 1) deallocate(idata1d) endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 0 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (0==0) allocate(idata1d(1)) if ( data )then idata1d(1) = 1 else idata1d(1) = 0 end if if (present(nt)) then start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), idata1d) else status = pio_put_var(ncid, varid, idata1d) end if deallocate(idata1d) #elif (0==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt allocate(idata1d(size(data))) where( data ) idata1d = 1 elsewhere idata1d = 0 end where status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), idata1d) deallocate( idata1d ) #endif endif ! flag # 1442 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_0d_log_glob !DIMS 0,1 # 1321 "src/main/ncdio_pio.F90.in" subroutine ncd_io_1d_log_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global logical variable ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name logical , intent(inout) :: data(:) ! raw data logical, optional , intent(out) :: readvar ! was var read? integer, optional , intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(2), count(2) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file integer :: idata integer, pointer :: idata1d(:) ! Temporary integer data to send to file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims character(len=*),parameter :: subname='ncd_io_1d_log_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (1==0) if (varpresent) then status = pio_get_var(ncid, vardesc, idata) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if if ( idata == 0 )then data = .false. else if ( idata == 1 )then data = .true. else call shr_sys_abort(' ERROR: bad integer value for logical data'//errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then allocate(idata1d(size(data))) if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), idata1d) else status = pio_get_var(ncid, varid, idata1d) end if else status = pio_get_var(ncid, varid, idata1d) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if if ( any(idata1d /= 0 .and. idata1d /= 1) )then call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(sourcefile, __LINE__)) end if data = (idata1d == 1) deallocate(idata1d) endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 1 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (1==0) allocate(idata1d(1)) if ( data )then idata1d(1) = 1 else idata1d(1) = 0 end if if (present(nt)) then start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), idata1d) else status = pio_put_var(ncid, varid, idata1d) end if deallocate(idata1d) #elif (1==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt allocate(idata1d(size(data))) where( data ) idata1d = 1 elsewhere idata1d = 0 end where status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), idata1d) deallocate( idata1d ) #endif endif ! flag # 1442 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_1d_log_glob !------------------------------------------------------------------------ !DIMS 0,1,2,3 !TYPE int,double # 1447 "src/main/ncdio_pio.F90.in" subroutine ncd_io_0d_int_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name integer(i4) , intent(inout) :: data ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(0+1), count(0+1) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims integer(i4) :: temp(1) character(len=*),parameter :: subname='ncd_io_0d_int_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (0==0) if (varpresent) then status = pio_get_var(ncid, vardesc, data) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_get_var(ncid, varid, data) end if else status = pio_get_var(ncid, varid, data) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 0 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (0==0) if (present(nt)) then temp(1) = data start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) else status = pio_put_var(ncid, varid, data) end if #elif (0==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (0==2) start(1) = 1 ; count(1) = size(data, dim=1) start(2) = 1 ; count(2) = size(data, dim=2) start(3) = 1 ; count(3) = 1 if (present(nt)) start(3) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (0==3) if (present(nt)) then start(1) = 1 ; count(1) = size(data,dim=1) start(2) = 1 ; count(2) = size(data,dim=2) start(3) = 1 ; count(3) = size(data,dim=3) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_put_var(ncid, varid, data) end if #endif endif ! flag # 1557 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_0d_int_glob !DIMS 0,1,2,3 !TYPE int,double # 1447 "src/main/ncdio_pio.F90.in" subroutine ncd_io_1d_int_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name integer(i4) , intent(inout) :: data(:) ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(1+1), count(1+1) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims integer(i4) :: temp(1) character(len=*),parameter :: subname='ncd_io_1d_int_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (1==0) if (varpresent) then status = pio_get_var(ncid, vardesc, data) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_get_var(ncid, varid, data) end if else status = pio_get_var(ncid, varid, data) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 1 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (1==0) if (present(nt)) then temp(1) = data start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) else status = pio_put_var(ncid, varid, data) end if #elif (1==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (1==2) start(1) = 1 ; count(1) = size(data, dim=1) start(2) = 1 ; count(2) = size(data, dim=2) start(3) = 1 ; count(3) = 1 if (present(nt)) start(3) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (1==3) if (present(nt)) then start(1) = 1 ; count(1) = size(data,dim=1) start(2) = 1 ; count(2) = size(data,dim=2) start(3) = 1 ; count(3) = size(data,dim=3) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_put_var(ncid, varid, data) end if #endif endif ! flag # 1557 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_1d_int_glob !DIMS 0,1,2,3 !TYPE int,double # 1447 "src/main/ncdio_pio.F90.in" subroutine ncd_io_2d_int_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name integer(i4) , intent(inout) :: data(:,:) ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(2+1), count(2+1) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims integer(i4) :: temp(1) character(len=*),parameter :: subname='ncd_io_2d_int_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (2==0) if (varpresent) then status = pio_get_var(ncid, vardesc, data) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_get_var(ncid, varid, data) end if else status = pio_get_var(ncid, varid, data) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 2 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (2==0) if (present(nt)) then temp(1) = data start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) else status = pio_put_var(ncid, varid, data) end if #elif (2==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (2==2) start(1) = 1 ; count(1) = size(data, dim=1) start(2) = 1 ; count(2) = size(data, dim=2) start(3) = 1 ; count(3) = 1 if (present(nt)) start(3) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (2==3) if (present(nt)) then start(1) = 1 ; count(1) = size(data,dim=1) start(2) = 1 ; count(2) = size(data,dim=2) start(3) = 1 ; count(3) = size(data,dim=3) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_put_var(ncid, varid, data) end if #endif endif ! flag # 1557 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_2d_int_glob !DIMS 0,1,2,3 !TYPE int,double # 1447 "src/main/ncdio_pio.F90.in" subroutine ncd_io_3d_int_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name integer(i4) , intent(inout) :: data(:,:,:) ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(3+1), count(3+1) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims integer(i4) :: temp(1) character(len=*),parameter :: subname='ncd_io_3d_int_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (3==0) if (varpresent) then status = pio_get_var(ncid, vardesc, data) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_get_var(ncid, varid, data) end if else status = pio_get_var(ncid, varid, data) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 3 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (3==0) if (present(nt)) then temp(1) = data start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) else status = pio_put_var(ncid, varid, data) end if #elif (3==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (3==2) start(1) = 1 ; count(1) = size(data, dim=1) start(2) = 1 ; count(2) = size(data, dim=2) start(3) = 1 ; count(3) = 1 if (present(nt)) start(3) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (3==3) if (present(nt)) then start(1) = 1 ; count(1) = size(data,dim=1) start(2) = 1 ; count(2) = size(data,dim=2) start(3) = 1 ; count(3) = size(data,dim=3) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_put_var(ncid, varid, data) end if #endif endif ! flag # 1557 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_3d_int_glob !DIMS 0,1,2,3 !TYPE int,double # 1447 "src/main/ncdio_pio.F90.in" subroutine ncd_io_0d_double_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name real(r8) , intent(inout) :: data ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(0+1), count(0+1) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims real(r8) :: temp(1) character(len=*),parameter :: subname='ncd_io_0d_double_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (0==0) if (varpresent) then status = pio_get_var(ncid, vardesc, data) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_get_var(ncid, varid, data) end if else status = pio_get_var(ncid, varid, data) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 0 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (0==0) if (present(nt)) then temp(1) = data start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) else status = pio_put_var(ncid, varid, data) end if #elif (0==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (0==2) start(1) = 1 ; count(1) = size(data, dim=1) start(2) = 1 ; count(2) = size(data, dim=2) start(3) = 1 ; count(3) = 1 if (present(nt)) start(3) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (0==3) if (present(nt)) then start(1) = 1 ; count(1) = size(data,dim=1) start(2) = 1 ; count(2) = size(data,dim=2) start(3) = 1 ; count(3) = size(data,dim=3) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_put_var(ncid, varid, data) end if #endif endif ! flag # 1557 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_0d_double_glob !DIMS 0,1,2,3 !TYPE int,double # 1447 "src/main/ncdio_pio.F90.in" subroutine ncd_io_1d_double_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name real(r8) , intent(inout) :: data(:) ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(1+1), count(1+1) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims real(r8) :: temp(1) character(len=*),parameter :: subname='ncd_io_1d_double_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (1==0) if (varpresent) then status = pio_get_var(ncid, vardesc, data) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_get_var(ncid, varid, data) end if else status = pio_get_var(ncid, varid, data) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 1 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (1==0) if (present(nt)) then temp(1) = data start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) else status = pio_put_var(ncid, varid, data) end if #elif (1==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (1==2) start(1) = 1 ; count(1) = size(data, dim=1) start(2) = 1 ; count(2) = size(data, dim=2) start(3) = 1 ; count(3) = 1 if (present(nt)) start(3) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (1==3) if (present(nt)) then start(1) = 1 ; count(1) = size(data,dim=1) start(2) = 1 ; count(2) = size(data,dim=2) start(3) = 1 ; count(3) = size(data,dim=3) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_put_var(ncid, varid, data) end if #endif endif ! flag # 1557 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_1d_double_glob !DIMS 0,1,2,3 !TYPE int,double # 1447 "src/main/ncdio_pio.F90.in" subroutine ncd_io_2d_double_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name real(r8) , intent(inout) :: data(:,:) ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(2+1), count(2+1) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims real(r8) :: temp(1) character(len=*),parameter :: subname='ncd_io_2d_double_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (2==0) if (varpresent) then status = pio_get_var(ncid, vardesc, data) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_get_var(ncid, varid, data) end if else status = pio_get_var(ncid, varid, data) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 2 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (2==0) if (present(nt)) then temp(1) = data start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) else status = pio_put_var(ncid, varid, data) end if #elif (2==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (2==2) start(1) = 1 ; count(1) = size(data, dim=1) start(2) = 1 ; count(2) = size(data, dim=2) start(3) = 1 ; count(3) = 1 if (present(nt)) start(3) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (2==3) if (present(nt)) then start(1) = 1 ; count(1) = size(data,dim=1) start(2) = 1 ; count(2) = size(data,dim=2) start(3) = 1 ; count(3) = size(data,dim=3) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_put_var(ncid, varid, data) end if #endif endif ! flag # 1557 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_2d_double_glob !DIMS 0,1,2,3 !TYPE int,double # 1447 "src/main/ncdio_pio.F90.in" subroutine ncd_io_3d_double_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name real(r8) , intent(inout) :: data(:,:,:) ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: varid ! netCDF variable id integer :: start(3+1), count(3+1) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape logical :: found ! if true, found lat/lon dims on file character(len=32) :: vname ! variable error checking type(var_desc_t) :: vardesc ! local vardesc pointer integer :: ndims real(r8) :: temp(1) character(len=*),parameter :: subname='ncd_io_3d_double_glob' !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) call pio_seterrorhandling(ncid, PIO_BCAST_ERROR) #if (3==0) if (varpresent) then status = pio_get_var(ncid, vardesc, data) if (single_column .and. present(posNOTonfile) ) then if ( .not. posNOTonfile )then call shr_sys_abort(' ERROR: scalar var is NOT compatable with posNOTonfile = .false.'//& errMsg(sourcefile, __LINE__)) end if endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if end if #else if (varpresent) then if (single_column) then call scam_field_offsets(ncid,'undefined', vardesc,& start, count, found=found, posNOTonfile=posNOTonfile) if ( found )then status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_get_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_get_var(ncid, varid, data) end if else status = pio_get_var(ncid, varid, data) endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading variable: '//trim(varname)//' ' & // errMsg(sourcefile, __LINE__)) end if endif #endif call pio_seterrorhandling(ncid, PIO_INTERNAL_ERROR) if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 3 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (3==0) if (present(nt)) then temp(1) = data start(1) = nt count(1) = 1 status = pio_put_var(ncid, varid, start(1:1), count(1:1), temp) else status = pio_put_var(ncid, varid, data) end if #elif (3==1) start(1) = 1 ; count(1) = size(data) start(2) = 1 ; count(2) = 1 if (present(nt)) start(2) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (3==2) start(1) = 1 ; count(1) = size(data, dim=1) start(2) = 1 ; count(2) = size(data, dim=2) start(3) = 1 ; count(3) = 1 if (present(nt)) start(3) = nt status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) #elif (3==3) if (present(nt)) then start(1) = 1 ; count(1) = size(data,dim=1) start(2) = 1 ; count(2) = size(data,dim=2) start(3) = 1 ; count(3) = size(data,dim=3) start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start(1:ndims), count(1:ndims), data) else status = pio_put_var(ncid, varid, data) end if #endif endif ! flag # 1557 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_3d_double_glob !------------------------------------------------------------------------ !DIMS 0,1,2 !TYPE text # 1562 "src/main/ncdio_pio.F90.in" subroutine ncd_io_0d_text_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name character(len=*) , intent(inout) :: data ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: m integer :: varid ! netCDF variable id integer :: start(4), count(4) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape character(len=1) :: tmpString(199) ! temp for manipulating output string type(var_desc_t) :: vardesc ! local vardesc pointer character(len=*),parameter :: subname='ncd_io_0d_text_glob' integer :: ndims !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then data = ' ' status = pio_get_var(ncid, varid, data) end if if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 0 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (0==0) start(1) = 1 ; count(1) = len(data) do m = 1,len(data) tmpString(m:m) = data(m:m) end do if (present(nt)) then start(2) = nt; count(2) = 1 if ( count(1) > size(tmpString) )then call shr_sys_abort( subname//' ERROR: input string size is too large:'//& errMsg(sourcefile, __LINE__)) end if end if status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) #elif (0==1) start(1) = 1 ; count(1) = len(data) start(2) = 1 ; count(2) = size(data) if (present(nt)) then start(3) = nt; count(3) = 1 status = pio_put_var(ncid, varid, start, count, data) else status = pio_put_var(ncid, varid, start, count, data) end if #elif (0==2) start(1) = 1 ; count(1) = len(data) start(2) = 1 ; count(2) = size(data,dim=1) start(3) = 1 ; count(3) = size(data,dim=2) if (present(nt)) then start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start, count, data) else status = pio_put_var(ncid, varid, start, count, data) end if #endif endif # 1642 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_0d_text_glob !DIMS 0,1,2 !TYPE text # 1562 "src/main/ncdio_pio.F90.in" subroutine ncd_io_1d_text_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name character(len=*) , intent(inout) :: data(:) ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: m integer :: varid ! netCDF variable id integer :: start(4), count(4) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape character(len=1) :: tmpString(199) ! temp for manipulating output string type(var_desc_t) :: vardesc ! local vardesc pointer character(len=*),parameter :: subname='ncd_io_1d_text_glob' integer :: ndims !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then data = ' ' status = pio_get_var(ncid, varid, data) end if if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 1 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (1==0) start(1) = 1 ; count(1) = len(data) do m = 1,len(data) tmpString(m:m) = data(m:m) end do if (present(nt)) then start(2) = nt; count(2) = 1 if ( count(1) > size(tmpString) )then call shr_sys_abort( subname//' ERROR: input string size is too large:'//& errMsg(sourcefile, __LINE__)) end if end if status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) #elif (1==1) start(1) = 1 ; count(1) = len(data) start(2) = 1 ; count(2) = size(data) if (present(nt)) then start(3) = nt; count(3) = 1 status = pio_put_var(ncid, varid, start, count, data) else status = pio_put_var(ncid, varid, start, count, data) end if #elif (1==2) start(1) = 1 ; count(1) = len(data) start(2) = 1 ; count(2) = size(data,dim=1) start(3) = 1 ; count(3) = size(data,dim=2) if (present(nt)) then start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start, count, data) else status = pio_put_var(ncid, varid, start, count, data) end if #endif endif # 1642 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_1d_text_glob !DIMS 0,1,2 !TYPE text # 1562 "src/main/ncdio_pio.F90.in" subroutine ncd_io_2d_text_glob(varname, data, flag, ncid, readvar, nt, posNOTonfile) ! ! !DESCRIPTION: ! netcdf I/O of global variable ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*), intent(in) :: flag ! 'read' or 'write' character(len=*), intent(in) :: varname ! variable name character(len=*) , intent(inout) :: data(:,:) ! raw data logical , optional, intent(out) :: readvar ! was var read? integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(in) :: posNOTonfile ! position is NOT on this file ! ! !LOCAL VARIABLES: integer :: m integer :: varid ! netCDF variable id integer :: start(4), count(4) ! output bounds integer :: status ! error code logical :: varpresent ! if true, variable is on tape character(len=1) :: tmpString(199) ! temp for manipulating output string type(var_desc_t) :: vardesc ! local vardesc pointer character(len=*),parameter :: subname='ncd_io_2d_text_glob' integer :: ndims !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then data = ' ' status = pio_get_var(ncid, varid, data) end if if (present(readvar)) readvar = varpresent elseif (flag == 'write') then ndims = 2 if(present(nt)) ndims=ndims+1 call ncd_inqvid (ncid, varname, varid, vardesc) #if (2==0) start(1) = 1 ; count(1) = len(data) do m = 1,len(data) tmpString(m:m) = data(m:m) end do if (present(nt)) then start(2) = nt; count(2) = 1 if ( count(1) > size(tmpString) )then call shr_sys_abort( subname//' ERROR: input string size is too large:'//& errMsg(sourcefile, __LINE__)) end if end if status = pio_put_var(ncid, varid, start, count, ival=tmpString(1:count(1))) #elif (2==1) start(1) = 1 ; count(1) = len(data) start(2) = 1 ; count(2) = size(data) if (present(nt)) then start(3) = nt; count(3) = 1 status = pio_put_var(ncid, varid, start, count, data) else status = pio_put_var(ncid, varid, start, count, data) end if #elif (2==2) start(1) = 1 ; count(1) = len(data) start(2) = 1 ; count(2) = size(data,dim=1) start(3) = 1 ; count(3) = size(data,dim=2) if (present(nt)) then start(4) = nt ; count(4) = 1 status = pio_put_var(ncid, varid, start, count, data) else status = pio_put_var(ncid, varid, start, count, data) end if #endif endif # 1642 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_2d_text_glob !----------------------------------------------------------------------- !TYPE int,double,logical # 1647 "src/main/ncdio_pio.F90.in" subroutine ncd_io_1d_int(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) ! ! !DESCRIPTION: ! netcdf I/O for 1d ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name integer(i4) , pointer :: data(:) ! local decomposition data character(len=*) , intent(in) :: dim1name ! dimension name integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) ! ! Local Variables character(len=8) :: clmlevel ! clmlevel character(len=32) :: dimname ! temporary integer :: n ! index integer :: iodnum ! iodesc num in list integer :: varid ! varid integer :: ndims ! ndims for var integer :: ndims_iod ! ndims iodesc for var integer :: dims(4) ! dim sizes integer :: dids(4) ! dim ids integer :: start(3) ! netcdf start index integer :: count(3) ! netcdf count index integer :: status ! error code logical :: varpresent ! if true, variable is on tape integer :: xtype ! type of var in file integer , pointer :: idata(:) ! Temporary integer data to send to file type(iodesc_plus_type) , pointer :: iodesc_plus type(var_desc_t) :: vardesc integer :: oldhandle ! previous value of pio_error_handle character(len=*),parameter :: subname='ncd_io_1d_int' ! subroutine name !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 clmlevel = dim1name if (masterproc .and. debug > 1) then write(iulog,*) subname//' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) end if #if (103==TYPEDOUBLE) if ( present(cnvrtnan2fill) )then if (.not. cnvrtnan2fill) then call shr_sys_abort(' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& errMsg(sourcefile, __LINE__)) endif end if #endif if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then if (single_column) then start(:) = 1 ; count(:) = 1 call scam_field_offsets(ncid,clmlevel,vardesc,start,count) if (trim(clmlevel) == grlnd) then n=2 if (present(nt)) then start(3) = nt ; count(3) = 1 n=3 end if else n=1 if (present(nt)) then n=2 start(2) = nt ; count(2) = 1 end if end if call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if (103==TYPELOGICAL) allocate(idata(size(data))) status = pio_get_var(ncid, varid, start(1:n), count(1:n), idata) data = (idata == 1) if ( any(idata /= 0 .and. idata /= 1) )then call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(sourcefile, __LINE__)) end if deallocate( idata ) #else status = pio_get_var(ncid, varid, start(1:n), count(1:n), data) #endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if call pio_seterrorhandling(ncid, oldhandle) else status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, data) end if end if if (present(readvar)) readvar = varpresent elseif (flag == 'write') then call ncd_inqvid(ncid, varname ,varid, vardesc) status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if #if (103==TYPELOGICAL) allocate( idata(size(data)) ) where( data ) idata = 1 elsewhere idata = 0 end where call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status, fillval=0) deallocate( idata ) #elif (103==TYPEINT) call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=ispval) #elif (103==TYPEDOUBLE) if (iodesc_plus%type == pio_double) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, real(data,kind=r4), status, fillval=real(spval,kind=r4)) endif #endif else if (masterproc) then write(iulog,*) subname//' ERROR: unsupported flag ',trim(flag) call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif endif # 1816 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_1d_int !TYPE int,double,logical # 1647 "src/main/ncdio_pio.F90.in" subroutine ncd_io_1d_double(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) ! ! !DESCRIPTION: ! netcdf I/O for 1d ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name real(r8) , pointer :: data(:) ! local decomposition data character(len=*) , intent(in) :: dim1name ! dimension name integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) ! ! Local Variables character(len=8) :: clmlevel ! clmlevel character(len=32) :: dimname ! temporary integer :: n ! index integer :: iodnum ! iodesc num in list integer :: varid ! varid integer :: ndims ! ndims for var integer :: ndims_iod ! ndims iodesc for var integer :: dims(4) ! dim sizes integer :: dids(4) ! dim ids integer :: start(3) ! netcdf start index integer :: count(3) ! netcdf count index integer :: status ! error code logical :: varpresent ! if true, variable is on tape integer :: xtype ! type of var in file integer , pointer :: idata(:) ! Temporary integer data to send to file type(iodesc_plus_type) , pointer :: iodesc_plus type(var_desc_t) :: vardesc integer :: oldhandle ! previous value of pio_error_handle character(len=*),parameter :: subname='ncd_io_1d_double' ! subroutine name !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 clmlevel = dim1name if (masterproc .and. debug > 1) then write(iulog,*) subname//' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) end if #if (102==TYPEDOUBLE) if ( present(cnvrtnan2fill) )then if (.not. cnvrtnan2fill) then call shr_sys_abort(' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& errMsg(sourcefile, __LINE__)) endif end if #endif if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then if (single_column) then start(:) = 1 ; count(:) = 1 call scam_field_offsets(ncid,clmlevel,vardesc,start,count) if (trim(clmlevel) == grlnd) then n=2 if (present(nt)) then start(3) = nt ; count(3) = 1 n=3 end if else n=1 if (present(nt)) then n=2 start(2) = nt ; count(2) = 1 end if end if call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if (102==TYPELOGICAL) allocate(idata(size(data))) status = pio_get_var(ncid, varid, start(1:n), count(1:n), idata) data = (idata == 1) if ( any(idata /= 0 .and. idata /= 1) )then call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(sourcefile, __LINE__)) end if deallocate( idata ) #else status = pio_get_var(ncid, varid, start(1:n), count(1:n), data) #endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if call pio_seterrorhandling(ncid, oldhandle) else status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, data) end if end if if (present(readvar)) readvar = varpresent elseif (flag == 'write') then call ncd_inqvid(ncid, varname ,varid, vardesc) status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if #if (102==TYPELOGICAL) allocate( idata(size(data)) ) where( data ) idata = 1 elsewhere idata = 0 end where call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status, fillval=0) deallocate( idata ) #elif (102==TYPEINT) call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=ispval) #elif (102==TYPEDOUBLE) if (iodesc_plus%type == pio_double) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, real(data,kind=r4), status, fillval=real(spval,kind=r4)) endif #endif else if (masterproc) then write(iulog,*) subname//' ERROR: unsupported flag ',trim(flag) call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif endif # 1816 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_1d_double !TYPE int,double,logical # 1647 "src/main/ncdio_pio.F90.in" subroutine ncd_io_1d_logical(varname, data, dim1name, flag, ncid, nt, readvar, cnvrtnan2fill) ! ! !DESCRIPTION: ! netcdf I/O for 1d ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name logical , pointer :: data(:) ! local decomposition data character(len=*) , intent(in) :: dim1name ! dimension name integer , optional, intent(in) :: nt ! time sample index logical , optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) logical , optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) ! ! Local Variables character(len=8) :: clmlevel ! clmlevel character(len=32) :: dimname ! temporary integer :: n ! index integer :: iodnum ! iodesc num in list integer :: varid ! varid integer :: ndims ! ndims for var integer :: ndims_iod ! ndims iodesc for var integer :: dims(4) ! dim sizes integer :: dids(4) ! dim ids integer :: start(3) ! netcdf start index integer :: count(3) ! netcdf count index integer :: status ! error code logical :: varpresent ! if true, variable is on tape integer :: xtype ! type of var in file integer , pointer :: idata(:) ! Temporary integer data to send to file type(iodesc_plus_type) , pointer :: iodesc_plus type(var_desc_t) :: vardesc integer :: oldhandle ! previous value of pio_error_handle character(len=*),parameter :: subname='ncd_io_1d_logical' ! subroutine name !----------------------------------------------------------------------- start(:) = 0 count(:) = 0 clmlevel = dim1name if (masterproc .and. debug > 1) then write(iulog,*) subname//' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) end if #if (105==TYPEDOUBLE) if ( present(cnvrtnan2fill) )then if (.not. cnvrtnan2fill) then call shr_sys_abort(' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& errMsg(sourcefile, __LINE__)) endif end if #endif if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then if (single_column) then start(:) = 1 ; count(:) = 1 call scam_field_offsets(ncid,clmlevel,vardesc,start,count) if (trim(clmlevel) == grlnd) then n=2 if (present(nt)) then start(3) = nt ; count(3) = 1 n=3 end if else n=1 if (present(nt)) then n=2 start(2) = nt ; count(2) = 1 end if end if call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if (105==TYPELOGICAL) allocate(idata(size(data))) status = pio_get_var(ncid, varid, start(1:n), count(1:n), idata) data = (idata == 1) if ( any(idata /= 0 .and. idata /= 1) )then call shr_sys_abort(' ERROR: read in bad integer value(s) for logical data'//errMsg(sourcefile, __LINE__)) end if deallocate( idata ) #else status = pio_get_var(ncid, varid, start(1:n), count(1:n), data) #endif if ( status /= PIO_NOERR )then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if call pio_seterrorhandling(ncid, oldhandle) else status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, data) end if end if if (present(readvar)) readvar = varpresent elseif (flag == 'write') then call ncd_inqvid(ncid, varname ,varid, vardesc) status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if #if (105==TYPELOGICAL) allocate( idata(size(data)) ) where( data ) idata = 1 elsewhere idata = 0 end where call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, idata, status, fillval=0) deallocate( idata ) #elif (105==TYPEINT) call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=ispval) #elif (105==TYPEDOUBLE) if (iodesc_plus%type == pio_double) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, real(data,kind=r4), status, fillval=real(spval,kind=r4)) endif #endif else if (masterproc) then write(iulog,*) subname//' ERROR: unsupported flag ',trim(flag) call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif endif # 1816 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_1d_logical !----------------------------------------------------------------------- !TYPE int,double # 1821 "src/main/ncdio_pio.F90.in" subroutine ncd_io_2d_int(varname, data, dim1name, lowerb2, upperb2, & flag, ncid, nt, readvar, switchdim, cnvrtnan2fill) ! ! !DESCRIPTION: ! Netcdf i/o of 2d ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name integer(i4) , pointer :: data(:,:) ! local decomposition input data character(len=*) , intent(in) :: dim1name ! dimension 1 name integer, optional, intent(in) :: nt ! time sample index integer, optional, intent(in) :: lowerb2,upperb2 ! lower and upper bounds of second dimension logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) logical, optional, intent(in) :: switchdim ! true=> permute dim1 and dim2 for output logical, optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) ! ! !LOCAL VARIABLES: #if (103==TYPEINT) integer , pointer :: temp(:,:) #else real(r8), pointer :: temp(:,:) #endif integer :: ndim1,ndim2 character(len=8) :: clmlevel ! clmlevel character(len=32) :: dimname ! temporary integer :: status ! error status integer :: ndims ! ndims total for var integer :: ndims_iod ! ndims iodesc for var integer :: varid ! varid integer :: n,i,j ! indices integer :: dims(4) ! dim sizes integer :: dids(4) ! dim ids integer :: iodnum ! iodesc num in list integer :: start(4) ! netcdf start index integer :: count(4) ! netcdf count index logical :: varpresent ! if true, variable is on tape integer :: lb1,lb2 integer :: ub1,ub2 integer :: xtype ! netcdf type of variable on file type(iodesc_plus_type) , pointer :: iodesc_plus type(var_desc_t) :: vardesc character(len=*),parameter :: subname='ncd_io_2d_int' ! subroutine name !----------------------------------------------------------------------- start(:)=0 count(:)=0 clmlevel = dim1name if (masterproc .and. debug > 1) then write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) end if #if (103==TYPEDOUBLE) if ( present(cnvrtnan2fill) )then if (.not. cnvrtnan2fill) then call shr_sys_abort( ' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& errMsg(sourcefile, __LINE__)) endif end if #endif lb1 = lbound(data, dim=1) ub1 = ubound(data, dim=1) lb2 = lbound(data, dim=2) ub2 = ubound(data, dim=2) if (present(switchdim)) then if (present(lowerb2)) lb2 = lowerb2 if (present(upperb2)) ub2 = upperb2 allocate(temp(lb2:ub2,lb1:ub1)) end if if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then if (single_column) then start(:) = 1 ; count(:) = 1 call scam_field_offsets(ncid, clmlevel, vardesc, start, count) if (trim(clmlevel) == grlnd) then count(3) = size(data,dim=2) n=3 if (present(nt)) then start(4) = nt; count(4) = 1 n=4 end if else count(2) = size(data,dim=2) n=2 if (present(nt)) then start(3) = nt ; count(3) = 1 n=3 end if end if if (present(switchdim)) then status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), temp) do j = lb2,ub2 do i = lb1,ub1 data(i,j) = temp(j,i) end do end do else status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) endif else status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid, dids(ndims), dimname) if (ndims == 0) then write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if if (present(switchdim)) then call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum, switchdim=.true.) iodesc_plus => iodesc_list(iodnum) call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, temp) do j = lb2,ub2 do i = lb1,ub1 data(i,j) = temp(j,i) end do end do else call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, data) end if end if #if (103==TYPEDOUBLE) if ( present(cnvrtnan2fill) )then do j = lb2,ub2 do i = lb1,ub1 if ( data(i,j) == spval )then data(i,j) = nan end if end do end do end if #endif end if if (present(readvar)) readvar = varpresent else if (flag == 'write') then call ncd_inqvid(ncid, varname ,varid, vardesc) status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) if (ndims == 0) then write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) if (present(switchdim)) then call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum, switchdim=.true.) else call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) end if iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if if (present(switchdim)) then do j = lb2,ub2 do i = lb1,ub1 temp(j,i) = data(i,j) end do end do end if #if (103==TYPEINT) if (present(switchdim)) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=ispval) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=ispval) end if #else if (iodesc_plus%type == pio_double) then if (present(switchdim)) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=spval) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) end if else if (present(switchdim)) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, real(temp, kind=r4), status, fillval=real(spval, kind=r4)) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, real(data, kind=r4), status, fillval=real(spval, kind=r4)) end if endif if ( present(cnvrtnan2fill) )then do j = lb2,ub2 do i = lb1,ub1 if ( isnan(data(i,j)) )then data(i,j) = spval end if end do end do end if #endif else if (masterproc) then write(iulog,*) subname,' error: unsupported flag ',trim(flag) call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif endif if (present(switchdim)) then deallocate(temp) end if # 2062 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_2d_int !TYPE int,double # 1821 "src/main/ncdio_pio.F90.in" subroutine ncd_io_2d_double(varname, data, dim1name, lowerb2, upperb2, & flag, ncid, nt, readvar, switchdim, cnvrtnan2fill) ! ! !DESCRIPTION: ! Netcdf i/o of 2d ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name real(r8) , pointer :: data(:,:) ! local decomposition input data character(len=*) , intent(in) :: dim1name ! dimension 1 name integer, optional, intent(in) :: nt ! time sample index integer, optional, intent(in) :: lowerb2,upperb2 ! lower and upper bounds of second dimension logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) logical, optional, intent(in) :: switchdim ! true=> permute dim1 and dim2 for output logical, optional, intent(in) :: cnvrtnan2fill ! true => convert any NaN's to _FillValue (spval) ! ! !LOCAL VARIABLES: #if (102==TYPEINT) integer , pointer :: temp(:,:) #else real(r8), pointer :: temp(:,:) #endif integer :: ndim1,ndim2 character(len=8) :: clmlevel ! clmlevel character(len=32) :: dimname ! temporary integer :: status ! error status integer :: ndims ! ndims total for var integer :: ndims_iod ! ndims iodesc for var integer :: varid ! varid integer :: n,i,j ! indices integer :: dims(4) ! dim sizes integer :: dids(4) ! dim ids integer :: iodnum ! iodesc num in list integer :: start(4) ! netcdf start index integer :: count(4) ! netcdf count index logical :: varpresent ! if true, variable is on tape integer :: lb1,lb2 integer :: ub1,ub2 integer :: xtype ! netcdf type of variable on file type(iodesc_plus_type) , pointer :: iodesc_plus type(var_desc_t) :: vardesc character(len=*),parameter :: subname='ncd_io_2d_double' ! subroutine name !----------------------------------------------------------------------- start(:)=0 count(:)=0 clmlevel = dim1name if (masterproc .and. debug > 1) then write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) end if #if (102==TYPEDOUBLE) if ( present(cnvrtnan2fill) )then if (.not. cnvrtnan2fill) then call shr_sys_abort( ' ERROR: cnvrtnan2fill present but NOT set to true -- MUST set it to TRUE if used'//& errMsg(sourcefile, __LINE__)) endif end if #endif lb1 = lbound(data, dim=1) ub1 = ubound(data, dim=1) lb2 = lbound(data, dim=2) ub2 = ubound(data, dim=2) if (present(switchdim)) then if (present(lowerb2)) lb2 = lowerb2 if (present(upperb2)) ub2 = upperb2 allocate(temp(lb2:ub2,lb1:ub1)) end if if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then if (single_column) then start(:) = 1 ; count(:) = 1 call scam_field_offsets(ncid, clmlevel, vardesc, start, count) if (trim(clmlevel) == grlnd) then count(3) = size(data,dim=2) n=3 if (present(nt)) then start(4) = nt; count(4) = 1 n=4 end if else count(2) = size(data,dim=2) n=2 if (present(nt)) then start(3) = nt ; count(3) = 1 n=3 end if end if if (present(switchdim)) then status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), temp) do j = lb2,ub2 do i = lb1,ub1 data(i,j) = temp(j,i) end do end do else status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) endif else status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid, dids(ndims), dimname) if (ndims == 0) then write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if if (present(switchdim)) then call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum, switchdim=.true.) iodesc_plus => iodesc_list(iodnum) call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, temp) do j = lb2,ub2 do i = lb1,ub1 data(i,j) = temp(j,i) end do end do else call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, data) end if end if #if (102==TYPEDOUBLE) if ( present(cnvrtnan2fill) )then do j = lb2,ub2 do i = lb1,ub1 if ( data(i,j) == spval )then data(i,j) = nan end if end do end do end if #endif end if if (present(readvar)) readvar = varpresent else if (flag == 'write') then call ncd_inqvid(ncid, varname ,varid, vardesc) status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) if (ndims == 0) then write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) if (present(switchdim)) then call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum, switchdim=.true.) else call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) end if iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if if (present(switchdim)) then do j = lb2,ub2 do i = lb1,ub1 temp(j,i) = data(i,j) end do end do end if #if (102==TYPEINT) if (present(switchdim)) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=ispval) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=ispval) end if #else if (iodesc_plus%type == pio_double) then if (present(switchdim)) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, temp, status, fillval=spval) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status, fillval=spval) end if else if (present(switchdim)) then call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, real(temp, kind=r4), status, fillval=real(spval, kind=r4)) else call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, real(data, kind=r4), status, fillval=real(spval, kind=r4)) end if endif if ( present(cnvrtnan2fill) )then do j = lb2,ub2 do i = lb1,ub1 if ( isnan(data(i,j)) )then data(i,j) = spval end if end do end do end if #endif else if (masterproc) then write(iulog,*) subname,' error: unsupported flag ',trim(flag) call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif endif if (present(switchdim)) then deallocate(temp) end if # 2062 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_2d_double !----------------------------------------------------------------------- !TYPE int,double # 2066 "src/main/ncdio_pio.F90.in" subroutine ncd_io_3d_int(varname, data, dim1name, flag, ncid, nt, readvar) ! ! !DESCRIPTION: ! Netcdf i/o of 3d ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name integer(i4) , pointer :: data(:,:,:) ! local decomposition input data character(len=*) , intent(in) :: dim1name ! dimension 1 name integer, optional, intent(in) :: nt ! time sample index logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) ! ! !LOCAL VARIABLES: integer :: ndim1,ndim2 character(len=8) :: clmlevel ! clmlevel character(len=32) :: dimname ! temporary integer :: status ! error status integer :: ndims ! ndims total for var integer :: ndims_iod ! ndims iodesc for var integer :: varid ! varid integer :: n ! index integer :: dims(4) ! dim sizes integer :: dids(4) ! dim ids integer :: iodnum ! iodesc num in list integer :: start(5) ! netcdf start index integer :: count(5) ! netcdf count index integer :: xtype ! netcdf type of variable on file logical :: varpresent ! if true, variable is on tape type(iodesc_plus_type) , pointer :: iodesc_plus type(var_desc_t) :: vardesc character(len=*),parameter :: subname='ncd_io_3d_int' ! subroutine name !----------------------------------------------------------------------- clmlevel = dim1name if (masterproc .and. debug > 1) then write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) end if if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then if (single_column) then start(:) = 1 count(:) = 1 call scam_field_offsets(ncid, clmlevel, vardesc, start, count) if (trim(clmlevel) == grlnd) then count(3) = size(data,dim=2); count(4) = size(data,dim=3) n=4 if (present(nt)) then start(5) = nt count(5) = 1 n=5 end if else count(2) = size(data,dim=2) count(3) = size(data,dim=3) n=3 if (present(nt)) then start(4) = nt count(4) = 1 n=4 end if end if status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) else status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid, dids(ndims), dimname) if (ndims == 0) then write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, data) end if end if if (present(readvar)) readvar = varpresent else if (flag == 'write') then call ncd_inqvid(ncid, varname ,varid, vardesc) status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) if (ndims == 0) then write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) else if (masterproc) then write(iulog,*) subname,' error: unsupported flag ',trim(flag) call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif endif # 2200 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_3d_int !TYPE int,double # 2066 "src/main/ncdio_pio.F90.in" subroutine ncd_io_3d_double(varname, data, dim1name, flag, ncid, nt, readvar) ! ! !DESCRIPTION: ! Netcdf i/o of 3d ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: flag ! 'read' or 'write' character(len=*) , intent(in) :: varname ! variable name real(r8) , pointer :: data(:,:,:) ! local decomposition input data character(len=*) , intent(in) :: dim1name ! dimension 1 name integer, optional, intent(in) :: nt ! time sample index logical, optional, intent(out) :: readvar ! true => variable is on initial dataset (read only) ! ! !LOCAL VARIABLES: integer :: ndim1,ndim2 character(len=8) :: clmlevel ! clmlevel character(len=32) :: dimname ! temporary integer :: status ! error status integer :: ndims ! ndims total for var integer :: ndims_iod ! ndims iodesc for var integer :: varid ! varid integer :: n ! index integer :: dims(4) ! dim sizes integer :: dids(4) ! dim ids integer :: iodnum ! iodesc num in list integer :: start(5) ! netcdf start index integer :: count(5) ! netcdf count index integer :: xtype ! netcdf type of variable on file logical :: varpresent ! if true, variable is on tape type(iodesc_plus_type) , pointer :: iodesc_plus type(var_desc_t) :: vardesc character(len=*),parameter :: subname='ncd_io_3d_double' ! subroutine name !----------------------------------------------------------------------- clmlevel = dim1name if (masterproc .and. debug > 1) then write(iulog,*) trim(subname),' ',trim(flag),' ',trim(varname),' ',trim(clmlevel) end if if (flag == 'read') then call ncd_inqvid(ncid, varname, varid, vardesc, readvar=varpresent) if (varpresent) then if (single_column) then start(:) = 1 count(:) = 1 call scam_field_offsets(ncid, clmlevel, vardesc, start, count) if (trim(clmlevel) == grlnd) then count(3) = size(data,dim=2); count(4) = size(data,dim=3) n=4 if (present(nt)) then start(5) = nt count(5) = 1 n=5 end if else count(2) = size(data,dim=2) count(3) = size(data,dim=3) n=3 if (present(nt)) then start(4) = nt count(4) = 1 n=4 end if end if status = pio_get_var(ncid, vardesc, start(1:n), count(1:n), data) else status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid,vardesc, dids(1:ndims)) status = pio_inq_dimname(ncid, dids(ndims), dimname) if (ndims == 0) then write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if call read_darray_dispatcher(ncid, vardesc, iodesc_plus%iodesc, varname, xtype, data) end if end if if (present(readvar)) readvar = varpresent else if (flag == 'write') then call ncd_inqvid(ncid, varname ,varid, vardesc) status = pio_inq_varndims(ncid, vardesc, ndims) status = pio_inq_vardimid(ncid, vardesc , dids(1:ndims)) if (ndims == 0) then write(iulog,*) trim(subname),' ERROR: ndims must be greater than 0' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if status = pio_inq_dimname(ncid,dids(ndims),dimname) if ('time' == trim(dimname)) then ndims_iod = ndims - 1 else ndims_iod = ndims end if do n = 1,ndims_iod status = pio_inq_dimlen(ncid,dids(n),dims(n)) enddo status = pio_inq_vartype(ncid, vardesc, xtype) call ncd_getiodesc(ncid, clmlevel, ndims_iod, dims(1:ndims_iod), dids(1:ndims_iod), & xtype, iodnum) iodesc_plus => iodesc_list(iodnum) if (present(nt)) then call pio_setframe(ncid, vardesc, int(nt,kind=Pio_Offset_Kind)) end if call pio_write_darray(ncid, vardesc, iodesc_plus%iodesc, data, status) else if (masterproc) then write(iulog,*) subname,' error: unsupported flag ',trim(flag) call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif endif # 2200 "src/main/ncdio_pio.F90.in" end subroutine ncd_io_3d_double !----------------------------------------------------------------------- !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_dispatcher_1(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype integer(i4), pointer :: data(:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_int_dispatcher_1' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_int_from_int_1(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_int_from_real_1(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_int_from_double_1(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_dispatcher_1 !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_dispatcher_2(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype integer(i4), pointer :: data(:,:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_int_dispatcher_2' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_int_from_int_2(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_int_from_real_2(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_int_from_double_2(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_dispatcher_2 !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_dispatcher_3(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype integer(i4), pointer :: data(:,:,:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_int_dispatcher_3' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_int_from_int_3(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_int_from_real_3(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_int_from_double_3(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_dispatcher_3 !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_dispatcher_1(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype real(r8), pointer :: data(:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_double_dispatcher_1' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_double_from_int_1(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_double_from_real_1(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_double_from_double_1(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_dispatcher_1 !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_dispatcher_2(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype real(r8), pointer :: data(:,:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_double_dispatcher_2' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_double_from_int_2(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_double_from_real_2(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_double_from_double_2(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_dispatcher_2 !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_dispatcher_3(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype real(r8), pointer :: data(:,:,:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_double_dispatcher_3' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_double_from_int_3(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_double_from_real_3(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_double_from_double_3(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_dispatcher_3 !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_dispatcher_1(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype logical, pointer :: data(:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_logical_dispatcher_1' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_logical_from_int_1(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_logical_from_real_1(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_logical_from_double_1(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_dispatcher_1 !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_dispatcher_2(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype logical, pointer :: data(:,:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_logical_dispatcher_2' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_logical_from_int_2(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_logical_from_real_2(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_logical_from_double_2(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_dispatcher_2 !TYPE int,double,logical !DIMS 1,2,3 # 2205 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_dispatcher_3(ncid, vardesc, iodesc, varname, xtype, data) ! ! !DESCRIPTION: ! Dispatch to the appropriate read_darray routine based on xtype (the type of var in file) ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer, intent(in) :: xtype logical, pointer :: data(:,:,:) ! ! !LOCAL VARIABLES: character(len=*), parameter :: subname = 'read_darray_logical_dispatcher_3' !----------------------------------------------------------------------- select case (xtype) case (PIO_INT) call read_darray_logical_from_int_3(ncid, vardesc, iodesc, varname, data) case (PIO_REAL) call read_darray_logical_from_real_3(ncid, vardesc, iodesc, varname, data) case (PIO_DOUBLE) call read_darray_logical_from_double_3(ncid, vardesc, iodesc, varname, data) case default write(iulog,*) subname//' ERROR: unrecognized type in read: ', xtype call shr_sys_abort(' ERROR: unrecognized type in read '//errMsg(sourcefile, __LINE__)) end select # 2235 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_dispatcher_3 !------------------------------------------------------------------------ !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_double_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc integer(i4), pointer :: data(:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(103==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEINT) data = int(ddata) #elif(103==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_double_1 !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_double_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc integer(i4), pointer :: data(:,:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(103==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEINT) data = int(ddata) #elif(103==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_double_2 !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_double_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc integer(i4), pointer :: data(:,:,:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(103==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEINT) data = int(ddata) #elif(103==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_double_3 !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_double_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc real(r8), pointer :: data(:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(102==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEINT) data = int(ddata) #elif(102==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_double_1 !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_double_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc real(r8), pointer :: data(:,:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(102==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEINT) data = int(ddata) #elif(102==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_double_2 !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_double_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc real(r8), pointer :: data(:,:,:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(102==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEINT) data = int(ddata) #elif(102==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_double_3 !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_double_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc logical, pointer :: data(:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(105==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEINT) data = int(ddata) #elif(105==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_double_1 !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_double_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc logical, pointer :: data(:,:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(105==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEINT) data = int(ddata) #elif(105==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_double_2 !TYPE int,double,logical !DIMS 1,2,3 # 2241 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_double_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc logical, pointer :: data(:,:,:) character(len=*), intent(in) :: varname integer :: status real(R8), allocatable :: ddata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(105==TYPEDOUBLE) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(ddata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, ddata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEINT) data = int(ddata) #elif(105==TYPELOGICAL) call convert_to_logical(ddata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(ddata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2276 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_double_3 !------------------------------------------------------------------------ !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_int_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer(i4), pointer :: data(:) integer :: status integer, allocatable :: idata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(103==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEDOUBLE) data = real(idata, kind=R8) #elif(103==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_int_1 !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_int_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer(i4), pointer :: data(:,:) integer :: status integer, allocatable :: idata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(103==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEDOUBLE) data = real(idata, kind=R8) #elif(103==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_int_2 !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_int_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer(i4), pointer :: data(:,:,:) integer :: status integer, allocatable :: idata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(103==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEDOUBLE) data = real(idata, kind=R8) #elif(103==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_int_3 !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_int_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname real(r8), pointer :: data(:) integer :: status integer, allocatable :: idata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(102==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEDOUBLE) data = real(idata, kind=R8) #elif(102==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_int_1 !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_int_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname real(r8), pointer :: data(:,:) integer :: status integer, allocatable :: idata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(102==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEDOUBLE) data = real(idata, kind=R8) #elif(102==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_int_2 !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_int_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname real(r8), pointer :: data(:,:,:) integer :: status integer, allocatable :: idata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(102==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEDOUBLE) data = real(idata, kind=R8) #elif(102==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_int_3 !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_int_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname logical, pointer :: data(:) integer :: status integer, allocatable :: idata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(105==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEDOUBLE) data = real(idata, kind=R8) #elif(105==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_int_1 !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_int_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname logical, pointer :: data(:,:) integer :: status integer, allocatable :: idata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(105==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEDOUBLE) data = real(idata, kind=R8) #elif(105==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_int_2 !TYPE int,double,logical !DIMS 1,2,3 # 2281 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_int_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname logical, pointer :: data(:,:,:) integer :: status integer, allocatable :: idata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) #if(105==TYPEINT) call pio_read_darray(ncid, vardesc, iodesc, data, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #else allocate(idata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, idata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEDOUBLE) data = real(idata, kind=R8) #elif(105==TYPELOGICAL) call convert_to_logical(idata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(idata) #endif call pio_seterrorhandling(ncid, oldhandle) # 2316 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_int_3 !------------------------------------------------------------------------ !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_real_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer(i4), pointer :: data(:) integer :: status real(r4), allocatable :: rdata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(103==TYPEINT) data = int(rdata) #elif(103==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_real_1 !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_real_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer(i4), pointer :: data(:,:) integer :: status real(r4), allocatable :: rdata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(103==TYPEINT) data = int(rdata) #elif(103==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_real_2 !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_int_from_real_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname integer(i4), pointer :: data(:,:,:) integer :: status real(r4), allocatable :: rdata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(103==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(103==TYPEINT) data = int(rdata) #elif(103==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_int_from_real_3 !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_real_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname real(r8), pointer :: data(:) integer :: status real(r4), allocatable :: rdata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(102==TYPEINT) data = int(rdata) #elif(102==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_real_1 !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_real_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname real(r8), pointer :: data(:,:) integer :: status real(r4), allocatable :: rdata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(102==TYPEINT) data = int(rdata) #elif(102==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_real_2 !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_double_from_real_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname real(r8), pointer :: data(:,:,:) integer :: status real(r4), allocatable :: rdata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(102==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(102==TYPEINT) data = int(rdata) #elif(102==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_double_from_real_3 !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_real_1(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname logical, pointer :: data(:) integer :: status real(r4), allocatable :: rdata(:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(105==TYPEINT) data = int(rdata) #elif(105==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_real_1 !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_real_2(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname logical, pointer :: data(:,:) integer :: status real(r4), allocatable :: rdata(:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1),& size(data,2))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(105==TYPEINT) data = int(rdata) #elif(105==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_real_2 !TYPE int,double,logical !DIMS 1,2,3 # 2321 "src/main/ncdio_pio.F90.in" subroutine read_darray_logical_from_real_3(ncid, vardesc, iodesc, varname, data) class(file_desc_t), intent(inout) :: ncid type(var_desc_t), intent(inout) :: vardesc type(io_desc_t), intent(inout) :: iodesc character(len=*), intent(in) :: varname logical, pointer :: data(:,:,:) integer :: status real(r4), allocatable :: rdata(:,:,:) integer :: oldhandle call pio_seterrorhandling(ncid, PIO_BCAST_ERROR, oldhandle) allocate(rdata( size(data,1),& size(data,2),& size(data,3))) call pio_read_darray(ncid, vardesc, iodesc, rdata, status) if ( status /= PIO_NOERR ) then call shr_sys_abort(' ERROR: reading in variable: '// trim(varname) & // errMsg(sourcefile, __LINE__)) end if #if(105==TYPEDOUBLE) data = real(rdata, kind=R8) #elif(105==TYPEINT) data = int(rdata) #elif(105==TYPELOGICAL) call convert_to_logical(rdata, data) #else call shr_sys_abort(' ERROR: unhandled type'//errMsg(sourcefile, __LINE__)) #endif deallocate(rdata) call pio_seterrorhandling(ncid, oldhandle) # 2352 "src/main/ncdio_pio.F90.in" end subroutine read_darray_logical_from_real_3 !------------------------------------------------------------------------ # 2356 "src/main/ncdio_pio.F90.in" subroutine scam_field_offsets( ncid, dim1name, vardesc, start, count, & found, posNOTonfile) ! ! !DESCRIPTION: ! Read/Write initial data from/to netCDF instantaneous initial data file ! ! !USES: use clm_varctl, only: scmlon,scmlat,single_column use shr_scam_mod, only: shr_scam_getCloseLatLon use shr_string_mod, only: shr_string_toLower ! ! !ARGUMENTS: class(file_desc_t), intent(inout) :: ncid ! netcdf file id character(len=*) , intent(in) :: dim1name ! dimension 1 name type(Var_desc_t) , intent(inout) :: vardesc ! variable descriptor integer , intent(out) :: start(:) ! start index integer , intent(out) :: count(:) ! count to retrieve logical, optional , intent(out) :: found ! if present return true if found ! dimensions on file else false if NOT present abort if can't find logical, optional , intent(in) :: posNOTonfile ! Position is NOT on this file ! ! !LOCAL VARIABLES: integer :: cc,i,ii ! index variable integer :: data_offset ! offset into land array 1st column integer :: ndata ! number of column (or pft points to read) real(r8) , pointer :: cols1dlon(:) ! holds cols1d_ixy var real(r8) , pointer :: cols1dlat(:) ! holds cols1d_jxy var real(r8) , pointer :: pfts1dlon(:) ! holds pfts1d_ixy var real(r8) , pointer :: pfts1dlat(:) ! holds pfts1d_jxy var real(r8) , pointer :: land1dlon(:) ! holds land1d_ixy var real(r8) , pointer :: land1dlat(:) ! holds land1d_jxy var integer, allocatable :: cols(:) ! grid cell columns for scam integer, allocatable :: pfts(:) ! grid cell pfts for scam integer, allocatable :: landunits(:) ! grid cell landunits for scam integer, allocatable :: dids(:) ! dim ids integer :: varid ! netCDF variable id integer :: status ! return code integer :: latidx,lonidx ! latitude/longitude indices real(r8) :: closelat,closelon ! closest latitude and longitude indices integer :: ndims,dimlen ! number of dimensions in desired variable character(len=32) :: dimname ! dimension name character(len=32) :: subname = 'scam_field_offsets' !------------------------------------------------------------------------ start(:)=1 count(:)=1 if ( present(posNOTonfile) )then if ( posNOTonfile )then if ( .not. present(found) )then # 2406 "src/main/ncdio_pio.F90.in" call shr_sys_abort('ERROR: Bad subroutine calling structure posNOTonfile sent, but found was NOT!'//& errMsg(sourcefile, __LINE__)) end if found = .false. return end if end if ! find closest land grid cell for this point if ( present(found) )then call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx,found) if ( .not. found ) return else call shr_scam_getCloseLatLon(ncid,scmlat,scmlon,closelat,closelon,latidx,lonidx) end if call ncd_inqvdims(ncid,ndims,vardesc) allocate(dids(ndims)) status = pio_inq_vardimid(ncid, vardesc, dids) do i = 1,ndims status = pio_inq_dimname(ncid,dids(i),dimname) dimname=shr_string_toLower(dimname) status = pio_inq_dimlen(ncid,dids(i),dimlen) if ( trim(dimname)=='nj'.or. trim(dimname)=='lat'.or. trim(dimname)=='lsmlat') then start(i)=latidx count(i)=1 else if ( trim(dimname)=='ni'.or. trim(dimname)=='lon'.or. trim(dimname)=='lsmlon') then start(i)=lonidx count(i)=1 else if ( trim(dimname)=='column') then allocate (cols1dlon(dimlen)) allocate (cols1dlat(dimlen)) allocate (cols(dimlen)) status = pio_inq_varid(ncid, 'cols1d_lon', varid) status = pio_get_var(ncid, varid, cols1dlon) status = pio_inq_varid(ncid, 'cols1d_lat', varid) status = pio_get_var(ncid, varid, cols1dlat) cols(:) = huge(1) data_offset = huge(1) ii = 1 ndata = 0 do cc = 1, dimlen if (cols1dlon(cc) == closelon.and.cols1dlat(cc) == closelat) then cols(ii)=cc ndata =ii ii=ii+1 end if end do if (ndata == 0) then write(iulog,*)'couldnt find any columns for this latitude ',latidx,' and longitude ',lonidx call shr_sys_abort('ERROR:: no columns for this position'//errMsg(sourcefile, __LINE__)) else data_offset=cols(1) end if deallocate (cols1dlon) deallocate (cols1dlat) deallocate (cols) start(i) = data_offset count(i) = ndata else if ( trim(dimname)=='pft') then allocate (pfts1dlon(dimlen)) allocate (pfts1dlat(dimlen)) allocate (pfts(dimlen)) status = pio_inq_varid(ncid, 'pfts1d_lon', varid) status = pio_get_var(ncid, varid, pfts1dlon) status = pio_inq_varid(ncid, 'pfts1d_lat', varid) status = pio_get_var(ncid, varid, pfts1dlat) pfts(:) = huge(1) data_offset = huge(1) ii = 1 ndata = 0 do cc = 1, dimlen if (pfts1dlon(cc) == closelon.and.pfts1dlat(cc) == closelat) then pfts(ii)=cc ndata =ii ii=ii+1 end if end do if (ndata == 0) then write(iulog,*)'couldnt find any pfts for this latitude ',closelat,' and longitude ',closelon call shr_sys_abort('ERROR:: no PFTs for this position'//errMsg(sourcefile, __LINE__)) else data_offset=pfts(1) end if deallocate (pfts1dlon) deallocate (pfts1dlat) deallocate (pfts) start(i) = data_offset count(i) = ndata else if ( trim(dimname)=='landunit') then allocate (land1dlon(dimlen)) allocate (land1dlat(dimlen)) allocate (landunits(dimlen)) status = pio_inq_varid(ncid, 'land1d_lon', varid) status = pio_get_var(ncid, varid, land1dlon) status = pio_inq_varid(ncid, 'land1d_lat', varid) status = pio_get_var(ncid, varid, land1dlat) landunits(:) = huge(1) data_offset = huge(1) ii = 1 ndata = 0 do cc = 1, dimlen if (land1dlon(cc) == closelon.and.land1dlat(cc) == closelat) then landunits(ii)=cc ndata =ii ii=ii+1 end if end do if (ndata == 0) then write(iulog,*)'couldnt find any landunits for this latitude ',closelat,' and longitude ',closelon call shr_sys_abort('ERROR:: no landunits for this position'//errMsg(sourcefile, __LINE__)) else data_offset=landunits(1) end if deallocate (land1dlon) deallocate (land1dlat) deallocate (landunits) start(i) = data_offset count(i) = ndata else start(i)=1 count(i)=dimlen end if enddo deallocate(dids) # 2551 "src/main/ncdio_pio.F90.in" end subroutine scam_field_offsets !------------------------------------------------------------------------ # 2555 "src/main/ncdio_pio.F90.in" subroutine ncd_getiodesc(ncid, clmlevel, ndims, dims, dimids, & xtype, iodnum, switchdim) ! ! !DESCRIPTION: ! Returns an index to an io descriptor ! ! !ARGUMENTS: class(file_desc_t) , intent(inout) :: ncid ! PIO file descriptor character(len=8) , intent(in) :: clmlevel ! clmlevel integer , intent(in) :: ndims ! ndims for var integer , intent(in) :: dims(:) ! dim sizes integer , intent(in) :: dimids(:) ! dim ids integer , intent(in) :: xtype ! file external type integer , intent(out) :: iodnum ! iodesc num in list logical,optional , intent(in) :: switchdim ! switch level dimension and first dim ! ! !LOCAL VARIABLES: integer :: k,m,n,cnt ! indices integer :: basetype ! pio basetype integer :: gsmap_lsize ! local size of gsmap integer :: gsmap_gsize ! global size of gsmap integer :: fullsize ! size of entire array on cdf integer :: gsize ! global size of clmlevel integer :: vsize ! other dimensions integer :: vsize1, vsize2 ! other dimensions integer :: status ! error status logical :: found ! true => found created iodescriptor integer :: ndims_file ! temporary character(len=64) dimname_file ! dimension name on file character(len=64) dimname_iodesc ! dimension name from io descriptor type(mct_gsMap),pointer :: gsmap ! global seg map integer, pointer,dimension(:) :: gsmOP ! gsmap ordered points integer(pio_offset_kind), pointer :: compDOF(:) character(len=32) :: subname = 'ncd_getiodesc' !------------------------------------------------------------------------ ! Determining if need to create a new io descriptor n = 1 found = .false. do while (n <= num_iodesc .and. .not.found) if (ndims == iodesc_list(n)%ndims .and. xtype == iodesc_list(n)%type) then found = .true. ! First found implies that dimension sizes are the same do m = 1,ndims if (dims(m) /= iodesc_list(n)%dims(m)) then found = .false. endif enddo ! If found - then also check that dimension names are equal - ! dimension ids in iodescriptor are only used to query dimension ! names associated with that iodescriptor if (found) then status = PIO_inquire(ncid, ndimensions=ndims_file) do m = 1,ndims status = PIO_inq_dimname(ncid,dimids(m),dimname_file) if (iodesc_list(n)%dimids(m) > ndims_file) then found = .false. exit else status = PIO_inq_dimname(ncid,iodesc_list(n)%dimids(m),dimname_iodesc) if (trim(dimname_file) /= trim(dimname_iodesc)) then found = .false. exit end if end if end do end if if (found) then iodnum = n if (iodnum > num_iodesc) then write(iulog,*) trim(subname),' ERROR: iodnum out of range ',iodnum,num_iodesc call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif RETURN endif endif n = n + 1 enddo ! Creating a new io descriptor if (ndims > 0) then num_iodesc = num_iodesc + 1 if (num_iodesc > max_iodesc) then write(iulog,*) trim(subname),' ERROR num_iodesc gt max_iodesc ',max_iodesc call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif iodnum = num_iodesc if (masterproc .and. debug > 1) then write(iulog,*) trim(subname),' creating iodesc at iodnum,ndims,dims(1:ndims),xtype',& iodnum,ndims,dims(1:ndims),xtype endif end if if (xtype == pio_double ) then basetype = PIO_DOUBLE else if (xtype == pio_real) then basetype = PIO_DOUBLE else if (xtype == pio_int) then basetype = PIO_INT else write(iulog,*) trim(subname),'ERROR: no match for xtype = ',xtype call shr_sys_abort(errMsg(sourcefile,__LINE__)) end if call get_clmlevel_gsmap(clmlevel,gsmap) gsize = get_clmlevel_gsize(clmlevel) gsmap_lsize = mct_gsmap_lsize(gsmap,mpicom) gsmap_gsize = mct_gsmap_gsize(gsmap) call mct_gsMap_orderedPoints(gsmap,iam,gsmOP) fullsize = 1 do n = 1,ndims fullsize = fullsize*dims(n) enddo vsize = fullsize / gsize if (mod(fullsize,gsize) /= 0) then write(iulog,*) subname,' ERROR in vsize ',fullsize,gsize,vsize call shr_sys_abort(errMsg(sourcefile, __LINE__)) endif allocate(compDOF(gsmap_lsize*vsize)) if (present(switchdim)) then if (switchdim) then cnt = 0 do m = 1,gsmap_lsize do n = 1,vsize cnt = cnt + 1 compDOF(cnt) = (gsmOP(m)-1)*vsize + n enddo enddo else write(iulog,*) subname,' ERROR switch dims present must have switchdim true' call shr_sys_abort(errMsg(sourcefile, __LINE__)) end if else ! currently allow for up to two vertical dimensions if (vsize /= 1 .and. vsize /= dims(ndims)) then vsize1 = vsize/dims(ndims) vsize2 = dims(ndims) if (vsize1*vsize2 /= vsize) then write(iulog,*)'vsize1= ',vsize1,' vsize2= ',vsize2,' vsize= ',vsize call shr_sys_abort('error in vsize1 and vsize2 computation'//errMsg(sourcefile, __LINE__)) end if cnt = 0 do k = 1,vsize2 do n = 1,vsize1 do m = 1,gsmap_lsize cnt = cnt + 1 compDOF(cnt) = (k-1)*vsize1*gsmap_gsize + (n-1)*gsmap_gsize + gsmOP(m) enddo enddo end do else cnt = 0 do n = 1,vsize do m = 1,gsmap_lsize cnt = cnt + 1 compDOF(cnt) = (n-1)*gsmap_gsize + gsmOP(m) enddo enddo end if end if if (debug > 1) then do m = 0,npes-1 if (iam == m) then write(iulog,*) trim(subname),' sizes1 = ',iam,gsize,gsmap_gsize,gsmap_lsize write(iulog,*) trim(subname),' sizes2 = ',iam,fullsize,npes,vsize write(iulog,*) trim(subname),' compDOF = ',iam,size(compDOF),minval(compDOF),maxval(compDOF) call shr_sys_flush(iulog) endif call mpi_barrier(mpicom,status) enddo endif deallocate(gsmOP) call pio_initdecomp(pio_subsystem, xTYPE, dims(1:ndims), compDOF, iodesc_list(iodnum)%iodesc) deallocate(compDOF) iodesc_list(iodnum)%type = xtype iodesc_list(iodnum)%ndims = ndims iodesc_list(iodnum)%dims = 0 iodesc_list(iodnum)%dims(1:ndims) = dims(1:ndims) iodesc_list(iodnum)%dimids(1:ndims) = dimids(1:ndims) # 2744 "src/main/ncdio_pio.F90.in" end subroutine ncd_getiodesc end module ncdio_pio