CESM_Driver: seq_io_mod.F90 Source File

00001 !===============================================================================
00002 ! SVN $Id: seq_io_mod.F90 23596 2010-06-07 19:36:18Z tcraig $
00003 ! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/drv/seq_mct/branch_tags/cesm1_0_rel_tags/cesm1_0_rel01_drvseq3_1_32/driver/seq_io_mod.F90 $
00004 !===============================================================================
00005 !BOP ===========================================================================
00006 !
00007 ! !MODULE: seq_io_mod -- reads and writes driver files
00008 !
00009 ! !DESCRIPTION:
00010 !    Writes attribute vectors to netcdf
00011 !
00012 ! !REMARKS:
00013 !
00014 ! !REVISION HISTORY:
00015 !    2007-Oct-26 - T. Craig first version
00016 !    2007-Dec-06 - T. Craig update and improve
00017 !    2008-Feb-16 - J. Edwards convert to PIO
00018 !
00019 ! !INTERFACE: ------------------------------------------------------------------
00020 
00021 module seq_io_mod
00022 
00023   ! !USES:
00024 
00025   use shr_kind_mod, only: r8 => shr_kind_r8, in => shr_kind_in
00026   use shr_kind_mod, only: cl => shr_kind_cl, cs => shr_kind_cs
00027   use shr_sys_mod       ! system calls
00028   use seq_cdata_mod     ! cdata
00029   use seq_comm_mct, only : logunit, seq_comm_setptrs, CPLID
00030   use seq_flds_mod, only : seq_flds_lookup
00031   use mct_mod           ! mct wrappers
00032   use pio
00033 
00034   implicit none
00035   private
00036 
00037 ! !PUBLIC TYPES:
00038 
00039   ! none
00040 
00041 ! !PUBLIC MEMBER FUNCTIONS:
00042 
00043   public seq_io_init
00044   public seq_io_wopen
00045   public seq_io_close
00046   public seq_io_redef
00047   public seq_io_enddef
00048   public seq_io_date2yyyymmdd
00049   public seq_io_sec2hms
00050   public seq_io_read
00051   public seq_io_write
00052 
00053 ! !PUBLIC DATA MEMBERS
00054 
00055   ! none
00056 
00057 !EOP
00058 
00059   interface seq_io_read
00060      module procedure seq_io_read_av
00061      module procedure seq_io_read_int
00062      module procedure seq_io_read_int1d
00063      module procedure seq_io_read_r8
00064      module procedure seq_io_read_r81d
00065   end interface
00066   interface seq_io_write
00067      module procedure seq_io_write_av
00068      module procedure seq_io_write_int
00069      module procedure seq_io_write_int1d
00070      module procedure seq_io_write_r8
00071      module procedure seq_io_write_r81d
00072      module procedure seq_io_write_time
00073   end interface
00074 
00075 !-------------------------------------------------------------------------------
00076 ! Local data
00077 !-------------------------------------------------------------------------------
00078 
00079    character(*),parameter :: prefix = "seq_io_"
00080    character(CL)          :: wfilename = ''
00081    real(r8)    ,parameter :: fillvalue = SHR_CONST_SPVAL
00082 
00083    character(*),parameter :: modName = "(seq_io_mod) "
00084    integer(in) ,parameter :: debug = 0 ! internal debug level
00085 
00086    integer(IN)          ,save :: cpl_io_type
00087    type(file_desc_t)    ,save :: cpl_io_file
00088    type(iosystem_desc_t),save :: cpl_io_subsystem
00089 
00090    character(*),parameter :: version ='cpl7v10'
00091    character(*),parameter :: version0='cpl7v00'
00092 
00093 !=================================================================================
00094 contains
00095 !=================================================================================
00096 
00097 !=================================================================================
00098 !BOP =============================================================================
00099 !
00100 ! !IROUTINE: seq_io_init - initialize io for coupler
00101 !
00102 ! !DESCRIPTION:
00103 !    Read the pio_inparm namelist and initialize the pio subsystem
00104 !
00105 ! !REVISION HISTORY:
00106 !    2009-Sep-30 - B. Kauffman - consolidation, clean up
00107 !    2009-Feb-17 - J. Edwards - initial version
00108 !
00109 ! !INTERFACE: --------------------------------------------------------------------
00110 
00111 subroutine seq_io_init(nlfilename)
00112 
00113    use shr_string_mod, only : shr_string_toupper
00114    use shr_file_mod,   only : shr_file_getunit, shr_file_freeunit
00115    use shr_mpi_mod,    only : shr_mpi_bcast
00116    use pio, only : pio_iotype_netcdf, pio_iotype_pnetcdf, pio_iotype_netcdf4c, pio_iotype_netcdf4p
00117 
00118    implicit none
00119 
00120 ! !INPUT/OUTPUT PARAMETERS:
00121 
00122    character(*), intent(in) :: nlfilename
00123 
00124 ! LOCAL
00125 
00126    integer(IN)   :: iam, mpicom, npes, ierr, unitn
00127    logical       :: iamroot
00128    character(CS) :: cpl_io_typename
00129    integer(IN)   :: cpl_io_stride
00130    integer(IN)   :: cpl_io_numtasks
00131    integer(IN)   :: cpl_io_root
00132    integer(IN),parameter :: cpl_io_root_default = 0
00133 
00134    namelist /pio_inparm/ cpl_io_stride, cpl_io_root, cpl_io_numtasks, cpl_io_typename
00135 
00136    character(*),parameter :: subName =   '(seq_io_init) '
00137    character(*),parameter :: F00     = "('(seq_io_init) ',4a)"
00138    character(*),parameter :: F01     = "('(seq_io_init) ',a,i6)"
00139 
00140 !-------------------------------------------------------------------------------
00141 !
00142 !-------------------------------------------------------------------------------
00143 
00144     call seq_comm_setptrs(CPLID, iam=iam, mpicom=mpicom,npes=npes, iamroot=iamroot)
00145 
00146     !--------------------------------------------------------------------------
00147     ! read io nml parameters 
00148     !--------------------------------------------------------------------------
00149     cpl_io_stride   = -1 ! set based on cpl_io_numtasks value when initialized < 0
00150     cpl_io_numtasks = -1 ! set based on cpl_io_stride   value when initialized < 0
00151     cpl_io_root     =  cpl_io_root_default
00152     cpl_io_typename = 'netcdf'
00153 
00154     if (iamroot) then
00155        if (debug > 0) then
00156           write(logunit,F00) 'pio init parameters: before nml read'
00157           write(logunit,F01) '   cpl_io_stride   = ',cpl_io_stride
00158           write(logunit,F01) '   cpl_io_root     = ',cpl_io_root
00159           write(logunit,F00) '   cpl_io_typename = ',cpl_io_typename
00160           write(logunit,F01) '   cpl_io_numtasks = ',cpl_io_numtasks
00161        end if
00162 
00163        unitn=shr_file_getunit()
00164        open( unitn, file=trim(nlfilename), status='old' )
00165        ierr = 1
00166        do while( ierr /= 0 )
00167           read(unitn,nml=pio_inparm,iostat=ierr)
00168           if (ierr < 0) then
00169              call shr_sys_abort( subname//':: namelist read returns an'// &
00170                                  ' end of file or end of record condition' )
00171           end if
00172        end do
00173        close(unitn)
00174        call shr_file_freeUnit( unitn )
00175 
00176        if (debug > 0) then
00177           write(logunit,F00) 'pio init parameters: after nml read'
00178           write(logunit,F01) '   cpl_io_stride   = ',cpl_io_stride
00179           write(logunit,F01) '   cpl_io_root     = ',cpl_io_root
00180           write(logunit,F00) '   cpl_io_typename = ',cpl_io_typename
00181           write(logunit,F01) '   cpl_io_numtasks = ',cpl_io_numtasks
00182        end if
00183 
00184        if      ( shr_string_toupper(cpl_io_typename) .eq. 'NETCDF' ) then
00185           cpl_io_type = pio_iotype_netcdf
00186        else if ( shr_string_toupper(cpl_io_typename) .eq. 'PNETCDF') then
00187           cpl_io_type = pio_iotype_pnetcdf
00188        else if ( shr_string_toupper(cpl_io_typename) .eq. 'NETCDF4P') then
00189           cpl_io_type = pio_iotype_netcdf4p
00190        else if ( shr_string_toupper(cpl_io_typename) .eq. 'NETCDF4C') then
00191           cpl_io_type = pio_iotype_netcdf4c
00192        else
00193           write(logunit,*) subName,'Bad io_type argument - using iotype_netcdf'
00194           cpl_io_type=pio_iotype_netcdf
00195        end if
00196     end if
00197     call shr_mpi_bcast(cpl_io_type , mpicom)
00198     call shr_mpi_bcast(cpl_io_stride  , mpicom)
00199     call shr_mpi_bcast(cpl_io_root    , mpicom)
00200     call shr_mpi_bcast(cpl_io_numtasks, mpicom)
00201 
00202     !--------------------------------------------------------------------------
00203     ! check/set/correct io pio parameters
00204     !--------------------------------------------------------------------------
00205 
00206 
00207     if (cpl_io_stride>0.and.cpl_io_numtasks<0) then
00208        cpl_io_numtasks = npes/cpl_io_stride
00209     else if(cpl_io_numtasks>0 .and. cpl_io_stride<0) then
00210        cpl_io_stride = npes/cpl_io_numtasks
00211     else if(cpl_io_numtasks<0 .and. cpl_io_stride<0) then
00212        cpl_io_stride = 4
00213        cpl_io_numtasks = npes/cpl_io_stride
00214        cpl_io_numtasks = max(1, cpl_io_numtasks)
00215     end if
00216 
00217     if (cpl_io_root<0) then
00218        cpl_io_root = cpl_io_root_default
00219     endif
00220     cpl_io_root = min(cpl_io_root,npes-1)
00221 
00222     if (cpl_io_root + (cpl_io_stride)*(cpl_io_numtasks-1) >= npes .or. &
00223        cpl_io_stride<=0 .or. cpl_io_numtasks<=0 .or. cpl_io_root < 0 .or. &
00224        cpl_io_root > npes-1) then
00225        write(logunit,*) subName,'cpl_io_stride, iotasks or root out of bounds - resetting to defaults ', &
00226                 cpl_io_stride, cpl_io_numtasks, cpl_io_root
00227        cpl_io_stride = max(1,npes/4)
00228        cpl_io_numtasks = npes/cpl_io_stride
00229        cpl_io_root = min(1,npes-1)
00230     end if
00231 
00232     !--------------------------------------------------------------------------
00233     ! init pio library
00234     !--------------------------------------------------------------------------
00235     if (iamroot) then
00236        write(logunit,F00) 'pio init parameters: '
00237        write(logunit,F01) '   cpl_io_stride   = ',cpl_io_stride
00238        write(logunit,F01) '   cpl_io_root     = ',cpl_io_root
00239        write(logunit,F00) '   cpl_io_typename = ',cpl_io_typename
00240        write(logunit,F01) '   cpl_io_numtasks = ',cpl_io_numtasks
00241     end if
00242 
00243 !   call pio_init(iam, mpicom, cpl_io_numtasks, cpl_io_root, cpl_io_stride, PIO_REARR_BOX, cpl_io_subsystem)
00244     call pio_init(iam, mpicom, cpl_io_numtasks, 0, cpl_io_stride, PIO_REARR_BOX, &
00245                   cpl_io_subsystem, base=cpl_io_root)
00246     
00247     cpl_io_file%fh=-1
00248 
00249   end subroutine seq_io_init
00250 
00251 !===============================================================================
00252 !BOP ===========================================================================
00253 !
00254 ! !IROUTINE: seq_io_wopen - open netcdf file
00255 !
00256 ! !DESCRIPTION:
00257 !    open netcdf file
00258 !
00259 ! !REVISION HISTORY:
00260 !    2007-Oct-26 - T. Craig - initial version
00261 !
00262 ! !INTERFACE: ------------------------------------------------------------------
00263 
00264 subroutine seq_io_wopen(filename,cdata,clobber,cdf64)
00265 
00266     ! !INPUT/OUTPUT PARAMETERS:
00267     implicit none
00268     character(*),intent(in) :: filename
00269     type(seq_cdata),intent(in) :: cdata
00270     logical,optional,intent(in):: clobber
00271     logical,optional,intent(in):: cdf64
00272 
00273     !EOP
00274 
00275     logical :: exists
00276     logical :: lclobber
00277     logical :: lcdf64
00278     integer :: iam
00279     integer :: rcode
00280     integer :: nmode
00281     character(CL)  :: lversion
00282     character(*),parameter :: subName = '(seq_io_wopen) '
00283     
00284 !-------------------------------------------------------------------------------
00285 !
00286 !-------------------------------------------------------------------------------
00287 
00288     lversion=trim(version0)
00289 
00290     lclobber = .false.
00291     if (present(clobber)) lclobber=clobber
00292 
00293     lcdf64 = .false.
00294     if (present(cdf64)) lcdf64=cdf64
00295 
00296     call seq_comm_setptrs(CPLID,iam=iam)
00297 
00298     if (cpl_io_file%fh<0) then
00299        ! filename not open
00300        inquire(file=trim(filename),exist=exists)
00301        if (exists) then
00302           if (lclobber) then
00303              nmode = pio_clobber
00304              if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
00305              rcode = pio_createfile(cpl_io_subsystem, cpl_io_file, cpl_io_type, trim(filename), nmode)
00306              if(iam==0) write(logunit,*) subname,' create file ',trim(filename)
00307              rcode = pio_put_att(cpl_io_file,pio_global,"file_version",version)
00308           else
00309              rcode = pio_openfile(cpl_io_subsystem, cpl_io_file, cpl_io_type, trim(filename), pio_write)
00310              if(iam==0) write(logunit,*) subname,' open file ',trim(filename)
00311              call pio_seterrorhandling(cpl_io_file,PIO_BCAST_ERROR)
00312              rcode = pio_get_att(cpl_io_file,pio_global,"file_version",lversion)
00313              call pio_seterrorhandling(cpl_io_file,PIO_INTERNAL_ERROR)
00314              if (trim(lversion) /= trim(version)) then
00315                 rcode = pio_redef(cpl_io_file)
00316                 rcode = pio_put_att(cpl_io_file,pio_global,"file_version",version)
00317                 rcode = pio_enddef(cpl_io_file)
00318              endif
00319           endif
00320        else
00321           nmode = pio_noclobber
00322           if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
00323           rcode = pio_createfile(cpl_io_subsystem, cpl_io_file, cpl_io_type, trim(filename), nmode)
00324           if(iam==0) write(logunit,*) subname,' create file ',trim(filename)
00325           rcode = pio_put_att(cpl_io_file,pio_global,"file_version",version)
00326        endif
00327     elseif (trim(wfilename) /= trim(filename)) then
00328        ! filename is open, better match open filename
00329        if(iam==0) write(logunit,*) subname,' different file currently open ',trim(filename)
00330        call shr_sys_abort()
00331     else
00332        ! filename is already open, just return
00333     endif
00334 
00335 end subroutine seq_io_wopen
00336 
00337 !===============================================================================
00338 !BOP ===========================================================================
00339 !
00340 ! !IROUTINE: seq_io_close - close netcdf file
00341 !
00342 ! !DESCRIPTION:
00343 !    close netcdf file
00344 !
00345 ! !REVISION HISTORY:
00346 !    2007-Oct-26 - T. Craig - initial version
00347 !
00348 ! !INTERFACE: ------------------------------------------------------------------
00349 
00350 subroutine seq_io_close(filename,cdata)
00351 
00352     use pio, only : pio_closefile
00353 
00354     implicit none
00355 
00356     ! !INPUT/OUTPUT PARAMETERS:
00357     character(*),intent(in) :: filename
00358     type(seq_cdata),intent(in) :: cdata
00359 
00360     !EOP
00361 
00362     integer :: iam
00363     integer :: rcode
00364     character(*),parameter :: subName = '(seq_io_close) '
00365 
00366 !-------------------------------------------------------------------------------
00367 !
00368 !-------------------------------------------------------------------------------
00369 
00370     call seq_comm_setptrs(CPLID,iam=iam)
00371 
00372 
00373     if (cpl_io_file%fh<0) then
00374        ! filename not open, just return
00375     elseif (trim(wfilename) /= trim(filename)) then
00376        ! filename matches, close it
00377        call pio_closefile(cpl_io_file)
00378        cpl_io_file%fh=-1
00379     else
00380        ! different filename is open, abort
00381        if(iam==0) write(logunit,*) subname,' different file currently open ',trim(filename)
00382        call shr_sys_abort()
00383     endif
00384 
00385     wfilename = ''
00386 
00387 end subroutine seq_io_close
00388 
00389 !===============================================================================
00390 
00391 subroutine seq_io_redef(filename)
00392     character(len=*), intent(in) :: filename
00393     integer :: rcode
00394 
00395     rcode = pio_redef(cpl_io_file)
00396 end subroutine seq_io_redef
00397 
00398 !===============================================================================
00399 
00400 subroutine seq_io_enddef(filename)
00401     character(len=*), intent(in) :: filename
00402     integer :: rcode
00403 
00404     rcode = pio_enddef(cpl_io_file)
00405 end subroutine seq_io_enddef
00406 
00407 !===============================================================================
00408 
00409 character(len=10) function seq_io_date2yyyymmdd (date)
00410 
00411 ! Input arguments
00412 
00413    integer, intent(in) :: date
00414 
00415 ! Local workspace
00416 
00417    integer :: year    ! year of yyyy-mm-dd
00418    integer :: month   ! month of yyyy-mm-dd
00419    integer :: day     ! day of yyyy-mm-dd
00420 
00421 !-------------------------------------------------------------------------------
00422 
00423    if (date < 0) then
00424       call shr_sys_abort ('seq_io_date2yyyymmdd: negative date not allowed')
00425    end if
00426 
00427    year  = date / 10000
00428    month = (date - year*10000) / 100
00429    day   = date - year*10000 - month*100
00430 
00431    write(seq_io_date2yyyymmdd,80) year, month, day
00432 80 format(i4.4,'-',i2.2,'-',i2.2)
00433 
00434 end function seq_io_date2yyyymmdd
00435 
00436 !===============================================================================
00437 
00438 character(len=8) function seq_io_sec2hms (seconds)
00439 
00440 ! Input arguments
00441 
00442    integer, intent(in) :: seconds
00443 
00444 ! Local workspace
00445 
00446    integer :: hours     ! hours of hh:mm:ss
00447    integer :: minutes   ! minutes of hh:mm:ss
00448    integer :: secs      ! seconds of hh:mm:ss
00449 
00450 !-------------------------------------------------------------------------------
00451 
00452    if (seconds < 0 .or. seconds > 86400) then
00453       write(logunit,*)'seq_io_sec2hms: bad input seconds:', seconds
00454       call shr_sys_abort()
00455    end if
00456 
00457    hours   = seconds / 3600
00458    minutes = (seconds - hours*3600) / 60
00459    secs    = (seconds - hours*3600 - minutes*60)
00460 
00461    if (minutes < 0 .or. minutes > 60) then
00462       write(logunit,*)'seq_io_sec2hms: bad minutes = ',minutes
00463       call shr_sys_abort()
00464    end if
00465 
00466    if (secs < 0 .or. secs > 60) then
00467       write(logunit,*)'seq_io_sec2hms: bad secs = ',secs
00468       call shr_sys_abort()
00469    end if
00470 
00471    write(seq_io_sec2hms,80) hours, minutes, secs
00472 80 format(i2.2,':',i2.2,':',i2.2)
00473 
00474 end function seq_io_sec2hms
00475 
00476   !===============================================================================
00477   !BOP ===========================================================================
00478   !
00479   ! !IROUTINE: seq_io_write_av - write AV to netcdf file
00480   !
00481   ! !DESCRIPTION:
00482   !    Write AV to netcdf file
00483   !
00484   ! !REVISION HISTORY:
00485   !    2007-Oct-26 - T. Craig - initial version
00486   !
00487   ! !INTERFACE: ------------------------------------------------------------------
00488 
00489   subroutine seq_io_write_av(filename,cdata,AV,dname,whead,wdata,nx,ny,nt,fillval,pre,tavg,&
00490                              use_float)
00491 
00492     ! !INPUT/OUTPUT PARAMETERS:
00493     implicit none
00494     character(len=*),intent(in) :: filename ! file
00495     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
00496     type(mct_aVect) ,intent(in) :: AV       ! data to be written
00497     character(len=*),intent(in) :: dname    ! name of data
00498     logical,optional,intent(in) :: whead    ! write header
00499     logical,optional,intent(in) :: wdata    ! write data
00500     integer(in),optional,intent(in) :: nx   ! 2d grid size if available
00501     integer(in),optional,intent(in) :: ny   ! 2d grid size if available
00502     integer(in),optional,intent(in) :: nt   ! time sample
00503     real(r8),optional,intent(in) :: fillval ! fill value
00504     character(len=*),optional,intent(in) :: pre      ! prefix to variable name
00505     logical,optional,intent(in) :: tavg     ! is this a tavg
00506     logical,optional,intent(in) :: use_float ! write output as float rather than double
00507 
00508     !EOP
00509 
00510     integer(in) :: rcode
00511     integer(in) :: mpicom
00512     integer(in) :: iam
00513     integer(in) :: nf,ns,ng
00514     integer(in) :: i,j,k,n
00515     integer(in),target  :: dimid2(2)
00516     integer(in),target  :: dimid3(3)
00517     integer(in),pointer :: dimid(:)
00518     type(var_desc_t) :: varid
00519     type(io_desc_t) :: iodesc
00520     integer(kind=PIO_OffSet) :: frame
00521     type(mct_string) :: mstring     ! mct char type
00522     character(CL)    :: itemc       ! string converted to char
00523     character(CL)    :: name1       ! var name
00524     character(CL)    :: cunit       ! var units
00525     character(CL)    :: lname       ! long name
00526     character(CL)    :: sname       ! standard name
00527     character(CL)    :: lpre        ! local prefix
00528     logical :: exists
00529     logical :: lwhead, lwdata
00530     integer(in) :: lnx,lny
00531     real(r8) :: lfillvalue
00532     type(mct_gsMap),pointer :: gsmap
00533     type(mct_aVect) :: AVroot
00534     real(r8),pointer :: fld1(:,:)  ! needed to convert AVroot ng rAttr to 2d nx,ny
00535     character(*),parameter :: subName = '(seq_io_write_av) '
00536 
00537     integer :: lbnum
00538     integer, pointer :: Dof(:)
00539 
00540     !-------------------------------------------------------------------------------
00541     !
00542     !-------------------------------------------------------------------------------
00543 
00544     lfillvalue = fillvalue
00545     if (present(fillval)) then
00546        lfillvalue = fillval
00547     endif
00548 
00549     lpre = trim(dname)
00550     if (present(pre)) then
00551        lpre = trim(pre)
00552     endif
00553 
00554     lwhead = .true.
00555     lwdata = .true.
00556     if (present(whead)) lwhead = whead
00557     if (present(wdata)) lwdata = wdata
00558 
00559     if (.not.lwhead .and. .not.lwdata) then
00560        ! should we write a warning?
00561        return
00562     endif
00563 
00564     call seq_cdata_setptrs(cdata,gsmap=gsmap)
00565     call seq_comm_setptrs(CPLID,iam=iam)        
00566 
00567     ng = mct_gsmap_gsize(gsmap)
00568     lnx = ng
00569     lny = 1
00570         
00571     nf = mct_aVect_nRattr(AV)
00572     if (nf < 1) then
00573        write(logunit,*) subname,' ERROR: nf = ',nf,trim(dname)
00574        call shr_sys_abort()
00575     endif
00576 
00577     if (present(nx)) then
00578        if (nx /= 0) lnx = nx
00579     endif
00580     if (present(ny)) then
00581        if (ny /= 0) lny = ny
00582     endif
00583     if (lnx*lny /= ng) then
00584        if(iam==0) write(logunit,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny,trim(dname)
00585        call shr_sys_abort()
00586     endif
00587 
00588     if (lwhead) then
00589        rcode = pio_def_dim(cpl_io_file,trim(lpre)//'_nx',lnx,dimid2(1))
00590        rcode = pio_def_dim(cpl_io_file,trim(lpre)//'_ny',lny,dimid2(2))
00591 
00592        if (present(nt)) then
00593           dimid3(1:2) = dimid2
00594           rcode = pio_inq_dimid(cpl_io_file,'time',dimid3(3))
00595           dimid => dimid3
00596        else
00597           dimid => dimid2
00598        endif
00599 
00600        do k = 1,nf
00601           call mct_aVect_getRList(mstring,k,AV)
00602           itemc = mct_string_toChar(mstring)
00603           call mct_string_clean(mstring)
00604 ! "v0"    name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
00605           name1 = trim(lpre)//'_'//trim(itemc)
00606           call seq_flds_lookup(itemc,longname=lname,stdname=sname,units=cunit)
00607           if (present(use_float)) then 
00608              rcode = pio_def_var(cpl_io_file,trim(name1),PIO_REAL,dimid,varid)
00609           else
00610              rcode = pio_def_var(cpl_io_file,trim(name1),PIO_DOUBLE,dimid,varid)
00611           end if
00612           rcode = pio_put_att(cpl_io_file,varid,"_FillValue",lfillvalue)
00613           rcode = pio_put_att(cpl_io_file,varid,"units",trim(cunit))
00614           rcode = pio_put_att(cpl_io_file,varid,"long_name",trim(lname))
00615           rcode = pio_put_att(cpl_io_file,varid,"standard_name",trim(sname))
00616           rcode = pio_put_att(cpl_io_file,varid,"internal_dname",trim(dname))
00617           if (present(tavg)) then
00618              if (tavg) then
00619                 rcode = pio_put_att(cpl_io_file,varid,"cell_methods","time: mean")
00620              endif
00621           endif
00622        enddo
00623 
00624     else if (lwdata) then
00625        call mct_gsmap_OrderedPoints(gsmap, iam, Dof)
00626        call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
00627        deallocate(dof)
00628 
00629        do k = 1,nf
00630           call mct_aVect_getRList(mstring,k,AV)
00631           itemc = mct_string_toChar(mstring)
00632           call mct_string_clean(mstring)
00633 ! "v0"    name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
00634           name1 = trim(lpre)//'_'//trim(itemc)
00635           rcode = pio_inq_varid(cpl_io_file,trim(name1),varid)
00636           if (present(nt)) then
00637              frame = nt
00638           else
00639              frame = 1
00640           endif
00641           call pio_setframe(varid,frame)
00642           call pio_write_darray(cpl_io_file, varid, iodesc, av%rattr(k,:), rcode, fillval=lfillvalue)
00643        enddo
00644 
00645        call pio_freedecomp(cpl_io_file, iodesc)
00646 
00647     end if
00648   end subroutine seq_io_write_av
00649 
00650   !===============================================================================
00651   !BOP ===========================================================================
00652   !
00653   ! !IROUTINE: seq_io_write_int - write AV to netcdf file
00654   !
00655   ! !DESCRIPTION:
00656   !    Write AV to netcdf file
00657   !
00658   ! !REVISION HISTORY:
00659   !    2007-Oct-26 - T. Craig - initial version
00660   !
00661   ! !INTERFACE: ------------------------------------------------------------------
00662 
00663   subroutine seq_io_write_int(filename,cdata,idata,dname,whead,wdata)
00664 
00665     ! !INPUT/OUTPUT PARAMETERS:
00666     implicit none
00667     character(len=*),intent(in) :: filename ! file
00668     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
00669     integer(in)     ,intent(in) :: idata    ! data to be written
00670     character(len=*),intent(in) :: dname    ! name of data
00671     logical,optional,intent(in) :: whead    ! write header
00672     logical,optional,intent(in) :: wdata    ! write data
00673 
00674     !EOP
00675 
00676     integer(in) :: rcode
00677     integer(in) :: iam
00678     type(var_desc_t) :: varid
00679     logical :: exists
00680     logical :: lwhead, lwdata
00681     character(*),parameter :: subName = '(seq_io_write_int) '
00682 
00683     !-------------------------------------------------------------------------------
00684     !
00685     !-------------------------------------------------------------------------------
00686 
00687     lwhead = .true.
00688     lwdata = .true.
00689     if (present(whead)) lwhead = whead
00690     if (present(wdata)) lwdata = wdata
00691 
00692     if (.not.lwhead .and. .not.lwdata) then
00693        ! should we write a warning?
00694        return
00695     endif
00696 
00697     call seq_comm_setptrs(CPLID,iam=iam)
00698 
00699     if (lwhead) then
00700        rcode = pio_def_var(cpl_io_file,trim(dname),PIO_INT,varid)
00701 
00702     else if (lwdata) then
00703        rcode = pio_inq_varid(cpl_io_file,trim(dname),varid)
00704        rcode = pio_put_var(cpl_io_file,varid,idata)
00705 
00706        !      write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
00707     endif
00708 
00709   end subroutine seq_io_write_int
00710 
00711   !===============================================================================
00712   !BOP ===========================================================================
00713   !
00714   ! !IROUTINE: seq_io_write_int1d - write AV to netcdf file
00715   !
00716   ! !DESCRIPTION:
00717   !    Write AV to netcdf file
00718   !
00719   ! !REVISION HISTORY:
00720   !    2007-Oct-26 - T. Craig - initial version
00721   !
00722   ! !INTERFACE: ------------------------------------------------------------------
00723 
00724   subroutine seq_io_write_int1d(filename,cdata,idata,dname,whead,wdata)
00725 
00726     ! !INPUT/OUTPUT PARAMETERS:
00727     implicit none
00728     character(len=*),intent(in) :: filename ! file
00729     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
00730     integer(in)     ,intent(in) :: idata(:) ! data to be written
00731     character(len=*),intent(in) :: dname    ! name of data
00732     logical,optional,intent(in) :: whead    ! write header
00733     logical,optional,intent(in) :: wdata    ! write data
00734 
00735     !EOP
00736 
00737     integer(in) :: rcode
00738     integer(in) :: iam
00739     integer(in) :: dimid(1)
00740     type(var_desc_t) :: varid
00741     integer(in) :: lnx
00742     logical :: exists
00743     logical :: lwhead, lwdata
00744     character(*),parameter :: subName = '(seq_io_write_int1d) '
00745 
00746     !-------------------------------------------------------------------------------
00747     !
00748     !-------------------------------------------------------------------------------
00749 
00750     lwhead = .true.
00751     lwdata = .true.
00752     if (present(whead)) lwhead = whead
00753     if (present(wdata)) lwdata = wdata
00754 
00755     if (.not.lwhead .and. .not.lwdata) then
00756        ! should we write a warning?
00757        return
00758     endif
00759 
00760     call seq_comm_setptrs(CPLID,iam=iam)
00761 
00762     lnx = size(idata)
00763 
00764     if (lwhead) then
00765        rcode = pio_def_dim(cpl_io_file,trim(dname)//'_nx',lnx,dimid(1))
00766        rcode = pio_def_var(cpl_io_file,trim(dname),PIO_INT,dimid,varid)
00767     else if (lwdata) then
00768        rcode = pio_inq_varid(cpl_io_file,trim(dname),varid)
00769        rcode = pio_put_var(cpl_io_file,varid,idata)
00770     endif
00771 
00772        !      write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
00773 
00774   end subroutine seq_io_write_int1d
00775 
00776   !===============================================================================
00777   !BOP ===========================================================================
00778   !
00779   ! !IROUTINE: seq_io_write_r8 - write AV to netcdf file
00780   !
00781   ! !DESCRIPTION:
00782   !    Write AV to netcdf file
00783   !
00784   ! !REVISION HISTORY:
00785   !    2007-Oct-26 - T. Craig - initial version
00786   !
00787   ! !INTERFACE: ------------------------------------------------------------------
00788 
00789   subroutine seq_io_write_r8(filename,cdata,rdata,dname,whead,wdata)
00790 
00791     ! !INPUT/OUTPUT PARAMETERS:
00792     implicit none
00793     character(len=*),intent(in) :: filename ! file
00794     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
00795     real(r8)        ,intent(in) :: rdata    ! data to be written
00796     character(len=*),intent(in) :: dname    ! name of data
00797     logical,optional,intent(in) :: whead    ! write header
00798     logical,optional,intent(in) :: wdata    ! write data
00799 
00800     !EOP
00801 
00802     integer(in) :: rcode
00803     integer(in) :: iam
00804     type(var_desc_t) :: varid
00805     logical :: exists
00806     logical :: lwhead, lwdata
00807     character(*),parameter :: subName = '(seq_io_write_r8) '
00808 
00809     !-------------------------------------------------------------------------------
00810     !
00811     !-------------------------------------------------------------------------------
00812 
00813     lwhead = .true.
00814     lwdata = .true.
00815     if (present(whead)) lwhead = whead
00816     if (present(wdata)) lwdata = wdata
00817 
00818     if (.not.lwhead .and. .not.lwdata) then
00819        ! should we write a warning?
00820        return
00821     endif
00822     call seq_comm_setptrs(CPLID,iam=iam)
00823 
00824     if (lwhead) then
00825        rcode = pio_def_var(cpl_io_file,trim(dname),PIO_DOUBLE,varid)
00826     endif
00827 
00828     if (lwdata) then
00829        rcode = pio_inq_varid(cpl_io_file,trim(dname),varid)
00830        rcode = pio_put_var(cpl_io_file,varid,rdata)
00831     endif
00832 
00833 
00834   end subroutine seq_io_write_r8
00835 
00836   !===============================================================================
00837   !BOP ===========================================================================
00838   !
00839   ! !IROUTINE: seq_io_write_r81d - write AV to netcdf file
00840   !
00841   ! !DESCRIPTION:
00842   !    Write AV to netcdf file
00843   !
00844   ! !REVISION HISTORY:
00845   !    2007-Oct-26 - T. Craig - initial version
00846   !
00847   ! !INTERFACE: ------------------------------------------------------------------
00848 
00849   subroutine seq_io_write_r81d(filename,cdata,rdata,dname,whead,wdata)
00850 
00851     ! !INPUT/OUTPUT PARAMETERS:
00852     implicit none
00853     character(len=*),intent(in) :: filename ! file
00854     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
00855     real(r8)        ,intent(in) :: rdata(:) ! data to be written
00856     character(len=*),intent(in) :: dname    ! name of data
00857     logical,optional,intent(in) :: whead    ! write header
00858     logical,optional,intent(in) :: wdata    ! write data
00859 
00860     !EOP
00861 
00862     integer(in) :: rcode
00863     integer(in) :: mpicom
00864     integer(in) :: iam
00865     integer(in) :: dimid(1)
00866     type(var_desc_t) :: varid
00867     integer(in) :: lnx
00868     logical :: exists
00869     logical :: lwhead, lwdata
00870     character(*),parameter :: subName = '(seq_io_write_r81d) '
00871 
00872     !-------------------------------------------------------------------------------
00873     !
00874     !-------------------------------------------------------------------------------
00875 
00876     lwhead = .true.
00877     lwdata = .true.
00878     if (present(whead)) lwhead = whead
00879     if (present(wdata)) lwdata = wdata
00880 
00881     if (.not.lwhead .and. .not.lwdata) then
00882        ! should we write a warning?
00883        return
00884     endif
00885     call seq_comm_setptrs(CPLID,iam=iam)
00886 
00887     lnx = size(rdata)
00888 
00889     if (lwhead) then
00890        rcode = pio_def_dim(cpl_io_file,trim(dname)//'_nx',lnx,dimid(1))
00891        rcode = pio_def_var(cpl_io_file,trim(dname),PIO_DOUBLE,dimid,varid)
00892     else if (lwdata) then
00893        rcode = pio_inq_varid(cpl_io_file,trim(dname),varid)
00894        rcode = pio_put_var(cpl_io_file,varid,rdata)
00895 
00896        !      write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
00897     endif
00898 
00899   end subroutine seq_io_write_r81d
00900 
00901   !===============================================================================
00902 !BOP ===========================================================================
00903 !
00904 ! !IROUTINE: seq_io_write_time - write time variable to netcdf file
00905 !
00906 ! !DESCRIPTION:
00907 !    Write time variable to netcdf file
00908 !
00909 ! !REVISION HISTORY:
00910 !    2009-Feb-11 - M. Vertenstein - initial version
00911 !
00912 ! !INTERFACE: ------------------------------------------------------------------
00913 
00914 subroutine seq_io_write_time(filename,time_units,time_cal,time_val,nt,whead,wdata,tbnds)
00915 
00916 ! !INPUT/OUTPUT PARAMETERS:
00917    implicit none
00918    character(len=*),intent(in) :: filename      ! file
00919    character(len=*),intent(in) :: time_units    ! units of time
00920    character(len=*),intent(in) :: time_cal      ! calendar type
00921    real(r8)        ,intent(in) :: time_val      ! data to be written
00922    integer(in),optional,intent(in) :: nt
00923    logical,optional,intent(in) :: whead         ! write header
00924    logical,optional,intent(in) :: wdata         ! write data
00925    real(r8),optional,intent(in) :: tbnds(2)     ! time bounds
00926 
00927 !EOP
00928 
00929    integer(in) :: rcode
00930    integer(in) :: iam
00931    integer(in) :: dimid(1)
00932    integer(in) :: dimid2(2)
00933    type(var_desc_t) :: varid
00934    integer(in) :: lnx
00935    logical :: exists
00936    logical :: lwhead, lwdata
00937    integer :: start(4),count(4)
00938    real(r8) :: time_val_1d(1)
00939    character(*),parameter :: subName = '(seq_io_write_time) '
00940 
00941 !-------------------------------------------------------------------------------
00942 !
00943 !-------------------------------------------------------------------------------
00944 
00945    lwhead = .true.
00946    lwdata = .true.
00947    if (present(whead)) lwhead = whead
00948    if (present(wdata)) lwdata = wdata
00949 
00950    if (.not.lwhead .and. .not.lwdata) then
00951       ! should we write a warning?
00952       return
00953    endif
00954 
00955    call seq_comm_setptrs(CPLID,iam=iam)
00956 
00957    if (lwhead) then
00958       rcode = pio_def_dim(cpl_io_file,'time',PIO_UNLIMITED,dimid(1))
00959       rcode = pio_def_var(cpl_io_file,'time',PIO_DOUBLE,dimid,varid)
00960       rcode = pio_put_att(cpl_io_file,varid,'units',trim(time_units))
00961       if (trim(time_cal) == 'NO_LEAP') then
00962          rcode = pio_put_att(cpl_io_file,varid,'calendar','noleap')
00963       else if (trim(time_cal) == 'GREGORIAN') then
00964          rcode = pio_put_att(cpl_io_file,varid,'calendar','365_day')
00965       else
00966          rcode = pio_put_att(cpl_io_file,varid,'calendar','time_cal')
00967       end if
00968       if (present(tbnds)) then
00969          rcode = pio_put_att(cpl_io_file,varid,'bounds','time_bnds')
00970          dimid2(2)=dimid(1)
00971          rcode = pio_def_dim(cpl_io_file,'ntb',2,dimid2(1))
00972          rcode = pio_def_var(cpl_io_file,'time_bnds',PIO_DOUBLE,dimid2,varid)
00973       endif
00974 
00975    else if (lwdata) then
00976       start = 1
00977       count = 1
00978       if (present(nt)) then
00979          start(1) = nt
00980       endif
00981       time_val_1d(1) = time_val
00982       rcode = pio_inq_varid(cpl_io_file,'time',varid)
00983       rcode = pio_put_var(cpl_io_file,varid,start,count,time_val_1d)
00984       if (present(tbnds)) then
00985          rcode = pio_inq_varid(cpl_io_file,'time_bnds',varid)
00986          start = 1
00987          count = 1
00988          if (present(nt)) then
00989             start(2) = nt
00990          endif
00991          count(1) = 2
00992          rcode = pio_put_var(cpl_io_file,varid,start,count,tbnds)
00993       endif
00994 
00995       !      write(logunit,*) subname,' wrote time ',lwhead,lwdata
00996    endif
00997 
00998  end subroutine seq_io_write_time
00999 
01000 !===============================================================================
01001   !BOP ===========================================================================
01002   !
01003   ! !IROUTINE: seq_io_read_av - read AV from netcdf file
01004   !
01005   ! !DESCRIPTION:
01006   !    Read AV from netcdf file
01007   !
01008   ! !REVISION HISTORY:
01009   !    2007-Oct-26 - T. Craig - initial version
01010   !
01011   ! !INTERFACE: ------------------------------------------------------------------
01012 
01013   subroutine seq_io_read_av(filename,cdata,AV,dname,pre)
01014 
01015     ! !INPUT/OUTPUT PARAMETERS:
01016     implicit none
01017     character(len=*),intent(in) :: filename ! file
01018     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
01019     type(mct_aVect) ,intent(inout):: AV     ! data to be written
01020     character(len=*),intent(in) :: dname    ! name of data
01021     character(len=*),intent(in),optional :: pre      ! prefix name
01022 
01023     !EOP
01024 
01025     integer(in) :: rcode
01026     integer(in) :: iam
01027     integer(in) :: nf,ns,ng
01028     integer(in) :: i,j,k,n, ndims
01029     type(file_desc_t) :: pioid
01030     integer(in) :: dimid(2)
01031     type(var_desc_t) :: varid
01032     integer(in) :: lnx,lny
01033     type(mct_string) :: mstring     ! mct char type
01034     character(CL)    :: itemc       ! string converted to char
01035     logical :: exists
01036     type(mct_gsMap),pointer :: gsmap
01037     character(*),parameter :: subName = '(seq_io_read_av) '
01038     type(io_desc_t) :: iodesc
01039     integer(in), pointer :: dof(:)
01040     character(CL)  :: lversion
01041     character(CL)  :: name1
01042     character(CL)  :: lpre
01043     !-------------------------------------------------------------------------------
01044     !
01045     !-------------------------------------------------------------------------------
01046 
01047     lversion = trim(version0)
01048 
01049     lpre = trim(dname)
01050     if (present(pre)) then
01051        lpre = trim(pre)
01052     endif
01053 
01054     call seq_cdata_setptrs(cdata,gsmap=gsmap)
01055     call seq_comm_setptrs(CPLID,iam=iam)
01056     call mct_gsmap_OrderedPoints(gsmap, iam, Dof)
01057 
01058     ns = mct_aVect_lsize(AV)
01059     nf = mct_aVect_nRattr(AV)
01060 
01061     inquire(file=trim(filename),exist=exists)
01062     if (exists) then
01063        rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_io_type, trim(filename),pio_nowrite)
01064        if(iam==0) write(logunit,*) subname,' open file ',trim(filename)
01065        call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
01066        rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
01067        call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
01068     else
01069        if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname)
01070        call shr_sys_abort()
01071     endif
01072 
01073     do k = 1,nf
01074        call mct_aVect_getRList(mstring,k,AV)
01075        itemc = mct_string_toChar(mstring)
01076        call mct_string_clean(mstring)
01077        if (trim(lversion) == trim(version)) then
01078           name1 = trim(lpre)//'_'//trim(itemc)
01079        else
01080           name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
01081        endif
01082        call pio_seterrorhandling(pioid, PIO_BCAST_ERROR)
01083        rcode = pio_inq_varid(pioid,trim(name1),varid)
01084        if (rcode == pio_noerr) then
01085           if (k==1) then
01086              rcode = pio_inq_varndims(pioid, varid, ndims)
01087              rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims))
01088              rcode = pio_inq_dimlen(pioid, dimid(1), lnx)
01089              if (ndims==2) then
01090                 rcode = pio_inq_dimlen(pioid, dimid(2), lny)
01091              else
01092                 lny = 1
01093              end if
01094              ng = lnx * lny
01095              if (ng /= mct_gsmap_gsize(gsmap)) then
01096                 if (iam==0) write(logunit,*) subname,' ERROR: dimensions do not match',&
01097                      lnx,lny,mct_gsmap_gsize(gsmap)
01098                 call shr_sys_abort()
01099              end if
01100              call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
01101              deallocate(dof)
01102           end if
01103           call pio_read_darray(pioid,varid,iodesc, av%rattr(k,:), rcode)
01104        else
01105           write(logunit,*)'seq_io_readav warning: field ',trim(itemc),' is not on restart file'
01106           write(logunit,*)'for backwards compatibility will set it to 0'
01107           av%rattr(k,:) = 0.0_r8
01108        end if
01109        call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
01110           
01111        !--- zero out fill value, this is somewhat arbitrary
01112        do n = 1,ns
01113           if (AV%rAttr(k,n) == fillvalue) then
01114               AV%rAttr(k,n) = 0.0_r8
01115           endif
01116        enddo
01117     enddo
01118 
01119     call pio_freedecomp(pioid, iodesc)
01120     call pio_closefile(pioid)
01121 
01122   end subroutine seq_io_read_av
01123 
01124   !===============================================================================
01125   !BOP ===========================================================================
01126   !
01127   ! !IROUTINE: seq_io_read_int - read AV from netcdf file
01128   !
01129   ! !DESCRIPTION:
01130   !    Read AV from netcdf file
01131   !
01132   ! !REVISION HISTORY:
01133   !    2007-Oct-26 - T. Craig - initial version
01134   !
01135   ! !INTERFACE: ------------------------------------------------------------------
01136 
01137   subroutine seq_io_read_int(filename,cdata,idata,dname)
01138 
01139     ! !INPUT/OUTPUT PARAMETERS:
01140     implicit none
01141     character(len=*),intent(in) :: filename ! file
01142     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
01143     integer         ,intent(inout):: idata  ! integer data
01144     character(len=*),intent(in) :: dname    ! name of data
01145 
01146     !EOP
01147 
01148     integer :: i1d(1)
01149     character(*),parameter :: subName = '(seq_io_read_int) '
01150 
01151     !-------------------------------------------------------------------------------
01152     !
01153     !-------------------------------------------------------------------------------
01154 
01155     call seq_io_read_int1d(filename,cdata,i1d,dname)
01156     idata = i1d(1)
01157 
01158   end subroutine seq_io_read_int
01159 
01160   !===============================================================================
01161   !BOP ===========================================================================
01162   !
01163   ! !IROUTINE: seq_io_read_int1d - read AV from netcdf file
01164   !
01165   ! !DESCRIPTION:
01166   !    Read AV from netcdf file
01167   !
01168   ! !REVISION HISTORY:
01169   !    2007-Oct-26 - T. Craig - initial version
01170   !
01171   ! !INTERFACE: ------------------------------------------------------------------
01172 
01173   subroutine seq_io_read_int1d(filename,cdata,idata,dname)
01174 
01175     ! !INPUT/OUTPUT PARAMETERS:
01176     implicit none
01177     character(len=*),intent(in) :: filename ! file
01178     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
01179     integer(in)     ,intent(inout):: idata(:)  ! integer data
01180     character(len=*),intent(in) :: dname    ! name of data
01181 
01182     !EOP
01183 
01184     integer(in) :: rcode
01185     integer(in) :: iam
01186     type(file_desc_t) :: pioid 
01187     type(var_desc_t) :: varid
01188     logical :: exists
01189     character(CL)  :: lversion
01190     character(CL)  :: name1
01191     character(*),parameter :: subName = '(seq_io_read_int1d) '
01192 
01193     !-------------------------------------------------------------------------------
01194     !
01195     !-------------------------------------------------------------------------------
01196 
01197     call seq_comm_setptrs(CPLID,iam=iam)
01198 
01199     lversion=trim(version0)
01200 
01201     inquire(file=trim(filename),exist=exists)
01202     if (exists) then
01203        rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_io_type, trim(filename),pio_nowrite)
01204        !         write(logunit,*) subname,' open file ',trim(filename)
01205        call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
01206        rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
01207        call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
01208     else
01209        if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname)
01210        call shr_sys_abort()
01211     endif
01212 
01213     if (trim(lversion) == trim(version)) then
01214        name1 = trim(dname)
01215     else
01216        name1 = trim(prefix)//trim(dname)
01217     endif
01218     rcode = pio_inq_varid(pioid,trim(name1),varid)
01219     rcode = pio_get_var(pioid,varid,idata)
01220 
01221     call pio_closefile(pioid)
01222 
01223     !      write(logunit,*) subname,' read int ',trim(dname)
01224 
01225 
01226   end subroutine seq_io_read_int1d
01227 
01228   !===============================================================================
01229   !BOP ===========================================================================
01230   !
01231   ! !IROUTINE: seq_io_read_r8 - read AV from netcdf file
01232   !
01233   ! !DESCRIPTION:
01234   !    Read AV from netcdf file
01235   !
01236   ! !REVISION HISTORY:
01237   !    2007-Oct-26 - T. Craig - initial version
01238   !
01239   ! !INTERFACE: ------------------------------------------------------------------
01240 
01241   subroutine seq_io_read_r8(filename,cdata,rdata,dname)
01242 
01243     ! !INPUT/OUTPUT PARAMETERS:
01244     implicit none
01245     character(len=*),intent(in) :: filename ! file
01246     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
01247     real(r8)        ,intent(inout):: rdata  ! integer data
01248     character(len=*),intent(in) :: dname    ! name of data
01249 
01250     !EOP
01251 
01252     real(r8) :: r1d(1)
01253     character(*),parameter :: subName = '(seq_io_read_r8) '
01254 
01255     !-------------------------------------------------------------------------------
01256     !
01257     !-------------------------------------------------------------------------------
01258 
01259     call seq_io_read_r81d(filename,cdata,r1d,dname)
01260     rdata = r1d(1)
01261 
01262   end subroutine seq_io_read_r8
01263 
01264   !===============================================================================
01265   !BOP ===========================================================================
01266   !
01267   ! !IROUTINE: seq_io_read_r81d - read AV from netcdf file
01268   !
01269   ! !DESCRIPTION:
01270   !    Read AV from netcdf file
01271   !
01272   ! !REVISION HISTORY:
01273   !    2007-Oct-26 - T. Craig - initial version
01274   !
01275   ! !INTERFACE: ------------------------------------------------------------------
01276 
01277   subroutine seq_io_read_r81d(filename,cdata,rdata,dname)
01278 
01279     ! !INPUT/OUTPUT PARAMETERS:
01280     implicit none
01281     character(len=*),intent(in) :: filename ! file
01282     type(seq_cdata) ,intent(in) :: cdata    ! cdata associated with AV
01283     real(r8)        ,intent(inout):: rdata(:)  ! integer data
01284     character(len=*),intent(in) :: dname    ! name of data
01285 
01286     !EOP
01287 
01288     integer(in) :: rcode
01289     integer(in) :: mpicom
01290     integer(in) :: iam
01291     type(file_desc_T) :: pioid 
01292     type(var_desc_t) :: varid
01293     logical :: exists
01294     character(CL)  :: lversion
01295     character(CL)  :: name1
01296     character(*),parameter :: subName = '(seq_io_read_r81d) '
01297 
01298     !-------------------------------------------------------------------------------
01299     !
01300     !-------------------------------------------------------------------------------
01301 
01302     call seq_comm_setptrs(CPLID,iam=iam)
01303 
01304     lversion=trim(version0)
01305 
01306     inquire(file=trim(filename),exist=exists)
01307     if (exists) then
01308        rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_io_type, trim(filename),pio_nowrite)
01309        !         write(logunit,*) subname,' open file ',trim(filename)
01310        call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
01311        rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
01312        call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
01313     else
01314        if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname)
01315        call shr_sys_abort()
01316     endif
01317 
01318     if (trim(lversion) == trim(version)) then
01319        name1 = trim(dname)
01320     else
01321        name1 = trim(prefix)//trim(dname)
01322     endif
01323     rcode = pio_inq_varid(pioid,trim(name1),varid)
01324     rcode = pio_get_var(pioid,varid,rdata)
01325 
01326     call pio_closefile(pioid)
01327 
01328 
01329     !      write(logunit,*) subname,' read int ',trim(dname)
01330 
01331 
01332   end subroutine seq_io_read_r81d
01333 
01334 !===============================================================================
01335 end module seq_io_mod