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

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,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 clim_state_rec,   only: write_restart, write_restartfi, write_restartpem
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
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), optional,            intent(in)    :: backup_idt
real(dp),       dimension(:,:),   intent(inout) :: h2o_ice, co2_ice

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

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

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

! Build soil for the PCM
if (do_soil) then
    allocate(tsoil4PCM(ngrid,nsoil_PCM,nslope),inertiesoil4PCM(ngrid,nsoil_PCM,nslope),flux_geo4PCM(ngrid,nslope))
    call build4PCM_soil(tsoil_avg,tsoil_dev,inertiesoil4PCM,tsoil4PCM,flux_geo4PCM)
end if

! Build atmosphere for the PCM
allocate(ps4PCM(ngrid),teta4PCM(ngrid,nlayer),air_mass4PCM(ngrid,nlayer))
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
allocate(q4PCM(ngrid,nlayer,nq))
call build4PCM_tracers(ps4PCM,q4PCM)

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

! Write restart files
call write_restartpem(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)
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

! Deallocation
if (allocated(emissivity4PCM)) deallocate(emissivity4PCM)
if (allocated(albedo4PCM)) deallocate(albedo4PCM)
if (allocated(q4PCM)) deallocate(q4PCM)
if (allocated(ps4PCM)) deallocate(ps4PCM)
if (allocated(teta4PCM)) deallocate(teta4PCM)
if (allocated(air_mass4PCM)) deallocate(air_mass4PCM)
if (allocated(tsoil4PCM)) deallocate(tsoil4PCM)
if (allocated(inertiesoil4PCM)) deallocate(inertiesoil4PCM)
if (allocated(flux_geo4PCM)) deallocate(flux_geo4PCM)
if (allocated(tsurf4PCM)) deallocate(tsurf4PCM)
if (allocated(co2_ice4PCM)) deallocate(co2_ice4PCM)
if (allocated(h2o_ice4PCM)) deallocate(h2o_ice4PCM)
if (allocated(is_h2o_perice)) deallocate(is_h2o_perice)

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

!=======================================================================
SUBROUTINE backup_restarts(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) :: idt

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

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

call print_msg('> Backup at dt = '//int2str(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