clock.F90

Go to the documentation of this file.

!! Copyright (C) 2020 Heiko Appel, M. Oliveira
!! 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 clock_oct_m
  use debug_oct_m
  use global_oct_m
  use io_oct_m
  use loct_oct_m
  use messages_oct_m
  use namespace_oct_m
  use profiling_oct_m
 
  implicit none
 
  private
 
  integer, parameter :: CLOCK_TICK = 1
 
  float, parameter :: time_relative_tolerance = cnst(1.e-8)
 
  public ::                &
    clock_t,               &
    clock_tick
 
  type clock_t
    private
    integer :: tick
    float   :: time_step   
    float   :: time_       
  contains
    procedure :: print => clock_print                 
    procedure :: print_str => clock_print_str         
    procedure :: set_time => clock_set_time           
    procedure :: copy => clock_copy                   
    procedure :: get_tick => clock_get_tick           
    procedure :: get_dt => clock_get_dt               
    procedure :: time => clock_time                   
    procedure :: reset => clock_reset                 
    procedure :: clock_is_equal
    generic   :: operator(.eq.) => clock_is_equal
    procedure :: clock_is_different
    generic   :: operator(/=) => clock_is_different
    procedure :: clock_is_earlier
    generic   :: operator(.lt.) => clock_is_earlier
    procedure :: clock_is_later
    generic   :: operator(.gt.) => clock_is_later
    procedure :: clock_is_equal_or_earlier
    generic   :: operator(.le.) => clock_is_equal_or_earlier
    procedure :: clock_is_equal_or_later
    generic   :: operator(.ge.) => clock_is_equal_or_later
    procedure :: clock_copy
    generic   :: assignment(=) => clock_copy
    procedure :: clock_add_tick
    generic   :: operator(+) => clock_add_tick
    procedure :: clock_subtract_tick
    generic   :: operator(-) => clock_subtract_tick
    procedure :: restart_write => clock_restart_write
    procedure :: restart_read => clock_restart_read
  end type clock_t
 
  interface clock_t
    module procedure clock_init
  end interface clock_t
 
contains
 
  ! ---------------------------------------------------------
  type(clock_t) function clock_init(time_step, initial_tick) result(this)
    float,   optional, intent(in) :: time_step
    integer, optional, intent(in) :: initial_tick
 
    push_sub(clock_init)
 
    this%tick = optional_default(initial_tick, 0)
    this%time_step = optional_default(time_step, m_zero)
    if (this%time_step <= m_zero) then
      this%time_ = m_zero
    else
      this%time_ = this%tick*this%time_step
    end if
 
    pop_sub(clock_init)
  end function clock_init
 
  ! ---------------------------------------------------------
  function clock_print_str(this) result(clock_string)
    class(clock_t), intent(in)    :: this
    character(len=65)             :: clock_string
 
    push_sub(clock_print_str)
 
    write(clock_string,'(A7,F16.6,A,I8.8,A)') &
      '[Clock:',                   &
      this%time_,                  &
      '|',                         &
      this%tick,                   &
      ']'
 
    pop_sub(clock_print_str)
  end function clock_print_str
 
  ! ---------------------------------------------------------
  subroutine clock_print(this)
    class(clock_t), intent(in) :: this
 
    push_sub(clock_print)
 
    message(1) = this%print_str()
    call messages_info(1)
 
    pop_sub(clock_print)
  end subroutine clock_print
 
  ! ---------------------------------------------------------
  subroutine clock_set_time(this, new)
    class(clock_t), intent(inout) :: this
    class(clock_t), intent(in)    :: new
 
    logical :: commensurable
    integer :: this_granularity, new_granularity
 
    push_sub(clock_set_time)
 
    if (this%time_step > m_zero .and. new%time_step > m_zero) then
      if (this%time_step >= new%time_step) then
        commensurable = ceiling(this%time_step/new%time_step) == floor(this%time_step/new%time_step)
        this_granularity = ceiling(this%time_step/new%time_step)
        new_granularity = 1
      else
        commensurable = ceiling(new%time_step/this%time_step) == floor(new%time_step/this%time_step)
        this_granularity = 1
        new_granularity = ceiling(new%time_step/this%time_step)
      end if
 
      if (.not. commensurable) then
        message(1) = 'Cannot set clock new time, as it is not commensurable with clock time-step.'
        call messages_fatal(1)
      end if
 
      this%tick = (new%tick * new_granularity) / this_granularity
      this%time_ = this%tick*this%time_step
    else
      this%time_ = new%time_
    end if
 
    pop_sub(clock_set_time)
  end subroutine clock_set_time
 
  ! ---------------------------------------------------------
  subroutine clock_copy(this, clock_in)
    class(clock_t), intent(in)    :: clock_in
    class(clock_t), intent(inout) :: this
 
    push_sub(clock_copy)
 
    this%tick = clock_in%tick
    this%time_step = clock_in%time_step
    this%time_ = clock_in%time_
 
    pop_sub(clock_copy)
  end subroutine clock_copy
 
  ! ---------------------------------------------------------
  type(clock_t) function clock_add_tick(clock, tick) result(new_clock)
    class(clock_t), intent(in) :: clock
    integer,        intent(in) :: tick
 
    push_sub(clock_add_tick)
 
    new_clock = clock
    new_clock%tick = new_clock%tick + tick
    new_clock%time_ = new_clock%tick*new_clock%time_step
 
    pop_sub(clock_add_tick)
  end function clock_add_tick
 
  ! ---------------------------------------------------------
  type(clock_t) function clock_subtract_tick(clock, tick) result(new_clock)
    class(clock_t), intent(in) :: clock
    integer,        intent(in) :: tick
 
    push_sub(clock_subtract_tick)
 
    new_clock = clock
    new_clock%tick = new_clock%tick - tick
    new_clock%time_ = new_clock%tick*new_clock%time_step
 
    pop_sub(clock_subtract_tick)
  end function clock_subtract_tick
 
  ! ---------------------------------------------------------
  integer function clock_get_tick(this) result(tick)
    class(clock_t), intent(in) :: this
 
    push_sub(clock_get_tick)
 
    tick = this%tick
 
    pop_sub(clock_get_tick)
  end function clock_get_tick
 
  ! ---------------------------------------------------------
  float function clock_get_dt(this) result(dt)
    class(clock_t), intent(in) :: this
 
    push_sub(clock_get_dt)
 
    dt = this%time_step
 
    pop_sub(clock_get_dt)
  end function clock_get_dt
 
 
  ! ---------------------------------------------------------
  float function clock_time(this)
    class(clock_t), intent(in) :: this
 
    push_sub(clock_time)
 
    clock_time = this%time_
 
    pop_sub(clock_time)
  end function clock_time
 
  ! ---------------------------------------------------------
  subroutine clock_reset(this)
    class(clock_t), intent(inout) :: this
 
    push_sub(clock_reset)
 
    this%tick = 0
    this%time_ = m_zero
 
    pop_sub(clock_reset)
  end subroutine clock_reset
 
  ! ---------------------------------------------------------
  logical function clock_is_earlier(clock_a, clock_b) result(is_earlier)
    class(clock_t), intent(in) :: clock_a, clock_b
 
    push_sub(clock_is_earlier)
 
    ! take into account the finite precision of the clocks
    if (clock_is_equal(clock_a, clock_b)) then
      is_earlier = .false.
    else
      is_earlier = clock_a%time_ < clock_b%time_
    end if
 
    pop_sub(clock_is_earlier)
  end function clock_is_earlier
 
  ! ---------------------------------------------------------
  logical function clock_is_later(clock_a, clock_b) result(is_later)
    class(clock_t), intent(in) :: clock_a, clock_b
 
    push_sub(clock_is_later)
 
    ! take into account the finite precision of the clocks
    if (clock_is_equal(clock_a, clock_b)) then
      is_later = .false.
    else
      is_later = clock_a%time_ > clock_b%time_
    end if
 
    pop_sub(clock_is_later)
  end function clock_is_later
 
  ! ---------------------------------------------------------
  logical function clock_is_equal_or_earlier(clock_a, clock_b) result(is_earlier)
    class(clock_t), intent(in) :: clock_a, clock_b
 
    push_sub(clock_is_equal_or_earlier)
 
    is_earlier = .not. clock_is_later(clock_a, clock_b)
 
    pop_sub(clock_is_equal_or_earlier)
  end function clock_is_equal_or_earlier
 
  ! ---------------------------------------------------------
  logical function clock_is_equal_or_later(clock_a, clock_b) result(is_later)
    class(clock_t), intent(in) :: clock_a, clock_b
 
    push_sub(clock_is_equal_or_later)
 
    is_later = .not. clock_is_earlier(clock_a, clock_b)
 
    pop_sub(clock_is_equal_or_later)
  end function clock_is_equal_or_later
 
  ! ---------------------------------------------------------
  logical function clock_is_equal(clock_a, clock_b) result(are_equal)
    class(clock_t), intent(in) :: clock_a, clock_b
 
    push_sub(clock_is_equal)
 
    ! we need to take into account the finite precision of floating point numbers
    if (abs(clock_b%time_) <= m_epsilon) then
      ! if the times are exactly 0, we cannot do a relative comparison, so we require
      ! both clocks to be exactly 0
      are_equal = clock_a%time_ == m_zero
    else if (abs(clock_a%time_) <= m_epsilon) then
      ! if the times are exactly 0, we cannot do a relative comparison, so we require
      ! both clocks to be exactly 0
      are_equal = clock_b%time_ == m_zero
    else
      ! otherwise we allow for a certain relative difference between the two values
      are_equal = abs((clock_a%time_-clock_b%time_)/clock_b%time_) <= time_relative_tolerance
    end if
 
    pop_sub(clock_is_equal)
  end function clock_is_equal
 
  ! ---------------------------------------------------------
  logical function clock_is_different(clock_a, clock_b) result(are_diff)
    class(clock_t), intent(in) :: clock_a, clock_b
 
    push_sub(clock_is_different)
 
    are_diff = .not. clock_is_equal(clock_a, clock_b)
 
    pop_sub(clock_is_different)
  end function clock_is_different
 
  ! ---------------------------------------------------------
  subroutine clock_restart_write(this, filename, namespace)
    class(clock_t),    intent(in) :: this
    character(len=*),  intent(in) :: filename
    type(namespace_t), intent(in) :: namespace
 
    integer :: restart_file_unit
 
    push_sub(clock_restart_write)
 
    call io_mkdir("restart", namespace, parents=.true.)
    restart_file_unit = io_open("restart/"//filename, namespace, form="unformatted", action='write')
    write(restart_file_unit) this%tick, this%time_step
    call io_close(restart_file_unit)
 
    pop_sub(clock_restart_write)
  end subroutine clock_restart_write
 
  ! ---------------------------------------------------------
  logical function clock_restart_read(this, filename, namespace)
    class(clock_t),    intent(inout) :: this
    character(len=*),  intent(in) :: filename
    type(namespace_t), intent(in) :: namespace
 
    integer :: restart_file_unit
 
    push_sub(clock_restart_read)
 
    restart_file_unit = io_open("restart/"//filename, namespace, form="unformatted", action='read', die=.false.)
    if (restart_file_unit > 0) then
      read(restart_file_unit) this%tick, this%time_step
      call io_close(restart_file_unit)
 
      this = clock_t(this%time_step, this%tick)
      clock_restart_read = .true.
    else
      ! could not open file
      clock_restart_read = .false.
    end if
 
    pop_sub(clock_restart_read)
  end function clock_restart_read
 
end module clock_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: