source: trunk/LMDZ.COMMON/libf/evolution/backup.F90 @ 4175

MODULE backup
!-----------------------------------------------------------------------
! NAME
!     backup
!
! DESCRIPTION
!     Build and write PEM/PCM restart files, with optional backups.
!
! AUTHORS & DATE
!     JB Clement, 03/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use numerics, only: dp, di, k4

! DECLARATION
! -----------
implicit none

! PARAMETERS
! ----------
integer(di), protected :: backup_rate = 0_di ! Backup rate in PEM timesteps (0 disables intermediate backups)

contains
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

!=======================================================================
SUBROUTINE set_backup_config(backup_rate_in)
!-----------------------------------------------------------------------
! NAME
!     set_backup_config
!
! DESCRIPTION
!     Setter for "backup" configuration parameters.
!
! AUTHORS & DATE
!     JB Clement, 03/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use utility,  only: int2str
use display,  only: print_msg, LVL_NFO
use stoppage, only: stop_clean

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
integer(di), intent(in) :: backup_rate_in

! CODE
! ----
backup_rate = backup_rate_in
call print_msg('backup_rate = '//int2str(backup_rate),LVL_NFO)
if (backup_rate < 0) call stop_clean(__FILE__,__LINE__,'''backup_rate'' must be >= 0!',1)

END SUBROUTINE set_backup_config
!=======================================================================

!=======================================================================
SUBROUTINE save_clim_state(h2o_ice,co2_ice,tsurf_avg,tsurf_dev,tsoil_avg,tsoil_dev,ps_avg,ps_dev,ps_avg_glob,ps_avg_glob_ini, &
                           icetable_depth,icetable_thickness,ice_porefilling,h2oice_depth,h2o_ads_reg,co2_ads_reg,layerings_map,backup_idt)
!-----------------------------------------------------------------------
! NAME
!     save_clim_state
!
! DESCRIPTION
!     Build PCM-compatible state and write "restartevo", "restartfi"
!     and "restart" files. Optionally create timestep-tagged backups.
!
! AUTHORS & DATE
!     JB Clement, 03/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use geometry,         only: ngrid, nslope, nsoil_PCM, nlayer
use soil,             only: do_soil, TI, build4PCM_soil
use surface,          only: build4PCM_surf_rad_prop
use surf_ice,         only: build4PCM_perice
use surf_temp,        only: build4PCM_tsurf
use atmosphere,       only: build4PCM_atmosphere
use tracers,          only: build4PCM_tracers, nq
use ice_table,        only: build4PCM_ssice
use clim_state_rec,   only: write_restart, write_restartfi, write_restartevo
use layered_deposits, only: layering

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
real(dp),       dimension(:),     intent(in)           :: ps_avg, ps_dev
real(dp),                         intent(in)           :: ps_avg_glob, ps_avg_glob_ini
real(dp),       dimension(:,:),   intent(in)           :: tsurf_avg, tsurf_dev, icetable_depth, icetable_thickness, h2oice_depth
real(dp),       dimension(:,:,:), intent(in)           :: tsoil_avg, tsoil_dev, ice_porefilling, h2o_ads_reg, co2_ads_reg
type(layering), dimension(:,:),   intent(in)           :: layerings_map
integer(di),                      intent(in), optional :: backup_idt
real(dp),       dimension(:,:),   intent(inout) :: h2o_ice, co2_ice

! LOCAL VARIABLES
! ---------------
real(dp),    dimension(ngrid,nslope)           :: h2o_ice4PCM, co2_ice4PCM, tsurf4PCM, flux_geo4PCM, albedo4PCM, emissivity4PCM, h2oice_depth4PCM
real(dp),    dimension(ngrid,nlayer)           :: teta4PCM, air_mass4PCM
real(dp),    dimension(ngrid,nsoil_PCM,nslope) :: tsoil4PCM, inertiesoil4PCM
real(dp),    dimension(ngrid,nlayer,nq)        :: q4PCM
real(dp),    dimension(ngrid)                  :: ps4PCM
logical(k4), dimension(ngrid)                  :: is_h2o_perice
real(dp)                                       :: pa4PCM, preff4PCM

! CODE
! ----
! Build ice for the PCM
call build4PCM_perice(h2o_ice,co2_ice,is_h2o_perice,h2o_ice4PCM,co2_ice4PCM)

! Build surface temperature for the PCM
call build4PCM_tsurf(tsurf_avg,tsurf_dev,tsurf4PCM)

if (do_soil) then
    ! Build soil for the PCM
    call build4PCM_soil(tsoil_avg,tsoil_dev,inertiesoil4PCM,tsoil4PCM,flux_geo4PCM)

    ! Build subsurface ice for the PCM
    call build4PCM_ssice(icetable_depth,h2oice_depth,h2oice_depth4PCM)
end if

! Build atmosphere for the PCM
call build4PCM_atmosphere(ps_avg,ps_dev,ps_avg_glob,ps_avg_glob_ini,ps4PCM,pa4PCM,preff4PCM,teta4PCM,air_mass4PCM)

! Build tracers for the PCM
call build4PCM_tracers(ps4PCM,q4PCM)

! Build surface radiative properties state for the PCM
call build4PCM_surf_rad_prop(h2o_ice,co2_ice,albedo4PCM,emissivity4PCM)

! Write restart files
call write_restartevo(h2o_ice,co2_ice,tsoil_avg,TI,icetable_depth,icetable_thickness,ice_porefilling,h2o_ads_reg,co2_ads_reg,layerings_map)
call write_restartfi(is_h2o_perice,h2o_ice4PCM,co2_ice4PCM,tsurf4PCM,tsoil4PCM,inertiesoil4PCM,albedo4PCM,emissivity4PCM,flux_geo4PCM,h2oice_depth4PCM)
call write_restart(ps4PCM,pa4PCM,preff4PCM,q4PCM,teta4PCM,air_mass4PCM)

if (present(backup_idt)) then
    if (backup_idt > 0) call backup_restarts(backup_idt)
end if

END SUBROUTINE save_clim_state
!=======================================================================

!=======================================================================
SUBROUTINE backup_restarts(backup_idt)
!-----------------------------------------------------------------------
! NAME
!     backup_restarts
!
! DESCRIPTION
!     Duplicate restart files to timestep-tagged backup files.
!
! AUTHORS & DATE
!     JB Clement, 03/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use geometry,  only: ngrid
use io_netcdf, only: start_name, start1D_name, startfi_name, startevo_name
use display,   only: print_msg, LVL_NFO
use utility,   only: int2str

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
integer(di), intent(in) :: backup_idt

! LOCAL VARIABLES
! ---------------
character(:), allocatable :: suffix

! CODE
! ----
suffix = '_ts'//int2str(backup_idt)

call print_msg('> Backup of "restart" files at dt = '//int2str(backup_idt),LVL_NFO)
call copy_restart_if_present('re'//startevo_name,suffix2filename(startevo_name,suffix))
call copy_restart_if_present('re'//startfi_name,suffix2filename(startfi_name,suffix))
if (ngrid == 1) then
    call copy_restart_if_present('re'//start1D_name,suffix2filename(start1D_name,suffix))
else
    call copy_restart_if_present('re'//start_name,suffix2filename(start_name,suffix))
end if

END SUBROUTINE backup_restarts
!=======================================================================

!=======================================================================
SUBROUTINE copy_restart_if_present(src_name,dst_name)
!-----------------------------------------------------------------------
! NAME
!     copy_restart_if_present
!
! DESCRIPTION
!     Copy file if present. Used for restart backup files.
!
! AUTHORS & DATE
!     JB Clement, 03/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use stoppage, only: stop_clean

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
character(*), intent(in) :: src_name, dst_name

! LOCAL VARIABLES
! ---------------
logical(k4) :: here
integer(di) :: cstat

! CODE
! ----
inquire(file = src_name,exist = here)
if (.not. here) return

call execute_command_line('cp '//src_name//' '//dst_name,cmdstat = cstat)
if (cstat > 0) then
    call stop_clean(__FILE__,__LINE__,'command execution failed!',1)
else if (cstat < 0) then
    call stop_clean(__FILE__,__LINE__,'command execution not supported!',1)
end if

END SUBROUTINE copy_restart_if_present
!=======================================================================

!=======================================================================
FUNCTION suffix2filename(filename,suffix_in) RESULT(name_out)
!-----------------------------------------------------------------------
! NAME
!     suffix2filename
!
! DESCRIPTION
!     Insert suffix before the extension of a filename.
!
! AUTHORS & DATE
!     JB Clement, 03/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
character(*), intent(in) :: filename, suffix_in

! LOCAL VARIABLES
! ---------------
character(:), allocatable :: name_out
integer(di)               :: ipos

! CODE
! ----
ipos = index(filename,'.',back = .true.)
if (ipos > 0) then
    name_out = filename(:ipos - 1)//suffix_in//filename(ipos:)
else
    name_out = filename//suffix_in
end if

END FUNCTION suffix2filename
!=======================================================================

END MODULE backup