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
