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