427 lines
18 KiB
Fortran
427 lines
18 KiB
Fortran
module restUtilMod
|
|
|
|
!-----------------------------------------------------------------------
|
|
! provies generic routines and types for use with restart files
|
|
!
|
|
use shr_kind_mod, only: r8=>shr_kind_r8, r4 => shr_kind_r4, i4=>shr_kind_i4
|
|
use shr_sys_mod, only: shr_sys_abort
|
|
use spmdMod, only: masterproc
|
|
use clm_varctl, only: iulog
|
|
use clm_varcon, only: spval, ispval
|
|
use ncdio_pio
|
|
use pio
|
|
!
|
|
implicit none
|
|
save
|
|
private
|
|
! save
|
|
!
|
|
!-----------------------------------------------------------------------
|
|
|
|
interface restartvar
|
|
!DIMS 0,1,2
|
|
!TYPE text,int,double
|
|
module procedure restartvar_{DIMS}d_{TYPE}
|
|
module procedure restartvar_2d_double_bounds
|
|
end interface restartvar
|
|
|
|
integer,parameter, public :: iflag_interp = 1
|
|
integer,parameter, public :: iflag_copy = 2
|
|
integer,parameter, public :: iflag_skip = 3
|
|
integer,parameter, public :: iflag_noswitchdim = 0
|
|
integer,parameter, public :: iflag_switchdim = 1
|
|
|
|
public :: restartvar
|
|
|
|
private :: is_restart
|
|
|
|
contains
|
|
|
|
!-----------------------------------------------------------------------
|
|
!DIMS 0
|
|
!TYPE text,int,double
|
|
subroutine restartvar_{DIMS}d_{TYPE}(&
|
|
ncid, flag, varname, xtype, &
|
|
long_name, units, interpinic_flag, data, readvar, &
|
|
comment, flag_meanings, missing_value, fill_value, &
|
|
imissing_value, ifill_value, flag_values, nvalid_range )
|
|
|
|
!----------------------------------------------------
|
|
! Arguments
|
|
type(file_desc_t) , intent(inout) :: ncid ! netcdf file id
|
|
character(len=*) , intent(in) :: flag ! 'read' or 'write'
|
|
character(len=*) , intent(in) :: varname ! variable name
|
|
integer , intent(in) :: xtype ! netcdf data type
|
|
character(len=*) , intent(in) :: long_name ! long name for variable
|
|
character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic
|
|
{VTYPE} , intent(inout) :: data{DIMSTR}
|
|
logical , intent(out) :: readvar ! was var read?
|
|
character(len=*) , intent(in), optional :: units ! long name for variable
|
|
character(len=*) , intent(in), optional :: comment ! attribute
|
|
character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute
|
|
real(r8) , intent(in), optional :: missing_value ! attribute for real
|
|
real(r8) , intent(in), optional :: fill_value ! attribute for real
|
|
integer , intent(in), optional :: imissing_value ! attribute for int
|
|
integer , intent(in), optional :: ifill_value ! attribute for int
|
|
integer , intent(in), optional :: flag_values(:) ! attribute for int
|
|
integer , intent(in), optional :: nvalid_range(2) ! attribute for int
|
|
!
|
|
! Local variables
|
|
integer :: ivalue
|
|
type(var_desc_t) :: vardesc ! local vardesc
|
|
integer :: status ! return error code
|
|
integer :: varid
|
|
integer :: lxtype ! local external type (in case logical variable)
|
|
!----------------------------------------------------
|
|
|
|
if (flag == 'define') then
|
|
|
|
if ( xtype == ncd_log )then
|
|
lxtype = ncd_int
|
|
else
|
|
lxtype = xtype
|
|
end if
|
|
|
|
call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, &
|
|
long_name=trim(long_name), units=units)
|
|
|
|
status = PIO_inq_varid(ncid, trim(varname), vardesc)
|
|
varid = vardesc%varid
|
|
|
|
if (trim(interpinic_flag) == 'interp') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp)
|
|
else if (trim(interpinic_flag) == 'copy') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy)
|
|
else if (trim(interpinic_flag) == 'skip') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip)
|
|
end if
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', &
|
|
"1=nearest neighbor, 2=copy directly, 3=skip")
|
|
|
|
if (present(comment)) then
|
|
call ncd_putatt(ncid, varid, 'comment', trim(comment))
|
|
end if
|
|
if (present(units)) then
|
|
call ncd_putatt(ncid, varid, 'units', trim(units))
|
|
end if
|
|
if (present(fill_value)) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype)
|
|
else if (lxtype == ncd_double) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype)
|
|
end if
|
|
if (present(missing_value)) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype)
|
|
else if (lxtype == ncd_double) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype)
|
|
end if
|
|
if (present(ifill_value)) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype)
|
|
else if (lxtype == ncd_int) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype)
|
|
end if
|
|
if (present(imissing_value)) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype)
|
|
else if (lxtype == ncd_int) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype)
|
|
end if
|
|
if ( xtype == ncd_log )then
|
|
status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) )
|
|
status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" )
|
|
status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) )
|
|
end if
|
|
|
|
else if (flag == 'read' .or. flag == 'write') then
|
|
|
|
#if ({ITYPE}!=TYPETEXT)
|
|
call ncd_io(varname=trim(varname), data=data, &
|
|
ncid=ncid, flag=flag, readvar=readvar)
|
|
#endif
|
|
end if
|
|
|
|
if (flag == 'read') then
|
|
if (.not. readvar .and. is_restart()) call shr_sys_abort()
|
|
end if
|
|
|
|
end subroutine restartvar_{DIMS}d_{TYPE}
|
|
|
|
!-----------------------------------------------------------------------
|
|
!DIMS 1,2
|
|
!TYPE text,int,double
|
|
subroutine restartvar_{DIMS}d_{TYPE}(&
|
|
ncid, flag, varname, xtype, dim1name, dim2name, &
|
|
long_name, units, interpinic_flag, data, readvar, &
|
|
comment, flag_meanings, missing_value, fill_value, &
|
|
imissing_value, ifill_value, flag_values, nvalid_range )
|
|
|
|
!----------------------------------------------------
|
|
! Arguments
|
|
type(file_desc_t) , intent(inout) :: ncid ! netcdf file id
|
|
character(len=*) , intent(in) :: flag ! 'read' or 'write'
|
|
character(len=*) , intent(in) :: varname ! variable name
|
|
integer , intent(in) :: xtype ! netcdf data type
|
|
character(len=*) , intent(in) :: long_name ! long name for variable
|
|
character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic
|
|
{VTYPE} , pointer :: data{DIMSTR}
|
|
logical , intent(inout) :: readvar ! was var read?
|
|
character(len=*) , intent(in), optional :: dim1name ! dimension name
|
|
character(len=*) , intent(in), optional :: dim2name ! dimension name
|
|
character(len=*) , intent(in), optional :: units ! long name for variable
|
|
character(len=*) , intent(in), optional :: comment ! attribute
|
|
character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute
|
|
real(r8) , intent(in), optional :: missing_value ! attribute for real
|
|
real(r8) , intent(in), optional :: fill_value ! attribute for real
|
|
integer , intent(in), optional :: imissing_value ! attribute for int
|
|
integer , intent(in), optional :: ifill_value ! attribute for int
|
|
integer , intent(in), optional :: flag_values(:) ! attribute for int
|
|
integer , intent(in), optional :: nvalid_range(2) ! attribute for int
|
|
!
|
|
! Local variables
|
|
integer :: ivalue
|
|
type(var_desc_t) :: vardesc ! local vardesc
|
|
integer :: status ! return error code
|
|
integer :: varid
|
|
integer :: lxtype ! local external type (in case logical variable)
|
|
!----------------------------------------------------
|
|
|
|
if (flag == 'define') then
|
|
|
|
if ( xtype == ncd_log )then
|
|
lxtype = ncd_int
|
|
else
|
|
lxtype = xtype
|
|
end if
|
|
|
|
if (.not. present(dim1name)) then
|
|
call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, &
|
|
long_name=trim(long_name), units=units)
|
|
else if (.not. present(dim2name)) then
|
|
call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, &
|
|
dim1name=trim(dim1name), &
|
|
long_name=trim(long_name), units=units)
|
|
else if (present(dim2name)) then
|
|
call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, &
|
|
dim1name=trim(dim1name), dim2name=trim(dim2name), &
|
|
long_name=trim(long_name), units=units)
|
|
end if
|
|
|
|
status = PIO_inq_varid(ncid, trim(varname), vardesc)
|
|
varid = vardesc%varid
|
|
|
|
if (trim(interpinic_flag) == 'interp') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp)
|
|
else if (trim(interpinic_flag) == 'copy') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy)
|
|
else if (trim(interpinic_flag) == 'skip') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip)
|
|
end if
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', &
|
|
"1=nearest neighbor, 2=copy directly, 3=skip")
|
|
|
|
if (present(comment)) then
|
|
call ncd_putatt(ncid, varid, 'comment', trim(comment))
|
|
end if
|
|
if (present(units)) then
|
|
call ncd_putatt(ncid, varid, 'units', trim(units))
|
|
end if
|
|
|
|
if (present(fill_value)) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype)
|
|
else if (lxtype == ncd_double) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype)
|
|
end if
|
|
if (present(missing_value)) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype)
|
|
else if (lxtype == ncd_double) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype)
|
|
end if
|
|
if (present(ifill_value)) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype)
|
|
else if (lxtype == ncd_int) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype)
|
|
end if
|
|
if (present(imissing_value)) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype)
|
|
else if (lxtype == ncd_int) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype)
|
|
end if
|
|
if (present(nvalid_range)) then
|
|
status = PIO_put_att(ncid,varid,'valid_range', nvalid_range )
|
|
end if
|
|
if ( xtype == ncd_log )then
|
|
status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) )
|
|
status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" )
|
|
status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) )
|
|
end if
|
|
|
|
else if (flag == 'read' .or. flag == 'write') then
|
|
|
|
#if ({ITYPE}!=TYPETEXT)
|
|
if (.not. present(dim1name)) then
|
|
call ncd_io(varname=trim(varname), data=data, &
|
|
ncid=ncid, flag=flag, readvar=readvar)
|
|
else
|
|
call ncd_io(varname=trim(varname), data=data, &
|
|
dim1name=trim(dim1name), ncid=ncid, flag=flag, readvar=readvar)
|
|
end if
|
|
#endif
|
|
end if
|
|
|
|
if (flag == 'read') then
|
|
if (.not. readvar .and. is_restart()) call shr_sys_abort()
|
|
end if
|
|
|
|
end subroutine restartvar_{DIMS}d_{TYPE}
|
|
|
|
!-----------------------------------------------------------------------
|
|
|
|
subroutine restartvar_2d_double_bounds(ncid, flag, varname, xtype, &
|
|
dim1name, dim2name, switchdim, lowerb2, upperb2, &
|
|
long_name, units, interpinic_flag, data, readvar, &
|
|
comment, flag_meanings, missing_value, fill_value, &
|
|
imissing_value, ifill_value, flag_values, nvalid_range )
|
|
|
|
!----------------------------------------------------
|
|
! Arguments
|
|
type(file_desc_t), intent(inout) :: ncid ! netcdf file id
|
|
character(len=*) , intent(in) :: flag ! 'read' or 'write'
|
|
character(len=*) , intent(in) :: varname ! variable name
|
|
integer , intent(in) :: xtype ! netcdf data type
|
|
character(len=*) , intent(in) :: dim1name ! dimension name
|
|
character(len=*) , intent(in) :: dim2name ! dimension name
|
|
logical , intent(in) :: switchdim
|
|
character(len=*) , intent(in) :: long_name ! long name for variable
|
|
character(len=*) , intent(in) :: interpinic_flag ! interpolate variable using interpinic
|
|
real(r8) , pointer :: data(:,:) ! raw data
|
|
logical , intent(out) :: readvar ! was var read?
|
|
integer , intent(in), optional :: lowerb2
|
|
integer , intent(in), optional :: upperb2
|
|
character(len=*) , intent(in), optional :: units ! long name for variable
|
|
character(len=*) , intent(in), optional :: comment ! attribute
|
|
character(len=*) , intent(in), optional :: flag_meanings(:) ! attribute
|
|
real(r8) , intent(in), optional :: missing_value ! attribute for real
|
|
real(r8) , intent(in), optional :: fill_value ! attribute for real
|
|
integer , intent(in), optional :: imissing_value ! attribute for int
|
|
integer , intent(in), optional :: ifill_value ! attribute for int
|
|
integer , intent(in), optional :: flag_values(:) ! attribute for int
|
|
integer , intent(in), optional :: nvalid_range(2) ! attribute for int
|
|
!
|
|
! Local variables
|
|
integer :: ivalue
|
|
type(var_desc_t) :: vardesc ! local vardesc
|
|
integer :: status ! return error code
|
|
integer :: varid ! returned var id
|
|
integer :: lxtype ! local external type (in case logical variable)
|
|
!----------------------------------------------------
|
|
|
|
if (flag == 'define') then
|
|
|
|
if ( xtype == ncd_log )then
|
|
lxtype = ncd_int
|
|
else
|
|
lxtype = xtype
|
|
end if
|
|
|
|
if (switchdim) then
|
|
call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, &
|
|
dim1name=trim(dim2name), dim2name=trim(dim1name), &
|
|
long_name=trim(long_name), units=units)
|
|
else
|
|
call ncd_defvar(ncid=ncid, varname=trim(varname), xtype=lxtype, &
|
|
dim1name=trim(dim1name), dim2name=trim(dim2name), &
|
|
long_name=trim(long_name), units=units)
|
|
end if
|
|
status = PIO_inq_varid(ncid, trim(varname), vardesc)
|
|
|
|
varid = vardesc%varid
|
|
|
|
if (trim(interpinic_flag) == 'interp') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_interp)
|
|
else if (trim(interpinic_flag) == 'copy') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_copy)
|
|
else if (trim(interpinic_flag) == 'skip') then
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag', iflag_skip)
|
|
end if
|
|
status = PIO_put_att(ncid, varid, 'interpinic_flag_meanings', &
|
|
"1=>nearest_neighbor 2=>copy 3=>skip")
|
|
|
|
if (switchdim) then
|
|
status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag', 1)
|
|
else
|
|
status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag', 0)
|
|
end if
|
|
status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_values', (/0,1/))
|
|
status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_is_0', &
|
|
"1st and 2nd dims are same as model representation")
|
|
status = PIO_put_att(ncid, vardesc%varid, 'switchdim_flag_is_1', &
|
|
"1st and 2nd dims are switched from model representation")
|
|
|
|
if (present(comment)) then
|
|
call ncd_putatt(ncid, varid, 'comment', trim(comment))
|
|
end if
|
|
if (present(units)) then
|
|
call ncd_putatt(ncid, varid, 'units', trim(units))
|
|
end if
|
|
if (present(fill_value)) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', fill_value, lxtype)
|
|
else if (lxtype == ncd_double) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', spval, lxtype)
|
|
end if
|
|
if (present(missing_value)) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', missing_value, lxtype)
|
|
else if (lxtype == ncd_double) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', spval, lxtype)
|
|
end if
|
|
if (present(ifill_value)) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', ifill_value, lxtype)
|
|
else if (lxtype == ncd_int) then
|
|
call ncd_putatt(ncid, varid, '_FillValue', ispval, lxtype)
|
|
end if
|
|
if (present(imissing_value)) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', imissing_value, lxtype)
|
|
else if (lxtype == ncd_int) then
|
|
call ncd_putatt(ncid, varid, 'missing_value', ispval, lxtype)
|
|
end if
|
|
if (present(nvalid_range)) then
|
|
status = PIO_put_att(ncid,varid,'valid_range', nvalid_range )
|
|
end if
|
|
if ( xtype == ncd_log )then
|
|
status = PIO_put_att(ncid,varid,'flag_values', (/0, 1/) )
|
|
status = PIO_put_att(ncid,varid,'flag_meanings', "FALSE TRUE" )
|
|
status = PIO_put_att(ncid,varid,'valid_range', (/0, 1/) )
|
|
end if
|
|
|
|
else
|
|
|
|
if (present(lowerb2) .and. present(upperb2)) then
|
|
call ncd_io(varname=trim(varname), data=data, &
|
|
dim1name=trim(dim1name), switchdim=switchdim, &
|
|
lowerb2=lowerb2, upperb2=upperb2, &
|
|
ncid=ncid, flag=flag, readvar=readvar)
|
|
else
|
|
call ncd_io(varname=trim(varname), data=data, &
|
|
dim1name=trim(dim1name), switchdim=switchdim, &
|
|
ncid=ncid, flag=flag, readvar=readvar)
|
|
end if
|
|
|
|
end if
|
|
|
|
if (flag == 'read') then
|
|
if (.not. readvar .and. is_restart()) call shr_sys_abort()
|
|
end if
|
|
|
|
end subroutine restartvar_2d_double_bounds
|
|
|
|
|
|
!-----------------------------------------------------------------------
|
|
logical function is_restart( )
|
|
! Determine if restart run
|
|
use clm_varctl, only : nsrest, nsrContinue
|
|
if (nsrest == nsrContinue) then
|
|
is_restart = .true.
|
|
else
|
|
is_restart = .false.
|
|
end if
|
|
end function is_restart
|
|
|
|
end module restUtilMod
|