restart.F90

Go to the documentation of this file.

!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!! Copyright (C) 2014 M. Oliveira
!! Copyright (C) 2021 S. Ohlmann
!! Copyright (C) 2025 M. Lueders
!!
!! This program is free software; you can redistribute it and/or modify
!! it under the terms of the GNU General Public License as published by
!! the Free Software Foundation; either version 2, or (at your option)
!! any later version.
!!
!! This program is distributed in the hope that it will be useful,
!! but WITHOUT ANY WARRANTY; without even the implied warranty of
!! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!! GNU General Public License for more details.
!!
!! You should have received a copy of the GNU General Public License
!! along with this program; if not, write to the Free Software
!! Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
!! 02110-1301, USA.
!!
 
#include "global.h"
 
module restart_oct_m
  use batch_oct_m
  use calc_mode_par_oct_m
  use debug_oct_m
  use global_oct_m
  use index_oct_m
  use io_oct_m
  use io_binary_oct_m
  use loct_oct_m
  use mesh_oct_m
  use mesh_batch_oct_m
  use messages_oct_m
  use mpi_oct_m
  use multicomm_oct_m
  use namespace_oct_m
  use parser_oct_m
  use par_vec_oct_m
  use profiling_oct_m
  use space_oct_m
  use string_oct_m
  use unit_system_oct_m
  use varinfo_oct_m
 
  implicit none
 
  private
  public ::                       &
    restart_basic_t,              &
    restart_t,                    &
    clean_stop,                   &
    restart_block_signals,        &
    restart_unblock_signals
 
 
  integer, parameter :: RESTART_N_DATA_TYPES = 14
 
  integer, parameter, public :: &
    RESTART_UNDEFINED  = -1,    &
    restart_all        =  0,    &
    restart_gs         =  1,    &
    restart_unocc      =  2,    &
    restart_td         =  3,    &
    restart_em_resp    =  4,    &
    restart_em_resp_fd =  5,    &
    restart_kdotp      =  6,    &
    restart_vib_modes  =  7,    &
    restart_vdw        =  8,    &
    restart_casida     =  9,    &
    restart_oct        =  10,   &
    restart_partition  =  11,   &
    restart_proj       =  12,   &
    restart_iteration  =  13,   &
    restart_custom     =  14
 
  type restart_data_t
    private
    character(len=20) :: tag
    character(len=MAX_PATH_LEN) :: basedir
    character(len=MAX_PATH_LEN) :: dir
    integer :: flags
  end type restart_data_t
 
 
  integer, parameter, public :: &
    RESTART_TYPE_DUMP = 1,      &
    restart_type_load = 2
 
  integer, parameter, public :: &
    RESTART_FLAG_STATES = 1,    &
    restart_flag_rho    = 2,    &
    restart_flag_vhxc   = 4,    &
    restart_flag_mix    = 8,    &
    restart_flag_skip   = 16,   &
    restart_flag_literal = 32
 
  type restart_basic_data_t
    private
    character(len=20)           :: tag
    character(len=MAX_PATH_LEN) :: dir
    !                                                 !! These will be appended to the basedir
    integer                     :: default_flags = 0
  end type restart_basic_data_t
 
  character(len=4), parameter :: type_string(2) = (/ "DUMP", "LOAD"/)
 
 
  !
  type restart_basic_t
    private
    type(namespace_t), pointer, public :: namespace
    integer           :: data_type = restart_undefined 
    integer           :: type = restart_undefined      
    logical           :: skip_
    character(len=MAX_PATH_LEN) :: dir_
    character(len=MAX_PATH_LEN) :: pwd
    !                                                  !! from or dumped to. It can be either dir or a subdirectory of dir.
    !                                                  !! pwd is set by restart_basic_open_dir()/restart_basic_close_dir()
    character(len=MAX_PATH_LEN), public :: basedir
    integer                             :: flags
    type(mpi_grp_t) , public            :: mpi_grp
    logical                             :: initialized = .false.
  contains
    !note: the generic name 'init' here is introduced to be able to combine the two functions (restart_basic_init and restart_init)
    !      with a common name, despite having a different signature (optional arguments in restart_init)
    procedure, private :: restart_basic_init
    generic   :: init => restart_basic_init
    procedure :: end => restart_basic_end
    procedure :: open => restart_basic_open
    procedure :: close => restart_basic_close
    procedure :: open_dir => restart_basic_open_dir
    procedure :: close_dir => restart_basic_close_dir
    procedure :: mkdir => restart_basic_mkdir
    procedure :: dir => restart_basic_dir
    procedure :: rm => restart_basic_rm
    procedure :: read => restart_basic_read
    procedure :: write => restart_basic_write
    procedure :: get_data_type => restart_basic_get_data_type
    procedure :: get_info => restart_basic_get_info
    procedure :: do_i_write => restart_basic_do_i_write
    procedure :: skip => restart_basic_skip
    procedure :: has_flag => restart_basic_has_flag
  end type
 
  type, extends(restart_basic_t) :: restart_t
    private
    type(multicomm_t), pointer  :: mc
    logical                     :: has_mesh
    !                                                !! and mesh functions cannot be written or read.
    integer(int64), allocatable :: map(:)
    !                                                !! used in the current calculations.
    integer, public :: file_format_states
 
  contains
    !note: the generic name 'init' here is introduced to be able to combine the two functions (restart_basic_init and restart_init)
    !      with a common name, despite having a different signature (optional arguments in restart_init)
    procedure, private :: restart_init
    generic :: init => restart_init
    procedure :: end => restart_end
    procedure :: has_map => restart_has_map
    procedure, private :: drestart_write_mesh_function, zrestart_write_mesh_function
    generic :: write_mesh_function => drestart_write_mesh_function, zrestart_write_mesh_function
    procedure, private :: drestart_read_mesh_function, zrestart_read_mesh_function
    generic :: read_mesh_function => drestart_read_mesh_function, zrestart_read_mesh_function
    procedure, private :: drestart_write_binary1, drestart_write_binary2, drestart_write_binary3, drestart_write_binary5, &
      drestart_write_binary1_int32, drestart_write_binary2_int32, drestart_write_binary3_int32, drestart_write_binary5_int32
    procedure, private :: zrestart_write_binary1, zrestart_write_binary2, zrestart_write_binary3, zrestart_write_binary5, &
      zrestart_write_binary1_int32, zrestart_write_binary2_int32, zrestart_write_binary3_int32, zrestart_write_binary5_int32
    generic :: write_binary => drestart_write_binary1, drestart_write_binary2, drestart_write_binary3, drestart_write_binary5, &
      drestart_write_binary1_int32, drestart_write_binary2_int32, drestart_write_binary3_int32, drestart_write_binary5_int32, &
      zrestart_write_binary1, zrestart_write_binary2, zrestart_write_binary3, zrestart_write_binary5, &
      zrestart_write_binary1_int32, zrestart_write_binary2_int32, zrestart_write_binary3_int32, zrestart_write_binary5_int32
    procedure, private :: drestart_read_binary1, drestart_read_binary2, drestart_read_binary3, drestart_read_binary5, &
      drestart_read_binary1_int32, drestart_read_binary2_int32, drestart_read_binary3_int32, drestart_read_binary5_int32
    procedure, private :: zrestart_read_binary1, zrestart_read_binary2, zrestart_read_binary3, zrestart_read_binary5, &
      zrestart_read_binary1_int32, zrestart_read_binary2_int32, zrestart_read_binary3_int32, zrestart_read_binary5_int32
    generic :: read_binary => drestart_read_binary1, drestart_read_binary2, drestart_read_binary3, drestart_read_binary5, &
      drestart_read_binary1_int32, drestart_read_binary2_int32, drestart_read_binary3_int32, drestart_read_binary5_int32, &
      zrestart_read_binary1, zrestart_read_binary2, zrestart_read_binary3, zrestart_read_binary5, &
      zrestart_read_binary1_int32, zrestart_read_binary2_int32, zrestart_read_binary3_int32, zrestart_read_binary5_int32
    procedure :: get_info => restart_get_info
 
  end type restart_t
 
  type(restart_basic_data_t), parameter :: basic_info(restart_undefined:restart_n_data_types)= [&
    restart_basic_data_t("Undefined", ""), &
    restart_basic_data_t("All", ""), &
    restart_basic_data_t("Ground-state", gs_dir), &
    restart_basic_data_t("Unoccupied states", gs_dir), &
    restart_basic_data_t("Time-dependent", td_dir), &
    restart_basic_data_t("EM Resp.", em_resp_dir), &
    restart_basic_data_t("EM Resp. FD", em_resp_fd_dir), &
    restart_basic_data_t("KdotP", kdotp_dir), &
    restart_basic_data_t("Vib. Modes", vib_modes_dir), &
    restart_basic_data_t("VdW", vdw_dir), &
    restart_basic_data_t("Casida", casida_dir), &
    restart_basic_data_t("Optimal Control", oct_dir), &
    restart_basic_data_t("Mesh Partition", partition_dir, restart_flag_skip), &
    restart_basic_data_t("GS for TDOutput", gs_dir), &
    restart_basic_data_t("Iteration counter", iteration_dir), &
    restart_basic_data_t("Custom data", "") &
    ]
 
 
  ! from signals.c
  interface restart_block_signals
    subroutine block_signals()
      implicit none
    end subroutine block_signals
  end interface restart_block_signals
 
  interface restart_unblock_signals
    subroutine unblock_signals()
      implicit none
    end subroutine unblock_signals
  end interface
 
contains
 
  function clean_stop(comm)
    type(mpi_comm), intent(in) :: comm
    logical :: clean_stop
 
    logical :: file_exists
 
    push_sub(clean_stop)
 
    clean_stop = .false.
 
    if (mpi_world%is_root()) then
      inquire(file='stop', exist=file_exists)
      if (file_exists) then
        call loct_rm('stop')
        clean_stop = .true.
      end if
    end if
 
#ifdef HAVE_MPI
    ! make sure all nodes agree on whether this condition occurred
    call mpi_bcast(clean_stop, 1, mpi_logical, 0, comm)
#endif
 
    if (clean_stop) then
      message(1) = 'Clean STOP'
      call messages_warning(1)
    end if
 
    pop_sub(clean_stop)
  end function clean_stop
 
 
  subroutine restart_basic_init(restart, namespace, data_type, type, ierr, dir)
    class(restart_basic_t),      intent(out) :: restart
    type(namespace_t), target,   intent(in)  :: namespace
    integer,                     intent(in)  :: data_type
    integer,                     intent(in)  :: type
    integer,                     intent(out) :: ierr
    character(len=*),  optional, intent(in)  :: dir
 
    character(len=MAX_PATH_LEN) :: basedir, dirname
    integer :: iline, n_cols, idata_type, i
    character(len=MAX_PATH_LEN) :: default_basedir
    character(len=20) :: tag
    type(block_t) :: blk
    logical :: restart_write, dir_exists
    character(len=MAX_NAMESPACE_LEN) :: namespace_prefix
 
 
    push_sub(restart_basic_init)
 
    ! Some initializations
    restart%type = type
 
    namespace_prefix = trim(namespace%get())
 
    default_basedir = trim(io_workdir())//'/restart/'
    restart%basedir = default_basedir
    restart%skip_ = .false.
    restart%data_type = data_type
    if(data_type>0 .and. data_type<=restart_n_data_types) then
      restart%flags = basic_info(data_type)%default_flags
    else
      restart%flags = 0
    end if
 
    if (data_type < restart_undefined .and. data_type > restart_n_data_types) then
      message(1) = "Illegal data_type in restart_init"
      call messages_fatal(1, namespace=namespace)
    end if
    restart%namespace => namespace
 
    ierr = 0
 
    ! Read input
    call messages_obsolete_variable(namespace, 'RestartFileFormat', 'RestartOptions')
    call messages_obsolete_variable(namespace, 'TmpDir', 'RestartOptions')
    call messages_obsolete_variable(namespace, 'RestartDir', 'RestartOptions')
    call messages_obsolete_variable(namespace, 'MeshPartitionRead', 'RestartOptions')
    call messages_obsolete_variable(namespace, 'MeshPartitionWrite', 'RestartOptions')
    call messages_obsolete_variable(namespace, 'MeshPartitionDir', 'RestartOptions')
 
    !%Variable RestartOptions
    !%Type block
    !%Section Execution::IO
    !%Description
    !% <tt>Octopus</tt> usually stores binary information, such as the wavefunctions, to be used
    !% in subsequent calculations. The most common example is the ground-state states
    !% that are used to start a time-dependent calculation. This variable allows to control
    !% where this information is written to or read from. The format of this block is the following:
    !% for each line, the first column indicates the type of data, the second column indicates
    !% the path to the directory that should be used to read and write that restart information, and the
    !% third column, which is optional, allows one to set some flags to modify the way how the data
    !% is read or written. For example, if you are running a time-dependent calculation, you can
    !% indicate where <tt>Octopus</tt> can find the ground-state information in the following way:
    !%
    !% <tt>%RestartOptions
    !% <br>&nbsp;&nbsp;restart_gs | "gs_restart"
    !% <br>&nbsp;&nbsp;restart_td | "td_restart"
    !% <br>%</tt>
    !%
    !% The second line of the above example also tells <tt>Octopus</tt> that the time-dependent restart data
    !% should be read from and written to the "td_restart" directory.
    !%
    !% In case you want to change the path of all the restart directories, you can use the <tt>restart_all</tt> option.
    !% When using the <tt>restart_all</tt> option, it is still possible to have a different restart directory for specific
    !% data types. For example, when including the following block in your input file:
    !%
    !% <tt>%RestartOptions
    !% <br>&nbsp;&nbsp;restart_all | "my_restart"
    !% <br>&nbsp;&nbsp;restart_td&nbsp;  | "td_restart"
    !% <br>%</tt>
    !%
    !% the time-dependent restart information will be stored in the "td_restart" directory, while all the remaining
    !% restart information will be stored in the "my_restart" directory.
    !%
    !% By default, the name of the "restart_all" directory is set to "restart".
    !%
    !%
    !% For multisystem calculations, the namespace of each system is inserted between the `restart top` folder and the specific
    !% directory for each data type. When specifying a folder for a given system, the corresponding namespace is added
    !% automatically to the folder name, unless the flag `restart_literal` is added.
    !%
    !% Some <tt>CalculationMode</tt>s also take into account specific flags set in the third column of the <tt>RestartOptions</tt>
    !% block. These are used to determine if some specific part of the restart data is to be taken into account
    !% or not when reading the restart information. For example, when restarting a ground-state calculation, one can
    !% set the <tt>restart_rho</tt> flags, so that the density used is not built from the saved wavefunctions, but is
    !% instead read from the restart directory. In this case, the block should look like this:
    !%
    !% <tt>%RestartOptions
    !% <br>&nbsp;&nbsp;restart_gs | "restart" | restart_rho
    !% <br>%</tt>
    !%
    !% A list of available flags is given below, but note that the code might ignore some of them, which will happen if they
    !% are not available for that particular calculation, or might assume some of them always present, which will happen
    !% in case they are mandatory.
    !%
    !% Finally, note that all the restart information of a given data type is always stored in a subdirectory of the
    !% specified path. The name of this subdirectory is fixed and cannot be changed. For example, ground-state information
    !% will always be stored in a subdirectory named "gs". This makes it safe in most situations to use the same path for
    !% all the data types. The name of these subdirectories is indicated in the description of the data types below.
    !%
    !% Currently, the available restart data types and flags are the following:
    !%Option restart_all 0
    !% (data type)
    !% Option to globally change the path of all the restart information.
    !%Option restart_gs  1
    !% (data type)
    !% The data resulting from a ground-state calculation.
    !% This information is stored under the "gs" subdirectory.
    !%Option restart_unocc 2
    !% (data type)
    !% The data resulting from an unoccupied states calculation. This information also corresponds to a ground state and
    !% can be used as such, so it is stored under the same subdirectory as the one of restart_gs.
    !%Option restart_td 3
    !% (data type)
    !% The data resulting from a real-time time-dependent calculation.
    !% This information is stored under the "td" subdirectory.
    !%Option restart_em_resp 4
    !% (data type)
    !% The data resulting from the calculation of the electromagnetic response using the Sternheimer approach.
    !% This information is stored under the "em_resp" subdirectory.
    !%Option restart_em_resp_fd 5
    !% (data type)
    !% The data resulting from the calculation of the electromagnetic response using finite-differences.
    !% This information is stored under the "em_resp_fd" subdirectory.
    !%Option restart_kdotp 6
    !% (data type)
    !% The data resulting from the calculation of effective masses by k.p perturbation theory.
    !% This information is stored under the "kdotp" subdirectory.
    !%Option restart_vib_modes 7
    !% (data type)
    !% The data resulting from the calculation of vibrational modes.
    !% This information is stored under the "vib_modes" subdirectory.
    !%Option restart_vdw 8
    !% (data type)
    !% The data resulting from the calculation of van der Waals coefficients.
    !% This information is stored under the "vdw" subdirectory.
    !%Option restart_casida 9
    !% (data type)
    !% The data resulting from a Casida calculation.
    !% This information is stored under the "casida" subdirectory.
    !%Option restart_oct 10
    !% (data type)
    !% The data for optimal control calculations.
    !% This information is stored under the "opt-control" subdirectory.
    !%Option restart_partition 11
    !% (data type)
    !% The data for the mesh partitioning.
    !% This information is stored under the "partition" subdirectory.
    !%Option restart_proj 12
    !% (data type)
    !% The ground-state to be used with the td_occup and populations options of <tt>TDOutput</tt>.
    !% This information should be a ground state, so the "gs" subdirectory is used.
    !%Option restart_states 1
    !% (flag)
    !% Read the electronic states. (not yet implemented)
    !%Option restart_rho 2
    !% (flag)
    !% Read the electronic density.
    !%Option restart_vhxc 4
    !% (flag)
    !% Read the Hartree and XC potentials.
    !%Option restart_mix 8
    !% (flag)
    !% Read the SCF mixing information.
    !%Option restart_skip 16
    !% (flag)
    !% This flag allows to selectively skip the reading and writing of specific restart information.
    !%Option restart_literal 32
    !% (flag)
    !% Treat the given path literally, i.e. do not insert the namespace. This is useful for ensembles
    !% if a given replica should read from a specific restart folder.
    !%End
    if (parse_block(namespace, 'RestartOptions', blk) == 0) then
 
 
      do iline = 1, parse_block_n(blk)
        n_cols = parse_block_cols(blk,iline-1)
 
        call parse_block_integer(blk, iline-1, 0, idata_type)
        if (idata_type < 0 .or. idata_type > restart_n_data_types) then
          call messages_input_error(namespace, 'RestartOptions', "Invalid data type", row=iline-1, column=0)
        end if
        if (data_type == 0) then
          call parse_block_string(blk, iline-1, 1, default_basedir)
        end if
 
        if (idata_type == data_type .or. idata_type == 0) then
          call parse_block_string(blk, iline-1, 1, restart%basedir)
          if (n_cols > 2) call parse_block_integer(blk, iline-1, 2, restart%flags)
 
          namespace_prefix = parse_get_full_name(namespace, 'RestartOptions')
          namespace_prefix = namespace_prefix(1:len_trim(namespace_prefix)-len_trim('.RestartOptions'))
 
          if (len_trim(namespace_prefix) == 0 .or. trim(namespace%get()) == trim(namespace_prefix)) then
            namespace_prefix = trim(namespace%get())
          end if
 
          if (bitand(restart%flags, restart_flag_literal) > 0) then
            namespace_prefix = ""
          end if
 
        end if
 
 
      end do
      call parse_block_end(blk)
 
    end if
 
    basedir = restart%basedir
    call add_last_slash(basedir)
 
    do i=1, len(namespace_prefix)
      if (namespace_prefix(i:i) == '.') namespace_prefix(i:i) = '/'
    end do
 
    !append namespace
    basedir = trim(basedir)//trim(namespace_prefix)//'/'
    dirname = trim(basic_info(restart%data_type)%dir)
 
    call mpi_grp_init(restart%mpi_grp, mpi_comm_undefined)
 
    select case (restart%type)
    case (restart_type_dump)
      !%Variable RestartWrite
      !%Type logical
      !%Default true
      !%Section Execution::IO
      !%Description
      !% If this variable is set to no, restart information is not
      !% written. Note that some run modes will ignore this
      !% option and write some restart information anyway.
      !%End
 
      call parse_variable(namespace, 'RestartWrite', .true., restart_write)
      restart%skip_ = .not. restart_write
 
      if (restart%skip_) then
        message(1) = 'Restart information will not be written.'
        call messages_info(1, namespace=namespace)
      end if
 
    case (restart_type_load)
      ! This is set to true as an error condition, checked by assertions in some routines.
      restart%skip_ = .false.
 
    case default
      message(1) = "Unknown restart type in restart_init"
      call messages_fatal(1, namespace=namespace)
    end select
 
 
    ! If the restart data type is not defined, the directories should be set explicitly
    if (restart%data_type == restart_undefined) then
      assert(present(dir))
      basedir = trim(dir)
      dirname = ""
    end if
 
    ! Set final path
    restart%dir_ = trim(basedir)//trim(dirname)
    ! Remove any trailing "/" from the path (all the routines from this module should add the trailing "/" when needed)
    if (index(restart%dir_, '/', .true.) == len_trim(restart%dir_)) then
      restart%dir_ = restart%dir_(1:len_trim(restart%dir_)-1)
    end if
 
    ! Set initial path to the working directory
    restart%pwd = restart%dir_
 
    ! Check if the directory already exists and create it if necessary
    if (restart%mpi_grp%is_root()) then
      dir_exists = io_dir_exists(restart%pwd)
      if (restart%type == restart_type_dump .and. .not. dir_exists) then
        call io_mkdir(restart%pwd, namespace, parents=.true.)
      end if
    end if
    if (restart%mpi_grp%size > 1) then
      call restart%mpi_grp%bcast(dir_exists, 1, mpi_logical, 0)
    end if
 
    if (restart%data_type == restart_undefined) then
      tag = "Some "
    else
      tag = trim(basic_info(data_type)%tag)
    end if
 
    select case (restart%type)
    case (restart_type_dump)
      if (.not. restart%skip_) then
        message(1) = "Info: "//trim(tag)//" restart information will be written to '"//trim(restart%pwd)//"'."
        call messages_info(1, namespace=namespace)
      end if
 
    case (restart_type_load)
      if (.not. dir_exists) then
        ierr = 1
        restart%skip_ = .true.
 
        message(1) = "Info: Could not find '"//trim(restart%pwd)//"' directory for restart."
        message(2) = "Info: No restart information will be read."
        call messages_info(2, namespace=namespace)
      else
        message(1) = "Info: "//trim(tag)//" restart information will be read from '"//trim(restart%pwd)//"'."
        call messages_info(1, namespace=namespace)
      end if
 
    end select
 
    restart%initialized = .true.
 
    pop_sub(restart_basic_init)
  end subroutine restart_basic_init
 
  function restart_basic_do_i_write(restart) result(res)
    class(restart_basic_t), intent(in) :: restart
    logical                            :: res
 
    res = restart%mpi_grp%is_root()
 
  end function restart_basic_do_i_write
 
  ! ---------------------------------------------------------
  subroutine restart_init(restart, namespace, data_type, type, mc, ierr, mesh, dir, exact)
    class(restart_t),            intent(out) :: restart
    type(namespace_t), target,   intent(in)  :: namespace
    integer,                     intent(in)  :: data_type
    integer,                     intent(in)  :: type
    type(multicomm_t), target,   intent(in)  :: mc
    integer,                     intent(out) :: ierr
    class(mesh_t),     optional, intent(in)  :: mesh
    character(len=*),  optional, intent(in)  :: dir
    logical,           optional, intent(in)  :: exact
 
    logical :: grid_changed, grid_reordered, exact_, with_changed_grid
    integer :: default_format
 
    push_sub(restart_init)
 
    ierr = 0
 
    call restart_basic_init(restart, namespace, data_type, type, ierr, dir)
    ! At this point, ierr == 1 indicates that the folder did not exist for RESTART_TYPE_LOAD.
    ! In this case, also restart%skip_ has been set.
 
    restart%has_mesh = present(mesh)
    restart%mc => mc
    call mpi_grp_init(restart%mpi_grp, mc%master_comm)
 
    ! Sanity checks
    if (present(exact) .and. .not. present(mesh)) then
      message(1) = "Error in restart_init: the 'exact' optional argument requires a mesh."
      call messages_fatal(1, namespace=namespace)
    end if
 
    exact_ = optional_default(exact, .false.)
 
    restart%has_mesh = present(mesh)
    restart%mc => mc
 
    if(present(mesh)) then
      !%Variable RestartFileFormatStates
      !%Type integer
      !%Section Execution::IO
      !%Description
      !% File format used for writing and reading the restart files for the states.
      !% Default is adios2 if support is available, otherwise obf.
      !% Restart files for linear response calculations always use obf.
      !%Option obf 1
      !% obf is the Octopus binary format, for which there is one file for
      !% each state.
      !%Option adios2 2
      !% For large systems, especially with many k points, having one file per state can
      !% be problematic for the file system. This option selects a format based on the
      !% ADIOS2 library which needs to be available. The library handles IO efficiently
      !% including aggregation and makes the restart IO much faster. However, it does
      !% not support all features that the default obf format supports. Moreover, it
      !% might use more memory for internal aggregation. In case of out-of-memory issues,
      !% you might need to rerun on more nodes.
      !%End
#ifdef HAVE_ADIOS2
      default_format = option__restartfileformatstates__adios2
#else
      default_format = option__restartfileformatstates__obf
#endif
      call parse_variable(namespace, 'RestartFileFormatStates', default_format, restart%file_format_states)
      if (.not. varinfo_valid_option('RestartFileFormatStates', restart%file_format_states)) then
        call messages_input_error(namespace, 'RestartFileFormatStates')
      end if
 
      if (restart%file_format_states == option__restartfileformatstates__adios2) then
        ! the ADIOS2 format requires the exact same mesh for restarting
        exact_ = .true.
#ifndef HAVE_ADIOS2
        message(1) = "Error: adios2 restart file format requested, but not compiled against ADIOS2 library."
        call messages_fatal(1)
#endif
      end if
 
      !%Variable RestartWithChangedGrid
      !%Type logical
      !%Default false
      !%Section Execution::IO
      !%Description
      !% Use restart data even when the grid has changed. Normally, this is not needed, but can be enabled.
      !%End
      call parse_variable(namespace, 'RestartWithChangedGrid', .false., with_changed_grid)
 
      select case (restart%type)
      case (restart_type_dump)
        if (.not. restart%skip_) then
          ! Dump the grid information. The main parameters of the grid should not change
          ! during the calculation, so we should only need to dump it once.
          call index_dump(mesh%idx, mesh%np_part_global, restart%pwd, restart%mpi_grp, &
            restart%namespace, ierr)
          if (ierr /= 0) then
            message(1) = "Unable to write index map to '"//trim(restart%pwd)//"'."
            call messages_fatal(1, namespace=namespace)
          end if
 
          call mesh_write_fingerprint(mesh, restart%pwd, "grid", restart%mpi_grp, namespace, ierr)
          if (ierr /= 0) then
            message(1) = "Unable to write mesh fingerprint to '"//trim(restart%pwd)//"/grid'."
            call messages_fatal(1, namespace=namespace)
          end if
        end if
 
      case (restart_type_load)
        if(.not. restart%skip_) then
          call mesh_check_dump_compatibility(mesh, restart%pwd, "grid", global_namespace, &
            restart%mpi_grp, grid_changed, grid_reordered, restart%map, ierr)
 
          ! Check whether an error occurred. In this case we cannot read.
          if (ierr /= 0) then
            if (ierr == 1) then
              message(1) = "Unable to check mesh compatibility: unable to read mesh fingerprint"
              message(2) = "in '"//trim(restart%pwd)//"'."
            else if (ierr > 1) then
              message(1) = "Mesh from current calculation is not compatible with mesh found in"
              message(2) = "'"//trim(restart%pwd)//"'."
            end if
            message(3) = "No restart information will be read."
            call messages_warning(3, namespace=namespace)
            ierr = 1
          end if
 
          ! Print some warnings in case the mesh is compatible, but changed.
          if (grid_changed) then
            if (grid_reordered) then
              message(1) = "Info: Octopus is attempting to restart from a mesh with a different order of points."
            else
              message(1) = "Info: Octopus is attempting to restart from a different mesh."
            end if
            if (with_changed_grid) then
              call messages_info(1, namespace=namespace)
            else
              message(2) = "This is disabled. To enable this, set RestartWithChangedGrid=True."
              call messages_warning(2, namespace=namespace)
              ierr = 1
            end if
          end if
 
          if (exact_) then
            restart%skip_ = grid_changed .and. .not. grid_reordered
            if (restart%skip_) then
              message(1) = "This calculation requires the exact same mesh to restart."
              message(2) = "No restart information will be read from '"//trim(restart%pwd)//"'."
              call messages_warning(2, namespace=namespace)
              ierr = 1
            end if
          else
            restart%skip_ = .false.
          end if
        end if
      end select
 
      ! Make sure all the processes have finished reading/writing all the grid information,
      ! as there might be some subsequent calls to this function where that information will
      ! be written/read to/from the same directory.
      if (restart%mpi_grp%size > 1) then
        call restart%mpi_grp%barrier()
      end if
 
    end if
 
    pop_sub(restart_init)
  end subroutine restart_init
 
 
  subroutine restart_basic_end(restart)
    class(restart_basic_t), intent(inout) :: restart
 
    push_sub(restart_basic_end)
 
    restart%type = 0
    restart%data_type = 0
    restart%skip_ = .true.
 
    pop_sub(restart_basic_end)
 
  end subroutine restart_basic_end
 
  ! ---------------------------------------------------------
  subroutine restart_end(restart)
    class(restart_t),  intent(inout) :: restart
 
    push_sub(restart_end)
 
    if (restart%mpi_grp%is_root() .and. .not. restart%skip_) then
      select case (restart%type)
      case (restart_type_load)
        message(1) = "Info: Finished reading information "//trim(basic_info(restart%type)%tag)//" from '"//trim(restart%dir_)//"'."
        call io_rm(trim(restart%pwd)//"/loading")
      case (restart_type_dump)
        call io_rm(trim(restart%pwd)//"/dumping")
        message(1) = "Info: Finished writing information "//trim(basic_info(restart%type)%tag)//" to '"//trim(restart%dir_)//"'."
      end select
      call messages_info(1, namespace=restart%namespace)
    end if
 
    safe_deallocate_a(restart%map)
    restart%has_mesh = .false.
    nullify(restart%mc)
 
    call restart_basic_end(restart)
 
    pop_sub(restart_end)
  end subroutine restart_end
 
 
  ! ---------------------------------------------------------
  function restart_basic_dir(restart)
    class(restart_basic_t), intent(in) :: restart
    character(len=MAX_PATH_LEN) :: restart_basic_dir
 
    push_sub(restart_basic_dir)
 
    restart_basic_dir = io_workpath(restart%pwd)
 
    pop_sub(restart_basic_dir)
  end function restart_basic_dir
 
 
  ! ---------------------------------------------------------
  subroutine restart_basic_open_dir(restart, dirname, ierr)
    class(restart_basic_t),  intent(inout) :: restart
    character(len=*), intent(in)    :: dirname
    integer,          intent(out)   :: ierr
 
    push_sub(restart_basic_open_dir)
 
    assert(.not. restart%skip_)
 
    ierr = 0
 
    select case (restart%type)
    case (restart_type_dump)
      call restart_basic_mkdir(restart, dirname)
    case (restart_type_load)
      if (.not. loct_dir_exists(trim(restart%dir_)//"/"//trim(dirname))) then
        ierr = 1
      end if
    end select
 
    if (ierr == 0) then
      if (index(dirname, '/', .true.) == len_trim(dirname)) then
        restart%pwd = trim(restart%dir_)//"/"//dirname(1:len_trim(dirname)-1)
      else
        restart%pwd = trim(restart%dir_)//"/"//trim(dirname)
      end if
    end if
 
    pop_sub(restart_basic_open_dir)
  end subroutine restart_basic_open_dir
 
 
  ! ---------------------------------------------------------
  subroutine restart_basic_close_dir(restart)
    class(restart_basic_t),  intent(inout) :: restart
 
    push_sub(restart_basic_close_dir)
 
    assert(.not. restart%skip_)
 
    restart%pwd = restart%dir_
 
    pop_sub(restart_basic_close_dir)
  end subroutine restart_basic_close_dir
 
 
  ! ---------------------------------------------------------
  subroutine restart_basic_mkdir(restart, dirname)
    class(restart_basic_t),  intent(in) :: restart
    character(len=*), intent(in) :: dirname
 
    push_sub(restart_basic_mkdir)
 
    assert(.not. restart%skip_)
 
    assert(restart%type == restart_type_dump)
 
    call io_mkdir(trim(restart%pwd)//"/"//trim(dirname), parents=.true.)
 
    pop_sub(restart_basic_mkdir)
  end subroutine restart_basic_mkdir
 
 
  ! ---------------------------------------------------------
  subroutine restart_basic_rm(restart, name)
    class(restart_basic_t),  intent(in) :: restart
    character(len=*), intent(in) :: name
 
    assert(.not. restart%skip_)
    assert(restart%type == restart_type_dump)
 
    push_sub(restart_basic_rm)
 
    call io_rm(trim(restart%pwd)//"/"//trim(name))
 
    pop_sub(restart_basic_rm)
  end subroutine restart_basic_rm
 
 
  ! ---------------------------------------------------------
  function restart_basic_open(restart, filename, status, position, silent)
    class(restart_basic_t),     intent(in) :: restart
    character(len=*),           intent(in) :: filename
    character(len=*), optional, intent(in) :: status
    character(len=*), optional, intent(in) :: position
    logical,          optional, intent(in) :: silent
    integer :: restart_basic_open
 
    logical :: die
    character(len=20) :: action, status_
 
    push_sub(restart_basic_open)
 
    assert(restart%initialized)
    assert(.not. restart%skip_)
 
    select case (restart%type)
    case (restart_type_dump)
      status_ = 'unknown'
      action = 'write'
      die = .true.
 
    case (restart_type_load)
      status_ = 'old'
      action = 'read'
      die = .false.
 
    case default
      message(1) = "Error in restart_basic_open: illegal restart type"
      call messages_fatal(1)
    end select
 
    if (present(status)) status_ = status
 
    restart_basic_open = io_open(trim(restart%pwd)//"/"//trim(filename),  &
      action=trim(action), status=trim(status_), &
      die=die, position=position, form="formatted", grp=restart%mpi_grp)
 
    if (restart_basic_open == -1 .and. .not. optional_default(silent, .false.)) then
      message(1) = "Unable to open file '"//trim(restart%pwd)//"/"//trim(filename)//"'."
      call messages_warning(1)
    end if
 
    pop_sub(restart_basic_open)
  end function restart_basic_open
 
 
  ! ---------------------------------------------------------
  subroutine restart_basic_write(restart, iunit, lines, nlines, ierr)
    class(restart_basic_t),  intent(in)  :: restart
    integer,          intent(in)  :: iunit
    character(len=*), intent(in)  :: lines(:)
    integer,          intent(in)  :: nlines
    integer,          intent(out) :: ierr
 
    integer :: iline
 
    push_sub(restart_basic_write)
 
    if (iunit /= -1) then
      ierr = 0
      if (restart%mpi_grp%is_root()) then
        do iline = 1, nlines
          write(iunit,"(a)") trim(lines(iline))
        end do
      end if
    else
      ierr = 1
    end if
 
    pop_sub(restart_basic_write)
  end subroutine restart_basic_write
 
 
  ! ---------------------------------------------------------
  subroutine restart_basic_read(restart, iunit, lines, nlines, ierr)
    class(restart_basic_t),  intent(in)  :: restart
    integer,          intent(in)  :: iunit
    character(len=*), intent(out) :: lines(:)
    integer,          intent(in)  :: nlines
    integer,          intent(out) :: ierr
 
    push_sub(restart_basic_read)
 
    call iopar_read(restart%mpi_grp, iunit, lines, nlines, ierr)
 
    pop_sub(restart_basic_read)
  end subroutine restart_basic_read
 
 
  ! ---------------------------------------------------------
  subroutine restart_basic_close(restart, iunit)
    class(restart_basic_t), intent(in)    :: restart
    integer,         intent(inout) :: iunit
 
    push_sub(restart_basic_close)
 
    if (iunit /= -1) call io_close(iunit, restart%mpi_grp)
 
    call restart%mpi_grp%barrier()
 
    pop_sub(restart_basic_close)
  end subroutine restart_basic_close
 
 
  ! ---------------------------------------------------------
  logical pure function restart_basic_skip(restart)
    class(restart_basic_t), intent(in) :: restart
 
    restart_basic_skip = restart%skip_ .or. restart%has_flag(restart_flag_skip)
 
  end function restart_basic_skip
 
 
  ! ---------------------------------------------------------
  logical pure function restart_basic_has_flag(restart, flag)
    class(restart_basic_t), intent(in) :: restart
    integer,                intent(in) :: flag
 
    restart_basic_has_flag = bitand(restart%flags, flag) /= 0
 
  end function restart_basic_has_flag
 
 
  ! ---------------------------------------------------------
  logical pure function restart_has_map(restart)
    class(restart_t), intent(in) :: restart
 
    restart_has_map = allocated(restart%map)
 
  end function restart_has_map
 
 
  integer pure function restart_basic_get_data_type(restart)
    class(restart_basic_t), intent(in) :: restart
 
    restart_basic_get_data_type = restart%data_type
  end function restart_basic_get_data_type
 
  function restart_basic_get_info(restart) result(info)
    class(restart_basic_t), intent(in) :: restart
 
    character(:), allocatable :: info
 
    info = "restart_basic "//trim(basic_info(restart%data_type)%tag)//" "//type_string(restart%type)
 
  end function restart_basic_get_info
 
  function restart_get_info(restart) result(info)
    class(restart_t), intent(in) :: restart
 
    character(:), allocatable :: info
 
    info = "restart       "//trim(basic_info(restart%data_type)%tag)//" "//type_string(restart%type)
 
  end function restart_get_info
 
#include "undef.F90"
#include "real.F90"
#include "restart_inc.F90"
 
#include "undef.F90"
#include "complex.F90"
#include "restart_inc.F90"
 
end module restart_oct_m
 
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: