CESM_Driver: shr_pcdf_mod.F90 Source File

00001 !===============================================================================
00002 ! SVN $Id: shr_pcdf_mod.F90 18683 2009-09-30 22:20:22Z kauff $
00003 ! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/trunk_tags/drvseq3_0_36/driver/shr_pcdf_mod.F90 $
00004 !===============================================================================
00005 !BOP ===========================================================================
00006 !
00007 ! !MODULE: shr_pcdf_mod -- generic pio file reader and writer
00008 !
00009 ! !DESCRIPTION:
00010 !
00011 !    Reads & writes pio files
00012 !
00013 ! !REMARKS:
00014 !
00015 !    supports aVect, 1d real and integer, and scalar real and integer fields
00016 !    using a common decomp for all fields.  this is a heavily overloaded interface
00017 !    that supports read and write of multiple fields/type to a file using a single call.
00018 !
00019 ! !REVISION HISTORY:
00020 !     2009-Oct-15 - T. Craig - initial implementation
00021 !
00022 ! !INTERFACE: ------------------------------------------------------------------
00023 
00024 module shr_pcdf_mod
00025 
00026   use shr_kind_mod,      only: R8 => SHR_KIND_R8, IN => SHR_KIND_IN
00027   use shr_kind_mod,      only: CL => SHR_KIND_CL, CS => SHR_KIND_CS
00028   use shr_sys_mod,       only: shr_sys_abort, shr_sys_flush
00029   use shr_const_mod,     only: shr_const_spval
00030   use shr_log_mod,       only: shr_log_unit, shr_log_level
00031   use mct_mod
00032   use pio
00033  
00034   implicit none
00035 
00036   private
00037 
00038  !PUBLIC TYPES:
00039 
00040   ! no public types
00041 
00042 !!PUBLIC MEMBER FUNCTIONS
00043 
00044   public :: shr_pcdf_readwrite
00045 
00046 !!PUBLIC DATA MEMBERS:
00047 
00048   ! no public data
00049 
00050 !EOP
00051 
00052   character(len=*),parameter :: version   = 'shr_pcdf_v0_0_01'
00053   real(r8)        ,parameter :: fillvalue = SHR_CONST_SPVAL
00054   integer(in)     ,parameter :: ifillvalue = -999999
00055   
00056 !===============================================================================
00057 contains
00058 !===============================================================================
00059 subroutine shr_pcdf_readwrite(type,filename,mpicom,gsmap,dof,clobber,cdf64, &
00060                      id1,id1n,rs1,rs1n,is1,is1n,rf1,rf1n,if1,if1n,av1,av1n, &
00061                      id2,id2n,rs2,rs2n,is2,is2n,rf2,rf2n,if2,if2n,av2,av2n, &
00062                      id3,id3n,rs3,rs3n,is3,is3n,rf3,rf3n,if3,if3n,av3,av3n, &
00063                      id4,id4n,rs4,rs4n,is4,is4n,rf4,rf4n,if4,if4n,av4,av4n  )
00064 
00065   implicit none
00066 
00067   character(len=*) , intent(in)    :: type      ! 'read' or 'write'
00068   character(len=*) , intent(in)    :: filename  ! filename
00069   integer(IN)      , intent(in)    :: mpicom    ! mpicom
00070 
00071   !--- one of these must be set ---
00072   type(mct_gsmap)  , optional, intent(in)    :: gsmap    ! decomp for all data
00073   integer(IN)      , optional, intent(in)    :: dof(:)   ! decomp for all data
00074 
00075   !--- optional settings ---
00076   logical          , optional, intent(in)    :: clobber
00077   logical          , optional, intent(in)    :: cdf64
00078   ! add root, stride, ntasks, netcdf/pnetcdf, etc
00079 
00080   !--- data to write ---
00081 
00082   !--- single scalar dimensions, assumed valid on the io root pe ---
00083   integer(IN)      , optional, intent(inout) :: id1      ! int field 1
00084   character(len=*) , optional, intent(in)    :: id1n     ! if1 name
00085   integer(IN)      , optional, intent(inout) :: id2      ! int field 2
00086   character(len=*) , optional, intent(in)    :: id2n     ! if2 name
00087   integer(IN)      , optional, intent(inout) :: id3      ! int field 3
00088   character(len=*) , optional, intent(in)    :: id3n     ! if3 name
00089   integer(IN)      , optional, intent(inout) :: id4      ! int field 4
00090   character(len=*) , optional, intent(in)    :: id4n     ! if4 name
00091 
00092   !--- single scalar variables, assumed valid on the io root pe ---
00093   real(R8)         , optional, intent(inout) :: rs1      ! real field 1
00094   character(len=*) , optional, intent(in)    :: rs1n     ! rf1 name
00095   real(R8)         , optional, intent(inout) :: rs2      ! real field 2
00096   character(len=*) , optional, intent(in)    :: rs2n     ! rf2 name
00097   real(R8)         , optional, intent(inout) :: rs3      ! real field 3
00098   character(len=*) , optional, intent(in)    :: rs3n     ! rf3 name
00099   real(R8)         , optional, intent(inout) :: rs4      ! real field 4
00100   character(len=*) , optional, intent(in)    :: rs4n     ! rf4 name
00101   integer(IN)      , optional, intent(inout) :: is1      ! int field 1
00102   character(len=*) , optional, intent(in)    :: is1n     ! if1 name
00103   integer(IN)      , optional, intent(inout) :: is2      ! int field 2
00104   character(len=*) , optional, intent(in)    :: is2n     ! if2 name
00105   integer(IN)      , optional, intent(inout) :: is3      ! int field 3
00106   character(len=*) , optional, intent(in)    :: is3n     ! if3 name
00107   integer(IN)      , optional, intent(inout) :: is4      ! int field 4
00108   character(len=*) , optional, intent(in)    :: is4n     ! if4 name
00109 
00110   !--- single field, decomposed f90 data in 1d arrays ---
00111   real(R8)         , optional, intent(inout) :: rf1(:)   ! real field 1
00112   character(len=*) , optional, intent(in)    :: rf1n     ! rf1 name
00113   real(R8)         , optional, intent(inout) :: rf2(:)   ! real field 2
00114   character(len=*) , optional, intent(in)    :: rf2n     ! rf2 name
00115   real(R8)         , optional, intent(inout) :: rf3(:)   ! real field 3
00116   character(len=*) , optional, intent(in)    :: rf3n     ! rf3 name
00117   real(R8)         , optional, intent(inout) :: rf4(:)   ! real field 4
00118   character(len=*) , optional, intent(in)    :: rf4n     ! rf4 name
00119   integer(IN)      , optional, intent(inout) :: if1(:)   ! int field 1
00120   character(len=*) , optional, intent(in)    :: if1n     ! if1 name
00121   integer(IN)      , optional, intent(inout) :: if2(:)   ! int field 2
00122   character(len=*) , optional, intent(in)    :: if2n     ! if2 name
00123   integer(IN)      , optional, intent(inout) :: if3(:)   ! int field 3
00124   character(len=*) , optional, intent(in)    :: if3n     ! if3 name
00125   integer(IN)      , optional, intent(inout) :: if4(:)   ! int field 4
00126   character(len=*) , optional, intent(in)    :: if4n     ! if4 name
00127 
00128   !--- attr vect, decomposed f90 data in av datatype ---
00129   type(mct_aVect)  , optional, intent(inout) :: av1      ! avect 1
00130   character(len=*) , optional, intent(in)    :: av1n     ! av1 name
00131   type(mct_aVect)  , optional, intent(inout) :: av2      ! avect 2
00132   character(len=*) , optional, intent(in)    :: av2n     ! av2 name
00133   type(mct_aVect)  , optional, intent(inout) :: av3      ! avect 3
00134   character(len=*) , optional, intent(in)    :: av3n     ! av3 name
00135   type(mct_aVect)  , optional, intent(inout) :: av4      ! avect 4
00136   character(len=*) , optional, intent(in)    :: av4n     ! av4 name
00137 
00138   !--- local ---
00139   integer(IN)   :: iam,ntasks
00140   integer(IN)   :: ier,rcode
00141   integer(IN)   :: lpio_root, lpio_stride, lpio_ntasks, lpio_type
00142   integer(IN)   :: loop,minloop,maxloop
00143   integer(IN)   :: n,nf
00144   logical       :: readtype
00145   integer(IN)   :: lsize,gsize
00146   logical       :: lclobber
00147   logical       :: lcdf64
00148   logical       :: exists
00149   integer       :: nmode
00150   character(CL) :: fname
00151   character(CL) :: vname
00152   type(mct_string) :: mstring     ! mct char type
00153   integer(IN)   :: dimid1(1)
00154 
00155   type(iosystem_desc_t) :: iosystem
00156   type(file_desc_t)     :: fid
00157   type(var_desc_t)      :: varid
00158   type(io_desc_t)       :: iodescd
00159   type(io_desc_t)       :: iodesci
00160   integer(IN), pointer  :: ldof(:)
00161 
00162   character(len=*),parameter :: subname = '(shr_pcdf_readwrite) '
00163   
00164   !-------------
00165 
00166   if (trim(type) == 'read') then
00167      readtype = .true.
00168   elseif (trim(type) == 'write') then
00169      readtype = .false.
00170   else
00171      call shr_sys_abort(subname//' ERROR: read write type invalid')
00172   endif
00173 
00174   lclobber = .false.
00175   if (present(clobber)) lclobber=clobber
00176 
00177   lcdf64 = .false.
00178   if (present(cdf64)) lcdf64=cdf64
00179 
00180   call mpi_comm_size(mpicom,ntasks,ier)
00181   call mpi_comm_rank(mpicom,iam,ier)
00182 
00183 !  lpio_type = iotype_pnetcdf
00184   lpio_type = iotype_netcdf
00185   lpio_root = 0
00186   lpio_stride = 4
00187   lpio_ntasks = max(1,ntasks/lpio_stride)
00188 
00189   if (iam == 0) then
00190      write(shr_log_unit,*) subname,' filename   = ',trim(filename)
00191      write(shr_log_unit,*) subname,' type       = ',trim(type)
00192      write(shr_log_unit,*) subname,' clobber    = ',lclobber
00193      write(shr_log_unit,*) subname,' cdf64      = ',lcdf64
00194      write(shr_log_unit,*) subname,' pio_type   = ',lpio_type
00195      write(shr_log_unit,*) subname,' pio_root   = ',lpio_root
00196      write(shr_log_unit,*) subname,' pio_ntasks = ',lpio_ntasks
00197      write(shr_log_unit,*) subname,' pio_stride = ',lpio_stride
00198      call shr_sys_flush(shr_log_unit)
00199   endif
00200 
00201   call pio_init(iam,mpicom,lpio_ntasks,0,lpio_stride, PIO_REARR_BOX,iosystem,base=lpio_root)
00202 
00203   if (present(gsmap) .and. present(dof)) then
00204      call shr_sys_abort(trim(subname)//' ERROR: either gsmap OR dof must be an argument')
00205   endif
00206   if (present(gsmap)) then
00207      lsize = mct_gsmap_lsize(gsmap,mpicom)
00208      gsize = mct_gsmap_gsize(gsmap)
00209      call mct_gsmap_OrderedPoints(gsmap, iam, ldof)
00210      call pio_initdecomp(iosystem, pio_double, (/gsize/), ldof, iodescd)
00211      call pio_initdecomp(iosystem, pio_int   , (/gsize/), ldof, iodesci)
00212      deallocate(ldof)
00213   elseif (present(dof)) then
00214      lsize = size(dof)
00215      call shr_mpi_sum(lsize,gsize,mpicom,string=trim(subname),all=.true.)
00216      call pio_initdecomp(iosystem, pio_double, (/gsize/), ldof, iodescd)
00217      call pio_initdecomp(iosystem, pio_int   , (/gsize/), ldof, iodesci)
00218   else
00219      call shr_sys_abort(trim(subname)//' ERROR: either gsmap OR dof must be an argument')
00220   endif
00221 
00222   if (iam == 0) then
00223      if (len_trim(filename) == 0) then
00224         call shr_sys_abort(trim(subname)//' ERROR: filename is empty')
00225      endif
00226      inquire(file=trim(filename),exist=exists)
00227   endif
00228   call shr_mpi_bcast(exists,mpicom,trim(subname)//' exists')
00229 
00230   if (readtype) then
00231      if (.not.exists) then
00232         call shr_sys_abort(trim(subname)//' ERROR: '//trim(filename)//' doesnt exist')
00233      endif
00234      nmode = pio_noclobber
00235      rcode = pio_openfile(iosystem, fid, lpio_type, trim(filename), nmode)
00236   else
00237      if (.not.lclobber .and. exists) then
00238         call shr_sys_abort(trim(subname)//' ERROR: '//trim(filename)//' exists, no clobber set')
00239      endif
00240      if (lclobber .or. .not.exists) then
00241         nmode = pio_clobber
00242         if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
00243         rcode = pio_createfile(iosystem, fid, lpio_type, trim(filename), nmode)
00244      else
00245         nmode = pio_noclobber
00246         if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
00247         rcode = pio_openfile(iosystem, fid, lpio_type, trim(filename), nmode)
00248      endif
00249      rcode = pio_put_att(fid,pio_global,"file_version",version)
00250   endif
00251   call pio_seterrorhandling(fid,PIO_INTERNAL_ERROR)
00252 
00253   if (readtype) then
00254      minloop = 11
00255      maxloop = 11
00256   else
00257      minloop = 21
00258      maxloop = 22
00259   endif
00260 
00261   ! loop = 11 is read
00262   ! loop = 21 is define
00263   ! loop = 22 is write
00264   do loop = minloop,maxloop
00265 
00266      if (loop == 21) rcode = pio_def_dim(fid,'gsize',gsize,dimid1(1))
00267 
00268      if (present(id1)) then
00269         fname = 'id1'
00270         if (present(id1n)) fname = trim(id1n)
00271         if (loop == 11) call shr_pcdf_readdim(fid,trim(fname),id1)
00272         if (loop == 21) call shr_pcdf_writedim(fid,trim(fname),id1)
00273      endif
00274 
00275      if (present(id2)) then
00276         fname = 'id2'
00277         if (present(id2n)) fname = trim(id2n)
00278         if (loop == 11) call shr_pcdf_readdim(fid,trim(fname),id2)
00279         if (loop == 21) call shr_pcdf_writedim(fid,trim(fname),id2)
00280      endif
00281 
00282      if (present(id3)) then
00283         fname = 'id3'
00284         if (present(id3n)) fname = trim(id3n)
00285         if (loop == 11) call shr_pcdf_readdim(fid,trim(fname),id3)
00286         if (loop == 21) call shr_pcdf_writedim(fid,trim(fname),id3)
00287      endif
00288 
00289      if (present(id4)) then
00290         fname = 'id4'
00291         if (present(id4n)) fname = trim(id4n)
00292         if (loop == 11) call shr_pcdf_readdim(fid,trim(fname),id4)
00293         if (loop == 21) call shr_pcdf_writedim(fid,trim(fname),id4)
00294      endif
00295 
00296      if (present(rs1)) then
00297         fname = 'rs1'
00298         if (present(rs1n)) fname = trim(rs1n)
00299         if (loop == 11) call shr_pcdf_readr0d(fid,trim(fname),rs1)
00300         if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_DOUBLE)
00301         if (loop == 22) call shr_pcdf_writer0d(fid,trim(fname),rs1)
00302      endif
00303 
00304      if (present(rs2)) then
00305         fname = 'rs2'
00306         if (present(rs2n)) fname = trim(rs2n)
00307         if (loop == 11) call shr_pcdf_readr0d(fid,trim(fname),rs2)
00308         if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_DOUBLE)
00309         if (loop == 22) call shr_pcdf_writer0d(fid,trim(fname),rs2)
00310      endif
00311 
00312      if (present(rs3)) then
00313         fname = 'rs3'
00314         if (present(rs3n)) fname = trim(rs3n)
00315         if (loop == 11) call shr_pcdf_readr0d(fid,trim(fname),rs3)
00316         if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_DOUBLE)
00317         if (loop == 22) call shr_pcdf_writer0d(fid,trim(fname),rs3)
00318      endif
00319 
00320      if (present(rs4)) then
00321         fname = 'rs4'
00322         if (present(rs4n)) fname = trim(rs4n)
00323         if (loop == 11) call shr_pcdf_readr0d(fid,trim(fname),rs4)
00324         if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_DOUBLE)
00325         if (loop == 22) call shr_pcdf_writer0d(fid,trim(fname),rs4)
00326      endif
00327 
00328      if (present(is1)) then
00329         fname = 'is1'
00330         if (present(is1n)) fname = trim(is1n)
00331         if (loop == 11) call shr_pcdf_readi0d(fid,trim(fname),is1)
00332         if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_INT)
00333         if (loop == 22) call shr_pcdf_writei0d(fid,trim(fname),is1)
00334      endif
00335 
00336      if (present(is2)) then
00337         fname = 'is2'
00338         if (present(is2n)) fname = trim(is2n)
00339         if (loop == 11) call shr_pcdf_readi0d(fid,trim(fname),is2)
00340         if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_INT)
00341         if (loop == 22) call shr_pcdf_writei0d(fid,trim(fname),is2)
00342      endif
00343  
00344      if (present(is3)) then
00345         fname = 'is3'
00346         if (present(is3n)) fname = trim(is3n)
00347         if (loop == 11) call shr_pcdf_readi0d(fid,trim(fname),is3)
00348         if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_INT)
00349         if (loop == 22) call shr_pcdf_writei0d(fid,trim(fname),is3)
00350      endif
00351 
00352      if (present(is4)) then
00353         fname = 'is4'
00354         if (present(is4n)) fname = trim(is4n)
00355         if (loop == 11) call shr_pcdf_readi0d(fid,trim(fname),is4)
00356         if (loop == 21) call shr_pcdf_defvar0d(fid,trim(fname),PIO_INT)
00357         if (loop == 22) call shr_pcdf_writei0d(fid,trim(fname),is4)
00358      endif
00359 
00360     if (present(rf1)) then
00361         fname = 'rf1'
00362         if (present(rf1n)) fname = trim(rf1n)
00363         if (loop == 11) call shr_pcdf_readr1d(fid,trim(fname),iodescd,rf1)
00364         if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_DOUBLE,dimid1)
00365         if (loop == 22) call shr_pcdf_writer1d(fid,trim(fname),iodescd,rf1)
00366      endif
00367 
00368      if (present(rf2)) then
00369         fname = 'rf2'
00370         if (present(rf2n)) fname = trim(rf2n)
00371         if (loop == 11) call shr_pcdf_readr1d(fid,trim(fname),iodescd,rf2)
00372         if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_DOUBLE,dimid1)
00373         if (loop == 22) call shr_pcdf_writer1d(fid,trim(fname),iodescd,rf2)
00374      endif
00375 
00376      if (present(rf3)) then
00377         fname = 'rf3'
00378         if (present(rf3n)) fname = trim(rf3n)
00379         if (loop == 11) call shr_pcdf_readr1d(fid,trim(fname),iodescd,rf3)
00380         if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_DOUBLE,dimid1)
00381         if (loop == 22) call shr_pcdf_writer1d(fid,trim(fname),iodescd,rf3)
00382      endif
00383 
00384      if (present(rf4)) then
00385         fname = 'rf4'
00386         if (present(rf4n)) fname = trim(rf4n)
00387         if (loop == 11) call shr_pcdf_readr1d(fid,trim(fname),iodescd,rf4)
00388         if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_DOUBLE,dimid1)
00389         if (loop == 22) call shr_pcdf_writer1d(fid,trim(fname),iodescd,rf4)
00390      endif
00391 
00392      if (present(if1)) then
00393         fname = 'if1'
00394         if (present(if1n)) fname = trim(if1n)
00395         if (loop == 11) call shr_pcdf_readi1d(fid,trim(fname),iodesci,if1)
00396         if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_INT,dimid1)
00397         if (loop == 22) call shr_pcdf_writei1d(fid,trim(fname),iodesci,if1)
00398      endif
00399 
00400      if (present(if2)) then
00401         fname = 'if2'
00402         if (present(if2n)) fname = trim(if2n)
00403         if (loop == 11) call shr_pcdf_readi1d(fid,trim(fname),iodesci,if2)
00404         if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_INT,dimid1)
00405         if (loop == 22) call shr_pcdf_writei1d(fid,trim(fname),iodesci,if2)
00406      endif
00407 
00408      if (present(if3)) then
00409         fname = 'if3'
00410         if (present(if3n)) fname = trim(if3n)
00411         if (loop == 11) call shr_pcdf_readi1d(fid,trim(fname),iodesci,if3)
00412         if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_INT,dimid1)
00413         if (loop == 22) call shr_pcdf_writei1d(fid,trim(fname),iodesci,if3)
00414      endif
00415 
00416      if (present(if4)) then
00417         fname = 'if4'
00418         if (present(if4n)) fname = trim(if4n)
00419         if (loop == 11) call shr_pcdf_readi1d(fid,trim(fname),iodesci,if4)
00420         if (loop == 21) call shr_pcdf_defvar1d(fid,trim(fname),PIO_INT,dimid1)
00421         if (loop == 22) call shr_pcdf_writei1d(fid,trim(fname),iodesci,if4)
00422      endif
00423 
00424      if (present(av1)) then
00425         fname = 'av1_'
00426         if (present(av1n)) then
00427            if (trim(av1n) == '') then
00428               fname = trim(av1n)
00429            else
00430               fname = trim(av1n)//'_'
00431            endif
00432         endif
00433         nf = mct_aVect_nRattr(av1)
00434         do n = 1,nf
00435            call mct_aVect_getRList(mstring,n,av1)
00436            vname = trim(fname)//trim(mct_string_toChar(mstring))
00437            call mct_string_clean(mstring)
00438            if (loop == 11) call shr_pcdf_readr1d(fid,trim(vname),iodescd,av1%rAttr(n,:))
00439            if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_DOUBLE,dimid1)
00440            if (loop == 22) call shr_pcdf_writer1d(fid,trim(vname),iodescd,av1%rAttr(n,:))
00441         enddo
00442         nf = mct_aVect_nIattr(av1)
00443         do n = 1,nf
00444            call mct_aVect_getIList(mstring,n,av1)
00445            vname = trim(fname)//trim(mct_string_toChar(mstring))
00446            call mct_string_clean(mstring)
00447            if (loop == 11) call shr_pcdf_readi1d(fid,trim(vname),iodesci,av1%iAttr(n,:))
00448            if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_INT,dimid1)
00449            if (loop == 22) call shr_pcdf_writei1d(fid,trim(vname),iodesci,av1%iAttr(n,:))
00450         enddo
00451      endif
00452 
00453      if (present(av2)) then
00454         fname = 'av2_'
00455         if (present(av2n)) then
00456            if (trim(av2n) == '') then
00457               fname = trim(av2n)
00458            else
00459               fname = trim(av2n)//'_'
00460            endif
00461         endif
00462         nf = mct_aVect_nRattr(av2)
00463         do n = 1,nf
00464            call mct_aVect_getRList(mstring,n,av2)
00465            vname = trim(fname)//trim(mct_string_toChar(mstring))
00466            call mct_string_clean(mstring)
00467            if (loop == 11) call shr_pcdf_readr1d(fid,trim(vname),iodescd,av2%rAttr(n,:))
00468            if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_DOUBLE,dimid1)
00469            if (loop == 22) call shr_pcdf_writer1d(fid,trim(vname),iodescd,av2%rAttr(n,:))
00470         enddo
00471         nf = mct_aVect_nIattr(av2)
00472         do n = 1,nf
00473            call mct_aVect_getIList(mstring,n,av2)
00474            vname = trim(fname)//trim(mct_string_toChar(mstring))
00475            call mct_string_clean(mstring)
00476            if (loop == 11) call shr_pcdf_readi1d(fid,trim(vname),iodesci,av2%iAttr(n,:))
00477            if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_INT,dimid1)
00478            if (loop == 22) call shr_pcdf_writei1d(fid,trim(vname),iodesci,av2%iAttr(n,:))
00479         enddo
00480      endif
00481 
00482      if (present(av3)) then
00483         fname = 'av3_'
00484         if (present(av3n)) then
00485            if (trim(av3n) == '') then
00486               fname = trim(av3n)
00487            else
00488               fname = trim(av3n)//'_'
00489            endif
00490         endif
00491         nf = mct_aVect_nRattr(av3)
00492         do n = 1,nf
00493            call mct_aVect_getRList(mstring,n,av3)
00494            vname = trim(fname)//trim(mct_string_toChar(mstring))
00495            call mct_string_clean(mstring)
00496            if (loop == 11) call shr_pcdf_readr1d(fid,trim(vname),iodescd,av3%rAttr(n,:))
00497            if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_DOUBLE,dimid1)
00498            if (loop == 22) call shr_pcdf_writer1d(fid,trim(vname),iodescd,av3%rAttr(n,:))
00499         enddo
00500         nf = mct_aVect_nIattr(av3)
00501         do n = 1,nf
00502            call mct_aVect_getIList(mstring,n,av3)
00503            vname = trim(fname)//trim(mct_string_toChar(mstring))
00504            call mct_string_clean(mstring)
00505            if (loop == 11) call shr_pcdf_readi1d(fid,trim(vname),iodesci,av3%iAttr(n,:))
00506            if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_INT,dimid1)
00507            if (loop == 22) call shr_pcdf_writei1d(fid,trim(vname),iodesci,av3%iAttr(n,:))
00508         enddo
00509      endif
00510 
00511      if (present(av4)) then
00512         fname = 'av4_'
00513         if (present(av4n)) then
00514            if (trim(av4n) == '') then
00515               fname = trim(av4n)
00516            else
00517               fname = trim(av4n)//'_'
00518            endif
00519         endif
00520         nf = mct_aVect_nRattr(av4)
00521         do n = 1,nf
00522            call mct_aVect_getRList(mstring,n,av4)
00523            vname = trim(fname)//trim(mct_string_toChar(mstring))
00524            call mct_string_clean(mstring)
00525            if (loop == 11) call shr_pcdf_readr1d(fid,trim(vname),iodescd,av4%rAttr(n,:))
00526            if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_DOUBLE,dimid1)
00527            if (loop == 22) call shr_pcdf_writer1d(fid,trim(vname),iodescd,av4%rAttr(n,:))
00528         enddo
00529         nf = mct_aVect_nIattr(av4)
00530         do n = 1,nf
00531            call mct_aVect_getIList(mstring,n,av4)
00532            vname = trim(fname)//trim(mct_string_toChar(mstring))
00533            call mct_string_clean(mstring)
00534            if (loop == 11) call shr_pcdf_readi1d(fid,trim(vname),iodesci,av4%iAttr(n,:))
00535            if (loop == 21) call shr_pcdf_defvar1d(fid,trim(vname),PIO_INT,dimid1)
00536            if (loop == 22) call shr_pcdf_writei1d(fid,trim(vname),iodesci,av4%iAttr(n,:))
00537         enddo
00538      endif
00539 
00540      if (loop == 21) rcode = pio_enddef(fid)
00541   enddo
00542 
00543   call pio_freedecomp(fid,iodesci)
00544   call pio_freedecomp(fid,iodescd)
00545   call pio_closefile(fid)
00546   call pio_finalize(iosystem,rcode)
00547 
00548 end subroutine shr_pcdf_readwrite
00549 
00550 !===============================================================================
00551 !===============================================================================
00552 subroutine shr_pcdf_defvar0d(fid,fname,vtype)
00553 
00554   implicit none
00555 
00556   type(file_desc_t),intent(in) :: fid
00557   character(len=*) ,intent(in) :: fname
00558   integer(IN)      ,intent(in) :: vtype
00559 
00560   !--- local ---
00561   type(var_desc_t) :: varid
00562   integer(IN)      :: rcode
00563   character(len=*),parameter :: subname = '(shr_pcdf_defvar0d) '
00564 
00565   !-------------
00566 
00567   rcode = pio_def_var(fid,trim(fname),vtype,varid)
00568 
00569 end subroutine shr_pcdf_defvar0d
00570 
00571 !===============================================================================
00572 subroutine shr_pcdf_defvar1d(fid,fname,vtype,dimid)
00573 
00574   implicit none
00575 
00576   type(file_desc_t),intent(in) :: fid
00577   character(len=*) ,intent(in) :: fname
00578   integer(IN)      ,intent(in) :: vtype
00579   integer(IN)      ,intent(in) :: dimid(:)
00580 
00581   !--- local ---
00582   type(var_desc_t) :: varid
00583   integer(IN)      :: rcode
00584   character(len=*),parameter :: subname = '(shr_pcdf_defvar1d) '
00585 
00586   !-------------
00587 
00588   rcode = pio_def_var(fid,trim(fname),vtype,dimid,varid)
00589 
00590 end subroutine shr_pcdf_defvar1d
00591 
00592 !===============================================================================
00593 subroutine shr_pcdf_readr1d(fid,fname,iodesc,r1d)
00594 
00595   implicit none
00596 
00597   type(file_desc_t),intent(inout) :: fid
00598   character(len=*) ,intent(in)    :: fname
00599   type(io_desc_t)  ,intent(inout) :: iodesc
00600   real(R8)         ,intent(inout) :: r1d(:)
00601 
00602   !--- local ---
00603   type(var_desc_t) :: varid
00604   integer(IN)      :: dimid(4),ndims
00605   integer(IN)      :: vsize,fsize
00606   integer(IN)      :: rcode
00607   character(len=*),parameter :: subname = '(shr_pcdf_readr1d) '
00608 
00609   !-------------
00610 
00611   rcode = pio_inq_varid(fid,trim(fname),varid)
00612 
00613 !--tcraig, here vsize is global, fsize is local, what check if any?
00614 !  rcode = pio_inq_varndims(fid, varid, ndims)
00615 !  rcode = pio_inq_vardimid(fid, varid, dimid(1:ndims))
00616 !  rcode = pio_inq_dimlen(fid, dimid(1), vsize)
00617 !  fsize = size(r1d)
00618 !  if (vsize /= fsize) then
00619 !     write(shr_log_unit,*) subname,' ERROR: vsize,fsize = ',vsize,fsize
00620 !     call shr_sys_abort(trim(subname)//' ERROR: vsize,fsize')
00621 !  endif
00622 
00623   call pio_read_darray(fid,varid,iodesc,r1d,rcode)
00624 
00625 end subroutine shr_pcdf_readr1d
00626 
00627 !===============================================================================
00628 subroutine shr_pcdf_writer1d(fid,fname,iodesc,r1d)
00629 
00630   implicit none
00631 
00632   type(file_desc_t),intent(inout) :: fid
00633   character(len=*) ,intent(in)    :: fname
00634   type(io_desc_t)  ,intent(inout) :: iodesc
00635   real(R8)         ,intent(inout) :: r1d(:)
00636 
00637   !--- local ---
00638   type(var_desc_t) :: varid
00639   integer(IN)      :: dimid(4)
00640   integer(IN)      :: vsize,fsize
00641   real(R8)         :: lfillvalue
00642   integer(IN)      :: rcode
00643   character(len=*),parameter :: subname = '(shr_pcdf_writer1d) '
00644 
00645   !-------------
00646 
00647   lfillvalue = fillvalue
00648 
00649   rcode = pio_inq_varid(fid,trim(fname),varid)
00650   call pio_write_darray(fid, varid, iodesc, r1d, rcode, fillval=lfillvalue)
00651 
00652 end subroutine shr_pcdf_writer1d
00653 !===============================================================================
00654 !===============================================================================
00655 subroutine shr_pcdf_readi1d(fid,fname,iodesc,i1d)
00656 
00657   implicit none
00658 
00659   type(file_desc_t),intent(inout) :: fid
00660   character(len=*) ,intent(in)    :: fname
00661   type(io_desc_t)  ,intent(inout) :: iodesc
00662   integer(IN)      ,intent(inout) :: i1d(:)
00663 
00664   !--- local ---
00665   type(var_desc_t) :: varid
00666   integer(IN)      :: dimid(4),ndims
00667   integer(IN)      :: vsize,fsize
00668   integer(IN)      :: rcode
00669   character(len=*),parameter :: subname = '(shr_pcdf_readi1d) '
00670 
00671   !-------------
00672 
00673   rcode = pio_inq_varid(fid,trim(fname),varid)
00674 
00675 !--tcraig, here vsize is global, fsize is local, what check if any?
00676 !  rcode = pio_inq_varndims(fid, varid, ndims)
00677 !  rcode = pio_inq_vardimid(fid, varid, dimid(1:ndims))
00678 !  rcode = pio_inq_dimlen(fid, dimid(1), vsize)
00679 !  fsize = size(i1d)
00680 !  if (vsize /= fsize) then
00681 !     write(shr_log_unit,*) subname,' ERROR: vsize,fsize = ',vsize,fsize
00682 !     call shr_sys_abort(trim(subname)//' ERROR: vsize,fsize')
00683 !  endif
00684 
00685   call pio_read_darray(fid,varid,iodesc,i1d,rcode)
00686 
00687 end subroutine shr_pcdf_readi1d
00688 
00689 !===============================================================================
00690 subroutine shr_pcdf_writei1d(fid,fname,iodesc,i1d)
00691 
00692   implicit none
00693 
00694   type(file_desc_t),intent(inout) :: fid
00695   character(len=*) ,intent(in)    :: fname
00696   type(io_desc_t)  ,intent(inout) :: iodesc
00697   integer(IN)      ,intent(inout) :: i1d(:)
00698 
00699   !--- local ---
00700   type(var_desc_t) :: varid
00701   integer(IN)      :: dimid(4)
00702   integer(IN)      :: vsize,fsize
00703   integer(IN)      :: lfillvalue
00704   integer(IN)      :: rcode
00705   character(len=*),parameter :: subname = '(shr_pcdf_writei1d) '
00706 
00707   !-------------
00708 
00709   lfillvalue = ifillvalue
00710 
00711   rcode = pio_inq_varid(fid,trim(fname),varid)
00712   call pio_write_darray(fid, varid, iodesc, i1d, rcode, fillval=lfillvalue)
00713 
00714 end subroutine shr_pcdf_writei1d
00715 !===============================================================================
00716 !===============================================================================
00717 subroutine shr_pcdf_readr0d(fid,fname,r0d)
00718 
00719   implicit none
00720 
00721   type(file_desc_t),intent(inout) :: fid
00722   character(len=*) ,intent(in)    :: fname
00723   real(R8)         ,intent(inout) :: r0d
00724 
00725   !--- local ---
00726   type(var_desc_t) :: varid
00727   integer(IN)      :: rcode
00728   character(len=*),parameter :: subname = '(shr_pcdf_readr0d) '
00729 
00730   !-------------
00731 
00732   rcode = pio_inq_varid(fid,trim(fname),varid)
00733   rcode = pio_get_var(fid,varid,r0d)
00734 
00735 end subroutine shr_pcdf_readr0d
00736 
00737 !===============================================================================
00738 subroutine shr_pcdf_writer0d(fid,fname,r0d)
00739 
00740   implicit none
00741 
00742   type(file_desc_t),intent(inout) :: fid
00743   character(len=*) ,intent(in)    :: fname
00744   real(R8)         ,intent(inout) :: r0d
00745 
00746   !--- local ---
00747   type(var_desc_t) :: varid
00748   integer(IN)      :: rcode
00749   character(len=*),parameter :: subname = '(shr_pcdf_writer0d) '
00750 
00751   !-------------
00752 
00753   rcode = pio_inq_varid(fid,trim(fname),varid)
00754   rcode = pio_put_var(fid, varid, r0d)
00755 
00756 end subroutine shr_pcdf_writer0d
00757 !===============================================================================
00758 !===============================================================================
00759 subroutine shr_pcdf_readi0d(fid,fname,i0d)
00760 
00761   implicit none
00762 
00763   type(file_desc_t),intent(inout) :: fid
00764   character(len=*) ,intent(in)    :: fname
00765   integer(IN)      ,intent(inout) :: i0d
00766 
00767   !--- local ---
00768   type(var_desc_t) :: varid
00769   integer(IN)      :: rcode
00770   character(len=*),parameter :: subname = '(shr_pcdf_readi0d) '
00771 
00772   !-------------
00773 
00774   rcode = pio_inq_varid(fid,trim(fname),varid)
00775   rcode = pio_get_var(fid,varid,i0d)
00776 
00777 end subroutine shr_pcdf_readi0d
00778 
00779 !===============================================================================
00780 subroutine shr_pcdf_writei0d(fid,fname,i0d)
00781 
00782   implicit none
00783 
00784   type(file_desc_t),intent(inout) :: fid
00785   character(len=*) ,intent(in)    :: fname
00786   integer(IN)      ,intent(inout) :: i0d
00787 
00788   !--- local ---
00789   type(var_desc_t) :: varid
00790   integer(IN)      :: rcode
00791   character(len=*),parameter :: subname = '(shr_pcdf_writei0d) '
00792 
00793   !-------------
00794 
00795   rcode = pio_inq_varid(fid,trim(fname),varid)
00796   rcode = pio_put_var(fid, varid, i0d)
00797 
00798 end subroutine shr_pcdf_writei0d
00799 !===============================================================================
00800 !===============================================================================
00801 subroutine shr_pcdf_readdim(fid,fname,dim)
00802 
00803   implicit none
00804 
00805   type(file_desc_t),intent(inout) :: fid
00806   character(len=*) ,intent(in)    :: fname
00807   integer(IN)      ,intent(inout) :: dim
00808 
00809   !--- local ---
00810   integer(IN)      :: dimid
00811   integer(IN)      :: rcode
00812   character(len=*),parameter :: subname = '(shr_pcdf_readdim) '
00813 
00814   !-------------
00815 
00816   rcode = pio_inq_dimid(fid,trim(fname),dimid)
00817   rcode = pio_inq_dimlen(fid,dimid,dim)
00818 
00819 end subroutine shr_pcdf_readdim
00820 
00821 !===============================================================================
00822 subroutine shr_pcdf_writedim(fid,fname,dim)
00823 
00824   implicit none
00825 
00826   type(file_desc_t),intent(inout) :: fid
00827   character(len=*) ,intent(in)    :: fname
00828   integer(IN)      ,intent(inout) :: dim
00829 
00830   !--- local ---
00831   integer(IN)      :: dimid
00832   integer(IN)      :: rcode
00833   character(len=*),parameter :: subname = '(shr_pcdf_writedim) '
00834 
00835   !-------------
00836 
00837   rcode = pio_def_dim(fid,trim(fname),dim,dimid)
00838 
00839 end subroutine shr_pcdf_writedim
00840 !===============================================================================
00841 !===============================================================================
00842 !===============================================================================
00843 
00844 end module shr_pcdf_mod