!=============================================================================== ! SVN $Id: shr_pcdf_mod.F90 18683 2009-09-30 22:20:22Z kauff $ ! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq3_0_36/driver/shr_pcdf_mod.F90 $ !=============================================================================== !BOP =========================================================================== ! ! !MODULE: shr_pcdf_mod -- generic pio file reader and writer ! ! !DESCRIPTION: ! ! Reads & writes pio files ! ! !REMARKS: ! ! supports aVect, 1d real and integer, and scalar real and integer fields ! using a common decomp for all fields. this is a heavily overloaded interface ! that supports read and write of multiple fields/type to a file using a single call. ! ! !REVISION HISTORY: ! 2009-Oct-15 - T. Craig - initial implementation ! ! !INTERFACE: ------------------------------------------------------------------ module shr_pcdf_mod use shr_kind_mod, only: R8 => SHR_KIND_R8, IN => SHR_KIND_IN use shr_kind_mod, only: CL => SHR_KIND_CL, CS => SHR_KIND_CS use shr_sys_mod, only: shr_sys_abort, shr_sys_flush use shr_const_mod, only: shr_const_spval use shr_log_mod, only: shr_log_unit, shr_log_level use mct_mod use pio implicit none private !PUBLIC TYPES: ! no public types !!PUBLIC MEMBER FUNCTIONS public :: shr_pcdf_readwrite !!PUBLIC DATA MEMBERS: ! no public data !EOP character(len=*),parameter :: version = 'shr_pcdf_v0_0_01' real(r8) ,parameter :: fillvalue = SHR_CONST_SPVAL integer(in) ,parameter :: ifillvalue = -999999 !=============================================================================== contains !=============================================================================== subroutine shr_pcdf_readwrite(type,iosystem,pio_iotype,filename,mpicom,gsmap,dof,clobber,cdf64, & id1,id1n,rs1,rs1n,is1,is1n,rf1,rf1n,if1,if1n,av1,av1n, & id2,id2n,rs2,rs2n,is2,is2n,rf2,rf2n,if2,if2n,av2,av2n, & id3,id3n,rs3,rs3n,is3,is3n,rf3,rf3n,if3,if3n,av3,av3n, & id4,id4n,rs4,rs4n,is4,is4n,rf4,rf4n,if4,if4n,av4,av4n ) use pio, only : iosystem_desc_t implicit none character(len=*) , intent(in) :: type ! 'read' or 'write' type(iosystem_desc_t) :: iosystem integer(IN), intent(in) :: pio_iotype character(len=*) , intent(in) :: filename ! filename integer(IN) , intent(in) :: mpicom ! mpicom !--- one of these must be set --- type(mct_gsmap) , optional, intent(in) :: gsmap ! decomp for all data integer(IN) , optional, intent(in) :: dof(:) ! decomp for all data !--- optional settings --- logical , optional, intent(in) :: clobber logical , optional, intent(in) :: cdf64 ! add root, stride, ntasks, netcdf/pnetcdf, etc !--- data to write --- !--- single scalar dimensions, assumed valid on the io root pe --- integer(IN) , optional, intent(inout) :: id1 ! int field 1 character(len=*) , optional, intent(in) :: id1n ! if1 name integer(IN) , optional, intent(inout) :: id2 ! int field 2 character(len=*) , optional, intent(in) :: id2n ! if2 name integer(IN) , optional, intent(inout) :: id3 ! int field 3 character(len=*) , optional, intent(in) :: id3n ! if3 name integer(IN) , optional, intent(inout) :: id4 ! int field 4 character(len=*) , optional, intent(in) :: id4n ! if4 name !--- single scalar variables, assumed valid on the io root pe --- real(R8) , optional, intent(inout) :: rs1 ! real field 1 character(len=*) , optional, intent(in) :: rs1n ! rf1 name real(R8) , optional, intent(inout) :: rs2 ! real field 2 character(len=*) , optional, intent(in) :: rs2n ! rf2 name real(R8) , optional, intent(inout) :: rs3 ! real field 3 character(len=*) , optional, intent(in) :: rs3n ! rf3 name real(R8) , optional, intent(inout) :: rs4 ! real field 4 character(len=*) , optional, intent(in) :: rs4n ! rf4 name integer(IN) , optional, intent(inout) :: is1 ! int field 1 character(len=*) , optional, intent(in) :: is1n ! if1 name integer(IN) , optional, intent(inout) :: is2 ! int field 2 character(len=*) , optional, intent(in) :: is2n ! if2 name integer(IN) , optional, intent(inout) :: is3 ! int field 3 character(len=*) , optional, intent(in) :: is3n ! if3 name integer(IN) , optional, intent(inout) :: is4 ! int field 4 character(len=*) , optional, intent(in) :: is4n ! if4 name !--- single field, decomposed f90 data in 1d arrays --- real(R8) , optional, intent(inout) :: rf1(:) ! real field 1 character(len=*) , optional, intent(in) :: rf1n ! rf1 name real(R8) , optional, intent(inout) :: rf2(:) ! real field 2 character(len=*) , optional, intent(in) :: rf2n ! rf2 name real(R8) , optional, intent(inout) :: rf3(:) ! real field 3 character(len=*) , optional, intent(in) :: rf3n ! rf3 name real(R8) , optional, intent(inout) :: rf4(:) ! real field 4 character(len=*) , optional, intent(in) :: rf4n ! rf4 name integer(IN) , optional, intent(inout) :: if1(:) ! int field 1 character(len=*) , optional, intent(in) :: if1n ! if1 name integer(IN) , optional, intent(inout) :: if2(:) ! int field 2 character(len=*) , optional, intent(in) :: if2n ! if2 name integer(IN) , optional, intent(inout) :: if3(:) ! int field 3 character(len=*) , optional, intent(in) :: if3n ! if3 name integer(IN) , optional, intent(inout) :: if4(:) ! int field 4 character(len=*) , optional, intent(in) :: if4n ! if4 name !--- attr vect, decomposed f90 data in av datatype --- type(mct_aVect) , optional, intent(inout) :: av1 ! avect 1 character(len=*) , optional, intent(in) :: av1n ! av1 name type(mct_aVect) , optional, intent(inout) :: av2 ! avect 2 character(len=*) , optional, intent(in) :: av2n ! av2 name type(mct_aVect) , optional, intent(inout) :: av3 ! avect 3 character(len=*) , optional, intent(in) :: av3n ! av3 name type(mct_aVect) , optional, intent(inout) :: av4 ! avect 4 character(len=*) , optional, intent(in) :: av4n ! av4 name !--- local --- integer(IN) :: iam,ntasks integer(IN) :: ier,rcode integer(IN) :: loop,minloop,maxloop integer(IN) :: n,nf logical :: readtype integer(IN) :: lsize,gsize logical :: lclobber logical :: lcdf64 logical :: exists integer :: nmode character(CL) :: fname character(CL) :: vname type(mct_string) :: mstring ! mct char type integer(IN) :: dimid1(1) type(file_desc_t) :: fid type(var_desc_t) :: varid type(io_desc_t) :: iodescd type(io_desc_t) :: iodesci integer(IN), pointer :: ldof(:) character(len=*),parameter :: subname = '(shr_pcdf_readwrite) ' !------------- if (trim(type) == 'read') then readtype = .true. elseif (trim(type) == 'write') then readtype = .false. else call shr_sys_abort(subname//' ERROR: read write type invalid') endif lclobber = .false. if (present(clobber)) lclobber=clobber lcdf64 = .false. if (present(cdf64)) lcdf64=cdf64 call mpi_comm_size(mpicom,ntasks,ier) call mpi_comm_rank(mpicom,iam,ier) if (iam == 0) then write(shr_log_unit,*) subname,' filename = ',trim(filename) write(shr_log_unit,*) subname,' type = ',trim(type) write(shr_log_unit,*) subname,' clobber = ',lclobber write(shr_log_unit,*) subname,' cdf64 = ',lcdf64 call shr_sys_flush(shr_log_unit) endif if (present(gsmap) .and. present(dof)) then call shr_sys_abort(trim(subname)//' ERROR: either gsmap OR dof must be an argument') endif if (present(gsmap)) then lsize = mct_gsmap_lsize(gsmap,mpicom) gsize = mct_gsmap_gsize(gsmap) call mct_gsmap_OrderedPoints(gsmap, iam, ldof) call pio_initdecomp(iosystem, pio_double, (/gsize/), ldof, iodescd) call pio_initdecomp(iosystem, pio_int , (/gsize/), ldof, iodesci) deallocate(ldof) elseif (present(dof)) then lsize = size(dof) call shr_mpi_sum(lsize,gsize,mpicom,string=trim(subname),all=.true.) call pio_initdecomp(iosystem, pio_double, (/gsize/), ldof, iodescd) call pio_initdecomp(iosystem, pio_int , (/gsize/), ldof, iodesci) else call shr_sys_abort(trim(subname)//' ERROR: either gsmap OR dof must be an argument') endif if (iam == 0) then if (len_trim(filename) == 0) then call shr_sys_abort(trim(subname)//' ERROR: filename is empty') endif inquire(file=trim(filename),exist=exists) endif call shr_mpi_bcast(exists,mpicom,trim(subname)//' exists') if (readtype) then if (.not.exists) then call shr_sys_abort(trim(subname)//' ERROR: '//trim(filename)//' doesnt exist') endif nmode = pio_nowrite rcode = pio_openfile(iosystem, fid, pio_iotype, trim(filename), nmode) else if (.not.lclobber .and. exists) then call shr_sys_abort(trim(subname)//' ERROR: '//trim(filename)//' exists, no clobber set') endif if (lclobber .or. .not.exists) then nmode = pio_clobber if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) rcode = pio_createfile(iosystem, fid, pio_iotype, trim(filename), nmode) else nmode = pio_write if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET) rcode = pio_openfile(iosystem, fid, pio_iotype, trim(filename), nmode) endif rcode = pio_put_att(fid,pio_global,"file_version",version) endif call pio_seterrorhandling(fid,PIO_INTERNAL_ERROR) if (readtype) then minloop = 11 maxloop = 11 else minloop = 21 maxloop = 22 endif ! loop = 11 is read ! loop = 21 is define ! loop = 22 is write do loop = minloop,maxloop if (loop == 21) rcode = pio_def_dim(fid,'gsize',gsize,dimid1(1)) if (present(id1)) then fname = 'id1' if (present(id1n)) fname = trim(id1n) if (loop == 11) call shr_pcdf_readdim(fid,trim(fname),id1) if (loop == 21) call shr_pcdf_writedim(fid,trim(fname),id1) endif if (present(id2)) then fname = 'id2' if (present(id2n)) fname = trim(id2n) if (loop == 11) call shr_pcdf_readdim(fid,trim(fname),id2) if (loop == 21) call shr_pcdf_writedim(fid,trim(fname),id2) endif if (present(id3)) then fname = 'id3' if (present(id3n)) fname = trim(id3n) if (loop == 11) call shr_pcdf_readdim(fid,trim(fname),id3) if (loop == 21) call shr_pcdf_writedim(fid,trim(fname),id3) endif if (present(id4)) then fname = 'id4' if (present(id4n)) fname = trim(id4n) if (loop == 11) call shr_pcdf_readdim(fid,trim(fname),id4) if (loop == 21) call shr_pcdf_writedim(fid,trim(fname),id4) endif if (present(rs1)) then fname = 'rs1' if (present(rs1n)) fname = trim(rs1n) if (loop == 11) call shr_pcdf_readr0d(fid,trim(fname),rs1) if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_DOUBLE) if (loop == 22) call shr_pcdf_writer0d(fid,trim(fname),rs1) endif if (present(rs2)) then fname = 'rs2' if (present(rs2n)) fname = trim(rs2n) if (loop == 11) call shr_pcdf_readr0d(fid,trim(fname),rs2) if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_DOUBLE) if (loop == 22) call shr_pcdf_writer0d(fid,trim(fname),rs2) endif if (present(rs3)) then fname = 'rs3' if (present(rs3n)) fname = trim(rs3n) if (loop == 11) call shr_pcdf_readr0d(fid,trim(fname),rs3) if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_DOUBLE) if (loop == 22) call shr_pcdf_writer0d(fid,trim(fname),rs3) endif if (present(rs4)) then fname = 'rs4' if (present(rs4n)) fname = trim(rs4n) if (loop == 11) call shr_pcdf_readr0d(fid,trim(fname),rs4) if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_DOUBLE) if (loop == 22) call shr_pcdf_writer0d(fid,trim(fname),rs4) endif if (present(is1)) then fname = 'is1' if (present(is1n)) fname = trim(is1n) if (loop == 11) call shr_pcdf_readi0d(fid,trim(fname),is1) if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_INT) if (loop == 22) call shr_pcdf_writei0d(fid,trim(fname),is1) endif if (present(is2)) then fname = 'is2' if (present(is2n)) fname = trim(is2n) if (loop == 11) call shr_pcdf_readi0d(fid,trim(fname),is2) if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_INT) if (loop == 22) call shr_pcdf_writei0d(fid,trim(fname),is2) endif if (present(is3)) then fname = 'is3' if (present(is3n)) fname = trim(is3n) if (loop == 11) call shr_pcdf_readi0d(fid,trim(fname),is3) if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_INT) if (loop == 22) call shr_pcdf_writei0d(fid,trim(fname),is3) endif if (present(is4)) then fname = 'is4' if (present(is4n)) fname = trim(is4n) if (loop == 11) call shr_pcdf_readi0d(fid,trim(fname),is4) if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_INT) if (loop == 22) call shr_pcdf_writei0d(fid,trim(fname),is4) endif if (present(rf1)) then fname = 'rf1' if (present(rf1n)) fname = trim(rf1n) if (loop == 11) call shr_pcdf_readr1d(fid,trim(fname),iodescd,rf1) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_DOUBLE,dimid1) if (loop == 22) call shr_pcdf_writer1d(fid,trim(fname),iodescd,rf1) endif if (present(rf2)) then fname = 'rf2' if (present(rf2n)) fname = trim(rf2n) if (loop == 11) call shr_pcdf_readr1d(fid,trim(fname),iodescd,rf2) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_DOUBLE,dimid1) if (loop == 22) call shr_pcdf_writer1d(fid,trim(fname),iodescd,rf2) endif if (present(rf3)) then fname = 'rf3' if (present(rf3n)) fname = trim(rf3n) if (loop == 11) call shr_pcdf_readr1d(fid,trim(fname),iodescd,rf3) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_DOUBLE,dimid1) if (loop == 22) call shr_pcdf_writer1d(fid,trim(fname),iodescd,rf3) endif if (present(rf4)) then fname = 'rf4' if (present(rf4n)) fname = trim(rf4n) if (loop == 11) call shr_pcdf_readr1d(fid,trim(fname),iodescd,rf4) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_DOUBLE,dimid1) if (loop == 22) call shr_pcdf_writer1d(fid,trim(fname),iodescd,rf4) endif if (present(if1)) then fname = 'if1' if (present(if1n)) fname = trim(if1n) if (loop == 11) call shr_pcdf_readi1d(fid,trim(fname),iodesci,if1) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_INT,dimid1) if (loop == 22) call shr_pcdf_writei1d(fid,trim(fname),iodesci,if1) endif if (present(if2)) then fname = 'if2' if (present(if2n)) fname = trim(if2n) if (loop == 11) call shr_pcdf_readi1d(fid,trim(fname),iodesci,if2) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_INT,dimid1) if (loop == 22) call shr_pcdf_writei1d(fid,trim(fname),iodesci,if2) endif if (present(if3)) then fname = 'if3' if (present(if3n)) fname = trim(if3n) if (loop == 11) call shr_pcdf_readi1d(fid,trim(fname),iodesci,if3) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_INT,dimid1) if (loop == 22) call shr_pcdf_writei1d(fid,trim(fname),iodesci,if3) endif if (present(if4)) then fname = 'if4' if (present(if4n)) fname = trim(if4n) if (loop == 11) call shr_pcdf_readi1d(fid,trim(fname),iodesci,if4) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_INT,dimid1) if (loop == 22) call shr_pcdf_writei1d(fid,trim(fname),iodesci,if4) endif if (present(av1)) then fname = 'av1_' if (present(av1n)) then if (trim(av1n) == '') then fname = trim(av1n) else fname = trim(av1n)//'_' endif endif nf = mct_aVect_nRattr(av1) do n = 1,nf call mct_aVect_getRList(mstring,n,av1) vname = trim(fname)//trim(mct_string_toChar(mstring)) call mct_string_clean(mstring) if (loop == 11) call shr_pcdf_readr1d(fid,trim(vname),iodescd,av1%rAttr(n,:)) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_DOUBLE,dimid1) if (loop == 22) call shr_pcdf_writer1d(fid,trim(vname),iodescd,av1%rAttr(n,:)) enddo nf = mct_aVect_nIattr(av1) do n = 1,nf call mct_aVect_getIList(mstring,n,av1) vname = trim(fname)//trim(mct_string_toChar(mstring)) call mct_string_clean(mstring) if (loop == 11) call shr_pcdf_readi1d(fid,trim(vname),iodesci,av1%iAttr(n,:)) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_INT,dimid1) if (loop == 22) call shr_pcdf_writei1d(fid,trim(vname),iodesci,av1%iAttr(n,:)) enddo endif if (present(av2)) then fname = 'av2_' if (present(av2n)) then if (trim(av2n) == '') then fname = trim(av2n) else fname = trim(av2n)//'_' endif endif nf = mct_aVect_nRattr(av2) do n = 1,nf call mct_aVect_getRList(mstring,n,av2) vname = trim(fname)//trim(mct_string_toChar(mstring)) call mct_string_clean(mstring) if (loop == 11) call shr_pcdf_readr1d(fid,trim(vname),iodescd,av2%rAttr(n,:)) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_DOUBLE,dimid1) if (loop == 22) call shr_pcdf_writer1d(fid,trim(vname),iodescd,av2%rAttr(n,:)) enddo nf = mct_aVect_nIattr(av2) do n = 1,nf call mct_aVect_getIList(mstring,n,av2) vname = trim(fname)//trim(mct_string_toChar(mstring)) call mct_string_clean(mstring) if (loop == 11) call shr_pcdf_readi1d(fid,trim(vname),iodesci,av2%iAttr(n,:)) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_INT,dimid1) if (loop == 22) call shr_pcdf_writei1d(fid,trim(vname),iodesci,av2%iAttr(n,:)) enddo endif if (present(av3)) then fname = 'av3_' if (present(av3n)) then if (trim(av3n) == '') then fname = trim(av3n) else fname = trim(av3n)//'_' endif endif nf = mct_aVect_nRattr(av3) do n = 1,nf call mct_aVect_getRList(mstring,n,av3) vname = trim(fname)//trim(mct_string_toChar(mstring)) call mct_string_clean(mstring) if (loop == 11) call shr_pcdf_readr1d(fid,trim(vname),iodescd,av3%rAttr(n,:)) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_DOUBLE,dimid1) if (loop == 22) call shr_pcdf_writer1d(fid,trim(vname),iodescd,av3%rAttr(n,:)) enddo nf = mct_aVect_nIattr(av3) do n = 1,nf call mct_aVect_getIList(mstring,n,av3) vname = trim(fname)//trim(mct_string_toChar(mstring)) call mct_string_clean(mstring) if (loop == 11) call shr_pcdf_readi1d(fid,trim(vname),iodesci,av3%iAttr(n,:)) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_INT,dimid1) if (loop == 22) call shr_pcdf_writei1d(fid,trim(vname),iodesci,av3%iAttr(n,:)) enddo endif if (present(av4)) then fname = 'av4_' if (present(av4n)) then if (trim(av4n) == '') then fname = trim(av4n) else fname = trim(av4n)//'_' endif endif nf = mct_aVect_nRattr(av4) do n = 1,nf call mct_aVect_getRList(mstring,n,av4) vname = trim(fname)//trim(mct_string_toChar(mstring)) call mct_string_clean(mstring) if (loop == 11) call shr_pcdf_readr1d(fid,trim(vname),iodescd,av4%rAttr(n,:)) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_DOUBLE,dimid1) if (loop == 22) call shr_pcdf_writer1d(fid,trim(vname),iodescd,av4%rAttr(n,:)) enddo nf = mct_aVect_nIattr(av4) do n = 1,nf call mct_aVect_getIList(mstring,n,av4) vname = trim(fname)//trim(mct_string_toChar(mstring)) call mct_string_clean(mstring) if (loop == 11) call shr_pcdf_readi1d(fid,trim(vname),iodesci,av4%iAttr(n,:)) if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_INT,dimid1) if (loop == 22) call shr_pcdf_writei1d(fid,trim(vname),iodesci,av4%iAttr(n,:)) enddo endif if (loop == 21) rcode = pio_enddef(fid) enddo call pio_freedecomp(fid,iodesci) call pio_freedecomp(fid,iodescd) call pio_closefile(fid) end subroutine shr_pcdf_readwrite !=============================================================================== !=============================================================================== subroutine shr_pcdf_defvar0d(fid,fname,vtype) implicit none type(file_desc_t),intent(in) :: fid character(len=*) ,intent(in) :: fname integer(IN) ,intent(in) :: vtype !--- local --- type(var_desc_t) :: varid integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_defvar0d) ' !------------- rcode = pio_def_var(fid,trim(fname),vtype,varid) end subroutine shr_pcdf_defvar0d !=============================================================================== subroutine shr_pcdf_defvar1d(fid,fname,vtype,dimid) implicit none type(file_desc_t),intent(in) :: fid character(len=*) ,intent(in) :: fname integer(IN) ,intent(in) :: vtype integer(IN) ,intent(in) :: dimid(:) !--- local --- type(var_desc_t) :: varid integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_defvar1d) ' !------------- rcode = pio_def_var(fid,trim(fname),vtype,dimid,varid) end subroutine shr_pcdf_defvar1d !=============================================================================== subroutine shr_pcdf_readr1d(fid,fname,iodesc,r1d) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname type(io_desc_t) ,intent(inout) :: iodesc real(R8) ,intent(inout) :: r1d(:) !--- local --- type(var_desc_t) :: varid integer(IN) :: dimid(4),ndims integer(IN) :: vsize,fsize integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_readr1d) ' !------------- rcode = pio_inq_varid(fid,trim(fname),varid) !--tcraig, here vsize is global, fsize is local, what check if any? ! rcode = pio_inq_varndims(fid, varid, ndims) ! rcode = pio_inq_vardimid(fid, varid, dimid(1:ndims)) ! rcode = pio_inq_dimlen(fid, dimid(1), vsize) ! fsize = size(r1d) ! if (vsize /= fsize) then ! write(shr_log_unit,*) subname,' ERROR: vsize,fsize = ',vsize,fsize ! call shr_sys_abort(trim(subname)//' ERROR: vsize,fsize') ! endif call pio_read_darray(fid,varid,iodesc,r1d,rcode) end subroutine shr_pcdf_readr1d !=============================================================================== subroutine shr_pcdf_writer1d(fid,fname,iodesc,r1d) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname type(io_desc_t) ,intent(inout) :: iodesc real(R8) ,intent(inout) :: r1d(:) !--- local --- type(var_desc_t) :: varid integer(IN) :: dimid(4) integer(IN) :: vsize,fsize real(R8) :: lfillvalue integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_writer1d) ' !------------- lfillvalue = fillvalue rcode = pio_inq_varid(fid,trim(fname),varid) call pio_write_darray(fid, varid, iodesc, r1d, rcode, fillval=lfillvalue) end subroutine shr_pcdf_writer1d !=============================================================================== !=============================================================================== subroutine shr_pcdf_readi1d(fid,fname,iodesc,i1d) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname type(io_desc_t) ,intent(inout) :: iodesc integer(IN) ,intent(inout) :: i1d(:) !--- local --- type(var_desc_t) :: varid integer(IN) :: dimid(4),ndims integer(IN) :: vsize,fsize integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_readi1d) ' !------------- rcode = pio_inq_varid(fid,trim(fname),varid) !--tcraig, here vsize is global, fsize is local, what check if any? ! rcode = pio_inq_varndims(fid, varid, ndims) ! rcode = pio_inq_vardimid(fid, varid, dimid(1:ndims)) ! rcode = pio_inq_dimlen(fid, dimid(1), vsize) ! fsize = size(i1d) ! if (vsize /= fsize) then ! write(shr_log_unit,*) subname,' ERROR: vsize,fsize = ',vsize,fsize ! call shr_sys_abort(trim(subname)//' ERROR: vsize,fsize') ! endif call pio_read_darray(fid,varid,iodesc,i1d,rcode) end subroutine shr_pcdf_readi1d !=============================================================================== subroutine shr_pcdf_writei1d(fid,fname,iodesc,i1d) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname type(io_desc_t) ,intent(inout) :: iodesc integer(IN) ,intent(inout) :: i1d(:) !--- local --- type(var_desc_t) :: varid integer(IN) :: dimid(4) integer(IN) :: vsize,fsize integer(IN) :: lfillvalue integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_writei1d) ' !------------- lfillvalue = ifillvalue rcode = pio_inq_varid(fid,trim(fname),varid) call pio_write_darray(fid, varid, iodesc, i1d, rcode, fillval=lfillvalue) end subroutine shr_pcdf_writei1d !=============================================================================== !=============================================================================== subroutine shr_pcdf_readr0d(fid,fname,r0d) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname real(R8) ,intent(inout) :: r0d !--- local --- type(var_desc_t) :: varid integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_readr0d) ' !------------- rcode = pio_inq_varid(fid,trim(fname),varid) rcode = pio_get_var(fid,varid,r0d) end subroutine shr_pcdf_readr0d !=============================================================================== subroutine shr_pcdf_writer0d(fid,fname,r0d) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname real(R8) ,intent(inout) :: r0d !--- local --- type(var_desc_t) :: varid integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_writer0d) ' !------------- rcode = pio_inq_varid(fid,trim(fname),varid) rcode = pio_put_var(fid, varid, r0d) end subroutine shr_pcdf_writer0d !=============================================================================== !=============================================================================== subroutine shr_pcdf_readi0d(fid,fname,i0d) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname integer(IN) ,intent(inout) :: i0d !--- local --- type(var_desc_t) :: varid integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_readi0d) ' !------------- rcode = pio_inq_varid(fid,trim(fname),varid) rcode = pio_get_var(fid,varid,i0d) end subroutine shr_pcdf_readi0d !=============================================================================== subroutine shr_pcdf_writei0d(fid,fname,i0d) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname integer(IN) ,intent(inout) :: i0d !--- local --- type(var_desc_t) :: varid integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_writei0d) ' !------------- rcode = pio_inq_varid(fid,trim(fname),varid) rcode = pio_put_var(fid, varid, i0d) end subroutine shr_pcdf_writei0d !=============================================================================== !=============================================================================== subroutine shr_pcdf_readdim(fid,fname,dim) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname integer(IN) ,intent(inout) :: dim !--- local --- integer(IN) :: dimid integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_readdim) ' !------------- rcode = pio_inq_dimid(fid,trim(fname),dimid) rcode = pio_inq_dimlen(fid,dimid,dim) end subroutine shr_pcdf_readdim !=============================================================================== subroutine shr_pcdf_writedim(fid,fname,dim) implicit none type(file_desc_t),intent(inout) :: fid character(len=*) ,intent(in) :: fname integer(IN) ,intent(inout) :: dim !--- local --- integer(IN) :: dimid integer(IN) :: rcode character(len=*),parameter :: subname = '(shr_pcdf_writedim) ' !------------- rcode = pio_def_dim(fid,trim(fname),dim,dimid) end subroutine shr_pcdf_writedim !=============================================================================== !=============================================================================== !=============================================================================== end module shr_pcdf_mod