!===============================================================================
! SVN $Id: seq_io_mod.F90 23596 2010-06-07 19:36:18Z tcraig $
! 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 $
!===============================================================================
!BOP ===========================================================================
!
! !MODULE: seq_io_mod -- reads and writes driver files
!
! !DESCRIPTION:
! Writes attribute vectors to netcdf
!
! !REMARKS:
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig first version
! 2007-Dec-06 - T. Craig update and improve
! 2008-Feb-16 - J. Edwards convert to PIO
!
! !INTERFACE: ------------------------------------------------------------------
module seq_io_mod 3,18
! !USES:
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 ! system calls
use seq_cdata_mod ! cdata
use seq_comm_mct, only : logunit, seq_comm_setptrs, CPLID
use seq_flds_mod, only : seq_flds_lookup
use mct_mod ! mct wrappers
use pio
implicit none
private
! !PUBLIC TYPES:
! none
! !PUBLIC MEMBER FUNCTIONS:
public seq_io_init
public seq_io_wopen
public seq_io_close
public seq_io_redef
public seq_io_enddef
public seq_io_date2yyyymmdd
public seq_io_sec2hms
public seq_io_read
public seq_io_write
! !PUBLIC DATA MEMBERS
! none
!EOP
interface seq_io_read 18
module procedure seq_io_read_av
module procedure seq_io_read_int
module procedure seq_io_read_int1d
module procedure seq_io_read_r8
module procedure seq_io_read_r81d
end interface
interface seq_io_write 77
module procedure seq_io_write_av
module procedure seq_io_write_int
module procedure seq_io_write_int1d
module procedure seq_io_write_r8
module procedure seq_io_write_r81d
module procedure seq_io_write_time
end interface
!-------------------------------------------------------------------------------
! Local data
!-------------------------------------------------------------------------------
character(*),parameter :: prefix = "seq_io_"
character(CL) :: wfilename = ''
real(r8) ,parameter :: fillvalue = SHR_CONST_SPVAL
character(*),parameter :: modName = "(seq_io_mod) "
integer(in) ,parameter :: debug = 0 ! internal debug level
integer(IN) ,save :: cpl_io_type
type(file_desc_t) ,save :: cpl_io_file
type(iosystem_desc_t),save :: cpl_io_subsystem
character(*),parameter :: version ='cpl7v10'
character(*),parameter :: version0='cpl7v00'
!=================================================================================
contains
!=================================================================================
!=================================================================================
!BOP =============================================================================
!
! !IROUTINE: seq_io_init - initialize io for coupler
!
! !DESCRIPTION:
! Read the pio_inparm namelist and initialize the pio subsystem
!
! !REVISION HISTORY:
! 2009-Sep-30 - B. Kauffman - consolidation, clean up
! 2009-Feb-17 - J. Edwards - initial version
!
! !INTERFACE: --------------------------------------------------------------------
subroutine seq_io_init(nlfilename) 1,11
use shr_string_mod, only : shr_string_toupper
use shr_file_mod, only : shr_file_getunit, shr_file_freeunit
use shr_mpi_mod, only : shr_mpi_bcast
use pio, only : pio_iotype_netcdf, pio_iotype_pnetcdf, pio_iotype_netcdf4c, pio_iotype_netcdf4p
implicit none
! !INPUT/OUTPUT PARAMETERS:
character(*), intent(in) :: nlfilename
! LOCAL
integer(IN) :: iam, mpicom, npes, ierr, unitn
logical :: iamroot
character(CS) :: cpl_io_typename
integer(IN) :: cpl_io_stride
integer(IN) :: cpl_io_numtasks
integer(IN) :: cpl_io_root
integer(IN),parameter :: cpl_io_root_default = 0
namelist /pio_inparm/ cpl_io_stride, cpl_io_root, cpl_io_numtasks, cpl_io_typename
character(*),parameter :: subName = '(seq_io_init) '
character(*),parameter :: F00 = "('(seq_io_init) ',4a)"
character(*),parameter :: F01 = "('(seq_io_init) ',a,i6)"
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
call seq_comm_setptrs(CPLID, iam=iam, mpicom=mpicom,npes=npes, iamroot=iamroot)
!--------------------------------------------------------------------------
! read io nml parameters
!--------------------------------------------------------------------------
cpl_io_stride = -1 ! set based on cpl_io_numtasks value when initialized < 0
cpl_io_numtasks = -1 ! set based on cpl_io_stride value when initialized < 0
cpl_io_root = cpl_io_root_default
cpl_io_typename = 'netcdf'
if (iamroot) then
if (debug > 0) then
write(logunit,F00) 'pio init parameters: before nml read'
write(logunit,F01) ' cpl_io_stride = ',cpl_io_stride
write(logunit,F01) ' cpl_io_root = ',cpl_io_root
write(logunit,F00) ' cpl_io_typename = ',cpl_io_typename
write(logunit,F01) ' cpl_io_numtasks = ',cpl_io_numtasks
end if
unitn=shr_file_getunit()
open( unitn, file=trim(nlfilename), status='old' )
ierr = 1
do while( ierr /= 0 )
read(unitn,nml=pio_inparm,iostat=ierr)
if (ierr < 0) then
call shr_sys_abort( subname//':: namelist read returns an'// &
' end of file or end of record condition' )
end if
end do
close(unitn)
call shr_file_freeUnit( unitn )
if (debug > 0) then
write(logunit,F00) 'pio init parameters: after nml read'
write(logunit,F01) ' cpl_io_stride = ',cpl_io_stride
write(logunit,F01) ' cpl_io_root = ',cpl_io_root
write(logunit,F00) ' cpl_io_typename = ',cpl_io_typename
write(logunit,F01) ' cpl_io_numtasks = ',cpl_io_numtasks
end if
if ( shr_string_toupper(cpl_io_typename) .eq. 'NETCDF' ) then
cpl_io_type = pio_iotype_netcdf
else if ( shr_string_toupper(cpl_io_typename) .eq. 'PNETCDF') then
cpl_io_type = pio_iotype_pnetcdf
else if ( shr_string_toupper(cpl_io_typename) .eq. 'NETCDF4P') then
cpl_io_type = pio_iotype_netcdf4p
else if ( shr_string_toupper(cpl_io_typename) .eq. 'NETCDF4C') then
cpl_io_type = pio_iotype_netcdf4c
else
write(logunit,*) subName,'Bad io_type argument - using iotype_netcdf'
cpl_io_type=pio_iotype_netcdf
end if
end if
call shr_mpi_bcast(cpl_io_type , mpicom)
call shr_mpi_bcast(cpl_io_stride , mpicom)
call shr_mpi_bcast(cpl_io_root , mpicom)
call shr_mpi_bcast(cpl_io_numtasks, mpicom)
!--------------------------------------------------------------------------
! check/set/correct io pio parameters
!--------------------------------------------------------------------------
if (cpl_io_stride>0.and.cpl_io_numtasks<0) then
cpl_io_numtasks = npes/cpl_io_stride
else if(cpl_io_numtasks>0 .and. cpl_io_stride<0) then
cpl_io_stride = npes/cpl_io_numtasks
else if(cpl_io_numtasks<0 .and. cpl_io_stride<0) then
cpl_io_stride = 4
cpl_io_numtasks = npes/cpl_io_stride
cpl_io_numtasks = max(1, cpl_io_numtasks)
end if
if (cpl_io_root<0) then
cpl_io_root = cpl_io_root_default
endif
cpl_io_root = min(cpl_io_root,npes-1)
if (cpl_io_root + (cpl_io_stride)*(cpl_io_numtasks-1) >= npes .or. &
cpl_io_stride<=0 .or. cpl_io_numtasks<=0 .or. cpl_io_root < 0 .or. &
cpl_io_root > npes-1) then
write(logunit,*) subName,'cpl_io_stride, iotasks or root out of bounds - resetting to defaults ', &
cpl_io_stride, cpl_io_numtasks, cpl_io_root
cpl_io_stride = max(1,npes/4)
cpl_io_numtasks = npes/cpl_io_stride
cpl_io_root = min(1,npes-1)
end if
!--------------------------------------------------------------------------
! init pio library
!--------------------------------------------------------------------------
if (iamroot) then
write(logunit,F00) 'pio init parameters: '
write(logunit,F01) ' cpl_io_stride = ',cpl_io_stride
write(logunit,F01) ' cpl_io_root = ',cpl_io_root
write(logunit,F00) ' cpl_io_typename = ',cpl_io_typename
write(logunit,F01) ' cpl_io_numtasks = ',cpl_io_numtasks
end if
! call pio_init(iam, mpicom, cpl_io_numtasks, cpl_io_root, cpl_io_stride, PIO_REARR_BOX, cpl_io_subsystem)
call pio_init(iam, mpicom, cpl_io_numtasks, 0, cpl_io_stride, PIO_REARR_BOX, &
cpl_io_subsystem, base=cpl_io_root)
cpl_io_file%fh=-1
end subroutine seq_io_init
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_wopen - open netcdf file
!
! !DESCRIPTION:
! open netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_wopen(filename,cdata,clobber,cdf64) 5,2
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(*),intent(in) :: filename
type(seq_cdata),intent(in) :: cdata
logical,optional,intent(in):: clobber
logical,optional,intent(in):: cdf64
!EOP
logical :: exists
logical :: lclobber
logical :: lcdf64
integer :: iam
integer :: rcode
integer :: nmode
character(CL) :: lversion
character(*),parameter :: subName = '(seq_io_wopen) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
lversion=trim(version0)
lclobber = .false.
if (present(clobber)) lclobber=clobber
lcdf64 = .false.
if (present(cdf64)) lcdf64=cdf64
call seq_comm_setptrs(CPLID,iam=iam)
if (cpl_io_file%fh<0) then
! filename not open
inquire(file=trim(filename),exist=exists)
if (exists) then
if (lclobber) then
nmode = pio_clobber
if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
rcode = pio_createfile(cpl_io_subsystem, cpl_io_file, cpl_io_type, trim(filename), nmode)
if(iam==0) write(logunit,*) subname,' create file ',trim(filename)
rcode = pio_put_att(cpl_io_file,pio_global,"file_version",version)
else
rcode = pio_openfile(cpl_io_subsystem, cpl_io_file, cpl_io_type, trim(filename), pio_write)
if(iam==0) write(logunit,*) subname,' open file ',trim(filename)
call pio_seterrorhandling(cpl_io_file,PIO_BCAST_ERROR)
rcode = pio_get_att(cpl_io_file,pio_global,"file_version",lversion)
call pio_seterrorhandling(cpl_io_file,PIO_INTERNAL_ERROR)
if (trim(lversion) /= trim(version)) then
rcode = pio_redef(cpl_io_file)
rcode = pio_put_att(cpl_io_file,pio_global,"file_version",version)
rcode = pio_enddef(cpl_io_file)
endif
endif
else
nmode = pio_noclobber
if (lcdf64) nmode = ior(nmode,PIO_64BIT_OFFSET)
rcode = pio_createfile(cpl_io_subsystem, cpl_io_file, cpl_io_type, trim(filename), nmode)
if(iam==0) write(logunit,*) subname,' create file ',trim(filename)
rcode = pio_put_att(cpl_io_file,pio_global,"file_version",version)
endif
elseif (trim(wfilename) /= trim(filename)) then
! filename is open, better match open filename
if(iam==0) write(logunit,*) subname,' different file currently open ',trim(filename)
call shr_sys_abort()
else
! filename is already open, just return
endif
end subroutine seq_io_wopen
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_close - close netcdf file
!
! !DESCRIPTION:
! close netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_close(filename,cdata) 4,2
use pio, only : pio_closefile
implicit none
! !INPUT/OUTPUT PARAMETERS:
character(*),intent(in) :: filename
type(seq_cdata),intent(in) :: cdata
!EOP
integer :: iam
integer :: rcode
character(*),parameter :: subName = '(seq_io_close) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
call seq_comm_setptrs(CPLID,iam=iam)
if (cpl_io_file%fh<0) then
! filename not open, just return
elseif (trim(wfilename) /= trim(filename)) then
! filename matches, close it
call pio_closefile(cpl_io_file)
cpl_io_file%fh=-1
else
! different filename is open, abort
if(iam==0) write(logunit,*) subname,' different file currently open ',trim(filename)
call shr_sys_abort()
endif
wfilename = ''
end subroutine seq_io_close
!===============================================================================
subroutine seq_io_redef(filename) 1
character(len=*), intent(in) :: filename
integer :: rcode
rcode = pio_redef(cpl_io_file)
end subroutine seq_io_redef
!===============================================================================
subroutine seq_io_enddef(filename) 4
character(len=*), intent(in) :: filename
integer :: rcode
rcode = pio_enddef(cpl_io_file)
end subroutine seq_io_enddef
!===============================================================================
character(len=10) function seq_io_date2yyyymmdd (date) 3,1
! Input arguments
integer, intent(in) :: date
! Local workspace
integer :: year ! year of yyyy-mm-dd
integer :: month ! month of yyyy-mm-dd
integer :: day ! day of yyyy-mm-dd
!-------------------------------------------------------------------------------
if (date < 0) then
call shr_sys_abort ('seq_io_date2yyyymmdd: negative date not allowed')
end if
year = date / 10000
month = (date - year*10000) / 100
day = date - year*10000 - month*100
write(seq_io_date2yyyymmdd,80) year, month, day
80 format(i4.4,'-',i2.2,'-',i2.2)
end function seq_io_date2yyyymmdd
!===============================================================================
character(len=8) function seq_io_sec2hms (seconds) 3,3
! Input arguments
integer, intent(in) :: seconds
! Local workspace
integer :: hours ! hours of hh:mm:ss
integer :: minutes ! minutes of hh:mm:ss
integer :: secs ! seconds of hh:mm:ss
!-------------------------------------------------------------------------------
if (seconds < 0 .or. seconds > 86400) then
write(logunit,*)'seq_io_sec2hms: bad input seconds:', seconds
call shr_sys_abort()
end if
hours = seconds / 3600
minutes = (seconds - hours*3600) / 60
secs = (seconds - hours*3600 - minutes*60)
if (minutes < 0 .or. minutes > 60) then
write(logunit,*)'seq_io_sec2hms: bad minutes = ',minutes
call shr_sys_abort()
end if
if (secs < 0 .or. secs > 60) then
write(logunit,*)'seq_io_sec2hms: bad secs = ',secs
call shr_sys_abort()
end if
write(seq_io_sec2hms,80) hours, minutes, secs
80 format(i2.2,':',i2.2,':',i2.2)
end function seq_io_sec2hms
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_write_av - write AV to netcdf file
!
! !DESCRIPTION:
! Write AV to netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_write_av(filename,cdata,AV,dname,whead,wdata,nx,ny,nt,fillval,pre,tavg,& 1,4
use_float)
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
type(mct_aVect) ,intent(in) :: AV ! data to be written
character(len=*),intent(in) :: dname ! name of data
logical,optional,intent(in) :: whead ! write header
logical,optional,intent(in) :: wdata ! write data
integer(in),optional,intent(in) :: nx ! 2d grid size if available
integer(in),optional,intent(in) :: ny ! 2d grid size if available
integer(in),optional,intent(in) :: nt ! time sample
real(r8),optional,intent(in) :: fillval ! fill value
character(len=*),optional,intent(in) :: pre ! prefix to variable name
logical,optional,intent(in) :: tavg ! is this a tavg
logical,optional,intent(in) :: use_float ! write output as float rather than double
!EOP
integer(in) :: rcode
integer(in) :: mpicom
integer(in) :: iam
integer(in) :: nf,ns,ng
integer(in) :: i,j,k,n
integer(in),target :: dimid2(2)
integer(in),target :: dimid3(3)
integer(in),pointer :: dimid(:)
type(var_desc_t) :: varid
type(io_desc_t) :: iodesc
integer(kind=PIO_OffSet) :: frame
type(mct_string) :: mstring ! mct char type
character(CL) :: itemc ! string converted to char
character(CL) :: name1 ! var name
character(CL) :: cunit ! var units
character(CL) :: lname ! long name
character(CL) :: sname ! standard name
character(CL) :: lpre ! local prefix
logical :: exists
logical :: lwhead, lwdata
integer(in) :: lnx,lny
real(r8) :: lfillvalue
type(mct_gsMap),pointer :: gsmap
type(mct_aVect) :: AVroot
real(r8),pointer :: fld1(:,:) ! needed to convert AVroot ng rAttr to 2d nx,ny
character(*),parameter :: subName = '(seq_io_write_av) '
integer :: lbnum
integer, pointer :: Dof(:)
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
lfillvalue = fillvalue
if (present(fillval)) then
lfillvalue = fillval
endif
lpre = trim(dname)
if (present(pre)) then
lpre = trim(pre)
endif
lwhead = .true.
lwdata = .true.
if (present(whead)) lwhead = whead
if (present(wdata)) lwdata = wdata
if (.not.lwhead .and. .not.lwdata) then
! should we write a warning?
return
endif
call seq_cdata_setptrs(cdata,gsmap=gsmap)
call seq_comm_setptrs(CPLID,iam=iam)
ng = mct_gsmap_gsize(gsmap)
lnx = ng
lny = 1
nf = mct_aVect_nRattr(AV)
if (nf < 1) then
write(logunit,*) subname,' ERROR: nf = ',nf,trim(dname)
call shr_sys_abort()
endif
if (present(nx)) then
if (nx /= 0) lnx = nx
endif
if (present(ny)) then
if (ny /= 0) lny = ny
endif
if (lnx*lny /= ng) then
if(iam==0) write(logunit,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny,trim(dname)
call shr_sys_abort()
endif
if (lwhead) then
rcode = pio_def_dim(cpl_io_file,trim(lpre)//'_nx',lnx,dimid2(1))
rcode = pio_def_dim(cpl_io_file,trim(lpre)//'_ny',lny,dimid2(2))
if (present(nt)) then
dimid3(1:2) = dimid2
rcode = pio_inq_dimid(cpl_io_file,'time',dimid3(3))
dimid => dimid3
else
dimid => dimid2
endif
do k = 1,nf
call mct_aVect_getRList(mstring,k,AV)
itemc = mct_string_toChar(mstring)
call mct_string_clean(mstring)
! "v0" name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
name1 = trim(lpre)//'_'//trim(itemc)
call seq_flds_lookup(itemc,longname=lname,stdname=sname,units=cunit)
if (present(use_float)) then
rcode = pio_def_var(cpl_io_file,trim(name1),PIO_REAL,dimid,varid)
else
rcode = pio_def_var(cpl_io_file,trim(name1),PIO_DOUBLE,dimid,varid)
end if
rcode = pio_put_att(cpl_io_file,varid,"_FillValue",lfillvalue)
rcode = pio_put_att(cpl_io_file,varid,"units",trim(cunit))
rcode = pio_put_att(cpl_io_file,varid,"long_name",trim(lname))
rcode = pio_put_att(cpl_io_file,varid,"standard_name",trim(sname))
rcode = pio_put_att(cpl_io_file,varid,"internal_dname",trim(dname))
if (present(tavg)) then
if (tavg) then
rcode = pio_put_att(cpl_io_file,varid,"cell_methods","time: mean")
endif
endif
enddo
else if (lwdata) then
call mct_gsmap_OrderedPoints(gsmap, iam, Dof)
call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
deallocate(dof)
do k = 1,nf
call mct_aVect_getRList(mstring,k,AV)
itemc = mct_string_toChar(mstring)
call mct_string_clean(mstring)
! "v0" name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
name1 = trim(lpre)//'_'//trim(itemc)
rcode = pio_inq_varid(cpl_io_file,trim(name1),varid)
if (present(nt)) then
frame = nt
else
frame = 1
endif
call pio_setframe(varid,frame)
call pio_write_darray(cpl_io_file, varid, iodesc, av%rattr(k,:), rcode, fillval=lfillvalue)
enddo
call pio_freedecomp(cpl_io_file, iodesc)
end if
end subroutine seq_io_write_av
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_write_int - write AV to netcdf file
!
! !DESCRIPTION:
! Write AV to netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_write_int(filename,cdata,idata,dname,whead,wdata) 1,1
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
integer(in) ,intent(in) :: idata ! data to be written
character(len=*),intent(in) :: dname ! name of data
logical,optional,intent(in) :: whead ! write header
logical,optional,intent(in) :: wdata ! write data
!EOP
integer(in) :: rcode
integer(in) :: iam
type(var_desc_t) :: varid
logical :: exists
logical :: lwhead, lwdata
character(*),parameter :: subName = '(seq_io_write_int) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
lwhead = .true.
lwdata = .true.
if (present(whead)) lwhead = whead
if (present(wdata)) lwdata = wdata
if (.not.lwhead .and. .not.lwdata) then
! should we write a warning?
return
endif
call seq_comm_setptrs(CPLID,iam=iam)
if (lwhead) then
rcode = pio_def_var(cpl_io_file,trim(dname),PIO_INT,varid)
else if (lwdata) then
rcode = pio_inq_varid(cpl_io_file,trim(dname),varid)
rcode = pio_put_var(cpl_io_file,varid,idata)
! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
endif
end subroutine seq_io_write_int
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_write_int1d - write AV to netcdf file
!
! !DESCRIPTION:
! Write AV to netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_write_int1d(filename,cdata,idata,dname,whead,wdata) 1,1
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
integer(in) ,intent(in) :: idata(:) ! data to be written
character(len=*),intent(in) :: dname ! name of data
logical,optional,intent(in) :: whead ! write header
logical,optional,intent(in) :: wdata ! write data
!EOP
integer(in) :: rcode
integer(in) :: iam
integer(in) :: dimid(1)
type(var_desc_t) :: varid
integer(in) :: lnx
logical :: exists
logical :: lwhead, lwdata
character(*),parameter :: subName = '(seq_io_write_int1d) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
lwhead = .true.
lwdata = .true.
if (present(whead)) lwhead = whead
if (present(wdata)) lwdata = wdata
if (.not.lwhead .and. .not.lwdata) then
! should we write a warning?
return
endif
call seq_comm_setptrs(CPLID,iam=iam)
lnx = size(idata)
if (lwhead) then
rcode = pio_def_dim(cpl_io_file,trim(dname)//'_nx',lnx,dimid(1))
rcode = pio_def_var(cpl_io_file,trim(dname),PIO_INT,dimid,varid)
else if (lwdata) then
rcode = pio_inq_varid(cpl_io_file,trim(dname),varid)
rcode = pio_put_var(cpl_io_file,varid,idata)
endif
! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
end subroutine seq_io_write_int1d
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_write_r8 - write AV to netcdf file
!
! !DESCRIPTION:
! Write AV to netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_write_r8(filename,cdata,rdata,dname,whead,wdata) 1,1
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
real(r8) ,intent(in) :: rdata ! data to be written
character(len=*),intent(in) :: dname ! name of data
logical,optional,intent(in) :: whead ! write header
logical,optional,intent(in) :: wdata ! write data
!EOP
integer(in) :: rcode
integer(in) :: iam
type(var_desc_t) :: varid
logical :: exists
logical :: lwhead, lwdata
character(*),parameter :: subName = '(seq_io_write_r8) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
lwhead = .true.
lwdata = .true.
if (present(whead)) lwhead = whead
if (present(wdata)) lwdata = wdata
if (.not.lwhead .and. .not.lwdata) then
! should we write a warning?
return
endif
call seq_comm_setptrs(CPLID,iam=iam)
if (lwhead) then
rcode = pio_def_var(cpl_io_file,trim(dname),PIO_DOUBLE,varid)
endif
if (lwdata) then
rcode = pio_inq_varid(cpl_io_file,trim(dname),varid)
rcode = pio_put_var(cpl_io_file,varid,rdata)
endif
end subroutine seq_io_write_r8
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_write_r81d - write AV to netcdf file
!
! !DESCRIPTION:
! Write AV to netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_write_r81d(filename,cdata,rdata,dname,whead,wdata) 1,1
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
real(r8) ,intent(in) :: rdata(:) ! data to be written
character(len=*),intent(in) :: dname ! name of data
logical,optional,intent(in) :: whead ! write header
logical,optional,intent(in) :: wdata ! write data
!EOP
integer(in) :: rcode
integer(in) :: mpicom
integer(in) :: iam
integer(in) :: dimid(1)
type(var_desc_t) :: varid
integer(in) :: lnx
logical :: exists
logical :: lwhead, lwdata
character(*),parameter :: subName = '(seq_io_write_r81d) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
lwhead = .true.
lwdata = .true.
if (present(whead)) lwhead = whead
if (present(wdata)) lwdata = wdata
if (.not.lwhead .and. .not.lwdata) then
! should we write a warning?
return
endif
call seq_comm_setptrs(CPLID,iam=iam)
lnx = size(rdata)
if (lwhead) then
rcode = pio_def_dim(cpl_io_file,trim(dname)//'_nx',lnx,dimid(1))
rcode = pio_def_var(cpl_io_file,trim(dname),PIO_DOUBLE,dimid,varid)
else if (lwdata) then
rcode = pio_inq_varid(cpl_io_file,trim(dname),varid)
rcode = pio_put_var(cpl_io_file,varid,rdata)
! write(logunit,*) subname,' wrote AV ',trim(dname),lwhead,lwdata
endif
end subroutine seq_io_write_r81d
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_write_time - write time variable to netcdf file
!
! !DESCRIPTION:
! Write time variable to netcdf file
!
! !REVISION HISTORY:
! 2009-Feb-11 - M. Vertenstein - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_write_time(filename,time_units,time_cal,time_val,nt,whead,wdata,tbnds) 1,1
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
character(len=*),intent(in) :: time_units ! units of time
character(len=*),intent(in) :: time_cal ! calendar type
real(r8) ,intent(in) :: time_val ! data to be written
integer(in),optional,intent(in) :: nt
logical,optional,intent(in) :: whead ! write header
logical,optional,intent(in) :: wdata ! write data
real(r8),optional,intent(in) :: tbnds(2) ! time bounds
!EOP
integer(in) :: rcode
integer(in) :: iam
integer(in) :: dimid(1)
integer(in) :: dimid2(2)
type(var_desc_t) :: varid
integer(in) :: lnx
logical :: exists
logical :: lwhead, lwdata
integer :: start(4),count(4)
real(r8) :: time_val_1d(1)
character(*),parameter :: subName = '(seq_io_write_time) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
lwhead = .true.
lwdata = .true.
if (present(whead)) lwhead = whead
if (present(wdata)) lwdata = wdata
if (.not.lwhead .and. .not.lwdata) then
! should we write a warning?
return
endif
call seq_comm_setptrs(CPLID,iam=iam)
if (lwhead) then
rcode = pio_def_dim(cpl_io_file,'time',PIO_UNLIMITED,dimid(1))
rcode = pio_def_var(cpl_io_file,'time',PIO_DOUBLE,dimid,varid)
rcode = pio_put_att(cpl_io_file,varid,'units',trim(time_units))
if (trim(time_cal) == 'NO_LEAP') then
rcode = pio_put_att(cpl_io_file,varid,'calendar','noleap')
else if (trim(time_cal) == 'GREGORIAN') then
rcode = pio_put_att(cpl_io_file,varid,'calendar','365_day')
else
rcode = pio_put_att(cpl_io_file,varid,'calendar','time_cal')
end if
if (present(tbnds)) then
rcode = pio_put_att(cpl_io_file,varid,'bounds','time_bnds')
dimid2(2)=dimid(1)
rcode = pio_def_dim(cpl_io_file,'ntb',2,dimid2(1))
rcode = pio_def_var(cpl_io_file,'time_bnds',PIO_DOUBLE,dimid2,varid)
endif
else if (lwdata) then
start = 1
count = 1
if (present(nt)) then
start(1) = nt
endif
time_val_1d(1) = time_val
rcode = pio_inq_varid(cpl_io_file,'time',varid)
rcode = pio_put_var(cpl_io_file,varid,start,count,time_val_1d)
if (present(tbnds)) then
rcode = pio_inq_varid(cpl_io_file,'time_bnds',varid)
start = 1
count = 1
if (present(nt)) then
start(2) = nt
endif
count(1) = 2
rcode = pio_put_var(cpl_io_file,varid,start,count,tbnds)
endif
! write(logunit,*) subname,' wrote time ',lwhead,lwdata
endif
end subroutine seq_io_write_time
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_read_av - read AV from netcdf file
!
! !DESCRIPTION:
! Read AV from netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_read_av(filename,cdata,AV,dname,pre) 1,4
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
type(mct_aVect) ,intent(inout):: AV ! data to be written
character(len=*),intent(in) :: dname ! name of data
character(len=*),intent(in),optional :: pre ! prefix name
!EOP
integer(in) :: rcode
integer(in) :: iam
integer(in) :: nf,ns,ng
integer(in) :: i,j,k,n, ndims
type(file_desc_t) :: pioid
integer(in) :: dimid(2)
type(var_desc_t) :: varid
integer(in) :: lnx,lny
type(mct_string) :: mstring ! mct char type
character(CL) :: itemc ! string converted to char
logical :: exists
type(mct_gsMap),pointer :: gsmap
character(*),parameter :: subName = '(seq_io_read_av) '
type(io_desc_t) :: iodesc
integer(in), pointer :: dof(:)
character(CL) :: lversion
character(CL) :: name1
character(CL) :: lpre
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
lversion = trim(version0)
lpre = trim(dname)
if (present(pre)) then
lpre = trim(pre)
endif
call seq_cdata_setptrs(cdata,gsmap=gsmap)
call seq_comm_setptrs(CPLID,iam=iam)
call mct_gsmap_OrderedPoints(gsmap, iam, Dof)
ns = mct_aVect_lsize(AV)
nf = mct_aVect_nRattr(AV)
inquire(file=trim(filename),exist=exists)
if (exists) then
rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_io_type, trim(filename),pio_nowrite)
if(iam==0) write(logunit,*) subname,' open file ',trim(filename)
call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
else
if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname)
call shr_sys_abort()
endif
do k = 1,nf
call mct_aVect_getRList(mstring,k,AV)
itemc = mct_string_toChar(mstring)
call mct_string_clean(mstring)
if (trim(lversion) == trim(version)) then
name1 = trim(lpre)//'_'//trim(itemc)
else
name1 = trim(prefix)//trim(dname)//'_'//trim(itemc)
endif
call pio_seterrorhandling(pioid, PIO_BCAST_ERROR)
rcode = pio_inq_varid(pioid,trim(name1),varid)
if (rcode == pio_noerr) then
if (k==1) then
rcode = pio_inq_varndims(pioid, varid, ndims)
rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims))
rcode = pio_inq_dimlen(pioid, dimid(1), lnx)
if (ndims==2) then
rcode = pio_inq_dimlen(pioid, dimid(2), lny)
else
lny = 1
end if
ng = lnx * lny
if (ng /= mct_gsmap_gsize(gsmap)) then
if (iam==0) write(logunit,*) subname,' ERROR: dimensions do not match',&
lnx,lny,mct_gsmap_gsize(gsmap)
call shr_sys_abort()
end if
call pio_initdecomp(cpl_io_subsystem, pio_double, (/lnx,lny/), dof, iodesc)
deallocate(dof)
end if
call pio_read_darray(pioid,varid,iodesc, av%rattr(k,:), rcode)
else
write(logunit,*)'seq_io_readav warning: field ',trim(itemc),' is not on restart file'
write(logunit,*)'for backwards compatibility will set it to 0'
av%rattr(k,:) = 0.0_r8
end if
call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
!--- zero out fill value, this is somewhat arbitrary
do n = 1,ns
if (AV%rAttr(k,n) == fillvalue) then
AV%rAttr(k,n) = 0.0_r8
endif
enddo
enddo
call pio_freedecomp(pioid, iodesc)
call pio_closefile(pioid)
end subroutine seq_io_read_av
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_read_int - read AV from netcdf file
!
! !DESCRIPTION:
! Read AV from netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_read_int(filename,cdata,idata,dname) 1,1
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
integer ,intent(inout):: idata ! integer data
character(len=*),intent(in) :: dname ! name of data
!EOP
integer :: i1d(1)
character(*),parameter :: subName = '(seq_io_read_int) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
call seq_io_read_int1d(filename,cdata,i1d,dname)
idata = i1d(1)
end subroutine seq_io_read_int
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_read_int1d - read AV from netcdf file
!
! !DESCRIPTION:
! Read AV from netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_read_int1d(filename,cdata,idata,dname) 2,2
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
integer(in) ,intent(inout):: idata(:) ! integer data
character(len=*),intent(in) :: dname ! name of data
!EOP
integer(in) :: rcode
integer(in) :: iam
type(file_desc_t) :: pioid
type(var_desc_t) :: varid
logical :: exists
character(CL) :: lversion
character(CL) :: name1
character(*),parameter :: subName = '(seq_io_read_int1d) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
call seq_comm_setptrs(CPLID,iam=iam)
lversion=trim(version0)
inquire(file=trim(filename),exist=exists)
if (exists) then
rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_io_type, trim(filename),pio_nowrite)
! write(logunit,*) subname,' open file ',trim(filename)
call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
else
if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname)
call shr_sys_abort()
endif
if (trim(lversion) == trim(version)) then
name1 = trim(dname)
else
name1 = trim(prefix)//trim(dname)
endif
rcode = pio_inq_varid(pioid,trim(name1),varid)
rcode = pio_get_var(pioid,varid,idata)
call pio_closefile(pioid)
! write(logunit,*) subname,' read int ',trim(dname)
end subroutine seq_io_read_int1d
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_read_r8 - read AV from netcdf file
!
! !DESCRIPTION:
! Read AV from netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_read_r8(filename,cdata,rdata,dname) 1,1
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
real(r8) ,intent(inout):: rdata ! integer data
character(len=*),intent(in) :: dname ! name of data
!EOP
real(r8) :: r1d(1)
character(*),parameter :: subName = '(seq_io_read_r8) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
call seq_io_read_r81d(filename,cdata,r1d,dname)
rdata = r1d(1)
end subroutine seq_io_read_r8
!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: seq_io_read_r81d - read AV from netcdf file
!
! !DESCRIPTION:
! Read AV from netcdf file
!
! !REVISION HISTORY:
! 2007-Oct-26 - T. Craig - initial version
!
! !INTERFACE: ------------------------------------------------------------------
subroutine seq_io_read_r81d(filename,cdata,rdata,dname) 2,2
! !INPUT/OUTPUT PARAMETERS:
implicit none
character(len=*),intent(in) :: filename ! file
type(seq_cdata) ,intent(in) :: cdata ! cdata associated with AV
real(r8) ,intent(inout):: rdata(:) ! integer data
character(len=*),intent(in) :: dname ! name of data
!EOP
integer(in) :: rcode
integer(in) :: mpicom
integer(in) :: iam
type(file_desc_T) :: pioid
type(var_desc_t) :: varid
logical :: exists
character(CL) :: lversion
character(CL) :: name1
character(*),parameter :: subName = '(seq_io_read_r81d) '
!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------
call seq_comm_setptrs(CPLID,iam=iam)
lversion=trim(version0)
inquire(file=trim(filename),exist=exists)
if (exists) then
rcode = pio_openfile(cpl_io_subsystem, pioid, cpl_io_type, trim(filename),pio_nowrite)
! write(logunit,*) subname,' open file ',trim(filename)
call pio_seterrorhandling(pioid,PIO_BCAST_ERROR)
rcode = pio_get_att(pioid,pio_global,"file_version",lversion)
call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR)
else
if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname)
call shr_sys_abort()
endif
if (trim(lversion) == trim(version)) then
name1 = trim(dname)
else
name1 = trim(prefix)//trim(dname)
endif
rcode = pio_inq_varid(pioid,trim(name1),varid)
rcode = pio_get_var(pioid,varid,rdata)
call pio_closefile(pioid)
! write(logunit,*) subname,' read int ',trim(dname)
end subroutine seq_io_read_r81d
!===============================================================================
end module seq_io_mod