walltimer.F90

Go to the documentation of this file.

!! Copyright (C) 2019 M. Lueders, Heiko Appel
!! Copyright (C) 2021 I-Te Lu
!!
!! 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 walltimer_oct_m
  use debug_oct_m
  use global_oct_m
  use io_oct_m
  use, intrinsic :: iso_fortran_env
  use loct_oct_m
  use messages_oct_m
  use mpi_oct_m
  use namespace_oct_m
  use parser_oct_m
 
  implicit none
 
  private
 
  real(real64) :: start_time
  real(real64) :: last_tap
  real(real64) :: iteration_time
  real(real64) :: margin
  real(real64) :: duration
  real(real64) :: restart_last_tap
  real(real64) :: restart_duration
 
  logical :: active
  logical :: auto_tap
  logical :: restart_active
 
  public ::         &
    walltimer_init, &
    walltimer_end,  &
    walltimer_tap,  &
    walltimer_alarm, &
    restart_walltime_period_alarm, &
    walltimer_get_start_time
 
contains
  subroutine walltimer_init(auto)
    logical, optional,   intent(in)   :: auto
 
    real(real64)  :: alarm_time, write_time, restart_alarm_time, slurm_start_time, slurm_end_time, slurm_time
    character(len=128) :: env_start, env_end
    integer :: status_start, status_end
    logical :: walltime_slurm
 
    push_sub(walltimer_init)
 
    start_time = m_zero
    last_tap = m_zero
    iteration_time = m_zero
    margin = m_zero
 
    active = .false.
    auto_tap = optional_default(auto, .true.)
 
    ! The following have to be moved to the right place, after the names for the variables have been confirmed:
 
    !%Variable WalltimeSlurm
    !%Type logical
    !%Default yes
    !%Section Execution::IO
    !%Description
    !% Parse environment variables SLURM_JOB_START_TIME and SLURM_JOB_END_TIME to get the slurm job
    !% length. Set this as default for the variable Walltime, i.e., always activate the walltimer
    !% for slurm jobs. This prevents jobs from running into the timelimit.
    !%End
    call parse_variable(global_namespace, 'WalltimeSlurm', .true., walltime_slurm)
    slurm_time = m_zero
    ! read environment variables set by slurm to determine the length of the job
    call get_environment_variable("SLURM_JOB_START_TIME", env_start, status=status_start)
    call get_environment_variable("SLURM_JOB_END_TIME", env_end, status=status_end)
    if (status_start == 0 .and. status_end == 0) then
      read(env_start, *, iostat=status_start) slurm_start_time
      read(env_end, *, iostat=status_end) slurm_end_time
      if (status_start == 0 .and. status_end == 0) then
        ! only set the time if the environment variables are defined and could be read
        slurm_time = (slurm_end_time - slurm_start_time) / 60.0_real64
      end if
    end if
 
    !%Variable Walltime
    !%Type float
    !%Default 0 (or given by the slurm time limit)
    !%Section Execution::IO
    !%Description
    !% Time in minutes before which the restart file will be written. This is to make sure that at least one restart
    !% file can be written before the code might be killed to to exceeding the given CPU time.
    !% If a finite time (in minutes) is specified, the code will write the restart file when the next
    !% iteration (plus the RestartWriteTime) would exceed the given time.
    !% A value less than 1 second (1/60 minutes) will disable the timer.
    !% For slurm jobs, this is set by default to the time limit of the job (can be deactivated by setting
    !% WalltimeSlurm = no).
    !%End
    call parse_variable(global_namespace, 'Walltime', slurm_time, alarm_time)
    call set_alarm(alarm_time*60.0_real64)
 
    !%Variable RestartWriteTime
    !%Type float
    !%Default 5
    !%Section Execution::IO
    !%Description
    !% The RestartWriteTime (in minutes) will be subtracted from the WallTime to allow time for writing the restart file.
    !% In huge calculations, this value should be increased.
    !%End
    call parse_variable(global_namespace, 'RestartWriteTime', 5.0_real64, write_time)
    if (write_time > alarm_time/m_four) write_time = alarm_time/m_four
    call set_margin(write_time*60.0_real64)
 
    !%Variable RestartWallTimePeriod
    !%Type float
    !%Default 120
    !%Section Execution::IO
    !%Description
    !% Period Time (in minutes) at which the restart file will be written.
    !% If a finite time (in minutes) is specified, the code will write the restart file every period.
    !%End
    call parse_variable(global_namespace, 'RestartWallTimePeriod', 120.0_real64, restart_alarm_time)
    call set_restart_alarm(restart_alarm_time*60.0_real64)
    restart_active = .false.
 
    call start()
 
    pop_sub(walltimer_init)
  end subroutine walltimer_init
 
  subroutine walltimer_end()
 
    push_sub(walltimer_end)
 
    active = .false.
 
    pop_sub(walltimer_end)
  end subroutine walltimer_end
 
  subroutine set_alarm(time)
    real(real64) :: time
 
    push_sub(set_alarm)
 
    duration = time
 
    pop_sub(set_alarm)
  end subroutine set_alarm
 
  subroutine set_restart_alarm(time)
    real(real64) :: time
 
    push_sub(set_restart_alarm)
 
    restart_duration = time
 
    pop_sub(set_restart_alarm)
  end subroutine set_restart_alarm
 
  subroutine set_margin(time)
 
    real(real64) :: time
 
    push_sub(set_margin)
 
    margin = time
 
    pop_sub(set_margin)
  end subroutine set_margin
 
  subroutine start()
 
    push_sub(start)
 
    start_time = loct_clock()
    last_tap = start_time
    restart_last_tap = start_time
 
    if (duration > m_one) active = .true.
    if (restart_duration > 60.0_real64) restart_active = .true.
 
    pop_sub(start)
  end subroutine start
 
  subroutine walltimer_tap(print)
    logical, optional, intent(in) :: print
 
    real(real64) :: now
 
    push_sub(walltimer_tap)
 
    now = loct_clock()
 
    iteration_time = now - last_tap
    last_tap = now
 
    if (optional_default(print, .false.)) then
      write(message(1), '("Walltimer_tap:   elapsed time = ",F6.2," (", 3F10.5, "), active = ",L1 )')  &
        now - start_time, duration, iteration_time, margin, active
      call messages_info(1, all_nodes=.true.)
    end if
 
    pop_sub(walltimer_tap)
  end subroutine walltimer_tap
 
  logical function walltimer_alarm(comm, print)
    type(mpi_comm),    intent(in) :: comm
    logical, optional, intent(in) :: print
 
#ifdef HAVE_MPI
    logical :: alarm
#endif
    real(real64) :: now
 
    push_sub(walltimer_alarm)
 
    now = loct_clock()
 
    if (optional_default(print, .false.)) then
      write(message(1), '("Walltimer_alarm: elapsed time = ",F6.2," (", 3F10.5, "), active = ",L1 )')  &
        now - start_time, duration, iteration_time, margin, active
      call messages_info(1, all_nodes=.true.)
    end if
 
    if (auto_tap) call walltimer_tap()
 
    walltimer_alarm = active .and. (now > start_time + duration - iteration_time - margin)
 
    ! All processes need to know that the walltimer was triggered.
#ifdef HAVE_MPI
    call mpi_debug_in(comm, c_mpi_allreduce)
    call mpi_allreduce(walltimer_alarm, alarm, 1, mpi_logical, mpi_lor, comm)
    call mpi_debug_out(comm, c_mpi_allreduce)
    walltimer_alarm = alarm
#endif
 
    if (walltimer_alarm) then
      write(message(1), '("Walltimer stopping execution after = ",F6.2," minutes.")') (now - start_time)/60.0_real64
      call messages_info(1)
      ! Switch status to indicate that the walltimer aborted the calculation.
      ! This can be used to communicate the status of octopus to a queuing system and to daisy-chain jobs.
      call messages_switch_status('walltimer-aborted')
    end if
 
    pop_sub(walltimer_alarm)
  end function walltimer_alarm
 
  logical function restart_walltime_period_alarm(comm)
    type(mpi_comm),    intent(in) :: comm
 
#ifdef HAVE_MPI
    logical :: alarm
#endif
    real(real64) :: now
 
    push_sub(restart_walltime_period_alarm)
 
    now = loct_clock()
 
    restart_walltime_period_alarm = restart_active .and. (now > restart_last_tap + restart_duration)
 
    ! All processes need to know that the walltimer was triggered.
#ifdef HAVE_MPI
    call mpi_debug_in(comm, c_mpi_allreduce)
    call mpi_allreduce(restart_walltime_period_alarm, alarm, 1, mpi_logical, mpi_lor, comm)
    call mpi_debug_out(comm, c_mpi_allreduce)
    restart_walltime_period_alarm = alarm
#endif
 
    if (restart_walltime_period_alarm) then
      restart_last_tap = now
      write(message(1), '(a)') "Restart walltime period is reached: writing restart data"
      call messages_info(1)
    end if
 
    pop_sub(restart_walltime_period_alarm)
  end function restart_walltime_period_alarm
 
  function walltimer_get_start_time() result(t)
    real(real64) :: t
    t = start_time
  end function walltimer_get_start_time
end module walltimer_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: