iteration_counter.F90

Go to the documentation of this file.

!! Copyright (C) 2020 Heiko Appel, M. Oliveira
!! Copyright (C) 2021 I-Te Lu
!! Copyright (C) 2023 M. Oliveira
!!
!! 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.
!!
 
module iteration_counter_oct_m
  use, intrinsic :: iso_fortran_env
  use global_oct_m
  use io_oct_m
  use messages_oct_m
  use namespace_oct_m
  use restart_oct_m
 
  implicit none
  private
 
  public :: iteration_counter_t
 
  type iteration_counter_t
    integer        :: iteration = 0
    integer(int64) :: step = -1
    integer(int64) :: global_iteration = 0
    procedure(get_value), pointer, public :: value => null() 
    !                                                        !! in the global reference frame (e.g., the time of a clock)
  contains
    procedure :: set => iteration_counter_set 
    procedure :: counter => iteration_counter_counter 
    procedure :: global_step => iteration_counter_global_step
    procedure :: reset => iteration_counter_reset 
    procedure :: add => iteration_counter_add
    procedure :: subtract => iteration_counter_subtract
    procedure :: is_equal => iteration_counter_is_equal
    procedure :: is_different => iteration_counter_is_different
    procedure :: is_earlier => iteration_counter_is_earlier
    procedure :: is_later => iteration_counter_is_later
    procedure :: is_equal_or_earlier => iteration_counter_is_equal_or_earlier
    procedure :: is_equal_or_later => iteration_counter_is_equal_or_later
    procedure :: restart_write => iteration_counter_restart_write
    procedure :: restart_read => iteration_counter_restart_read
    ! Operators
    generic   :: operator(+) => add
    generic   :: operator(-) => subtract
    generic   :: operator(.eq.) => is_equal
    generic   :: operator(/=) => is_different
    generic   :: operator(.lt.) => is_earlier
    generic   :: operator(.gt.) => is_later
    generic   :: operator(.le.) => is_equal_or_earlier
    generic   :: operator(.ge.) => is_equal_or_later
  end type iteration_counter_t
 
  abstract interface
    pure real(real64) function get_value(this)
      import real64
      import iteration_counter_t
      class(iteration_counter_t), intent(in) :: this
    end function get_value
  end interface
 
  interface iteration_counter_t
    module procedure iteration_counter_constructor
  end interface iteration_counter_t
 
contains
 
  pure type(iteration_counter_t) function iteration_counter_constructor(step, initial_iteration) result(counter)
    integer(int64), optional, intent(in) :: step
    integer,     optional, intent(in) :: initial_iteration
 
    if (present(initial_iteration)) then
      counter%iteration = initial_iteration
    end if
    if (present(step)) then
      counter%step = step
    else
      counter%step = 1
    end if
    counter%global_iteration = counter%iteration * counter%step
 
    counter%value => iteration_counter_value
 
  end function iteration_counter_constructor
 
  ! ---------------------------------------------------------
  subroutine iteration_counter_set(this, counter)
    class(iteration_counter_t), intent(inout) :: this
    type(iteration_counter_t),  intent(in)    :: counter
 
    ! Sanity check: the new iteration must be commensurable with the step
    if (mod(counter%global_iteration, this%step) /= 0) then
      message(1) = 'Cannot set iteration counter, as the new iteration is not commensurable with counter step.'
      call messages_fatal(1)
    end if
 
    this%iteration = int(counter%global_iteration / this%step)
    this%global_iteration = counter%global_iteration
 
  end subroutine iteration_counter_set
 
  ! ---------------------------------------------------------
  pure real(real64) function iteration_counter_value(this) result(value)
    class(iteration_counter_t), intent(in) :: this
 
    value = real(this%global_iteration, real64)
 
  end function iteration_counter_value
 
  ! ---------------------------------------------------------
  pure integer function iteration_counter_counter(this) result(counter)
    class(iteration_counter_t), intent(in) :: this
 
    counter = this%iteration
 
  end function iteration_counter_counter
 
  ! ---------------------------------------------------------
  pure integer(int64) function iteration_counter_global_step(this) result(step)
    class(iteration_counter_t), intent(in) :: this
 
    step = this%step
 
  end function iteration_counter_global_step
 
  ! ---------------------------------------------------------
  function iteration_counter_add(this, n) result(new_counter)
    class(iteration_counter_t), intent(in) :: this
    integer,                    intent(in) :: n
    type(iteration_counter_t) :: new_counter
 
    new_counter = this
    new_counter%iteration = new_counter%iteration + n
    new_counter%global_iteration = new_counter%iteration * new_counter%step
 
  end function iteration_counter_add
 
  ! ---------------------------------------------------------
  function iteration_counter_subtract(this, n) result(new_counter)
    class(iteration_counter_t), intent(in) :: this
    integer,                    intent(in) :: n
    type(iteration_counter_t) :: new_counter
 
    new_counter = this
    new_counter%iteration = new_counter%iteration - n
    new_counter%global_iteration = new_counter%iteration * new_counter%step
 
  end function iteration_counter_subtract
 
  ! ---------------------------------------------------------
  pure subroutine iteration_counter_reset(this)
    class(iteration_counter_t), intent(inout) :: this
 
    this%iteration = 0
    this%global_iteration = 0
 
  end subroutine iteration_counter_reset
 
  ! ---------------------------------------------------------
  elemental logical function iteration_counter_is_earlier(counter_a, counter_b) result(is_earlier)
    class(iteration_counter_t), intent(in) :: counter_a, counter_b
 
    is_earlier = counter_a%global_iteration < counter_b%global_iteration
 
  end function iteration_counter_is_earlier
 
  ! ---------------------------------------------------------
  elemental logical function iteration_counter_is_later(counter_a, counter_b) result(is_later)
    class(iteration_counter_t), intent(in) :: counter_a, counter_b
 
    is_later = counter_a%global_iteration > counter_b%global_iteration
 
  end function iteration_counter_is_later
 
  ! ---------------------------------------------------------
  elemental logical function iteration_counter_is_equal_or_earlier(counter_a, counter_b) result(is_equal_or_earlier)
    class(iteration_counter_t), intent(in) :: counter_a, counter_b
 
    is_equal_or_earlier = counter_a%global_iteration <= counter_b%global_iteration
 
  end function iteration_counter_is_equal_or_earlier
 
  ! ---------------------------------------------------------
  elemental logical function iteration_counter_is_equal_or_later(counter_a, counter_b) result(is_equal_or_later)
    class(iteration_counter_t), intent(in) :: counter_a, counter_b
 
    is_equal_or_later = counter_a%global_iteration >= counter_b%global_iteration
 
  end function iteration_counter_is_equal_or_later
 
  ! ---------------------------------------------------------
  elemental logical function iteration_counter_is_equal(counter_a, counter_b) result(are_equal)
    class(iteration_counter_t), intent(in) :: counter_a, counter_b
 
    are_equal = counter_a%global_iteration == counter_b%global_iteration
 
  end function iteration_counter_is_equal
 
  ! ---------------------------------------------------------
  elemental logical function iteration_counter_is_different(counter_a, counter_b) result(are_diff)
    class(iteration_counter_t), intent(in) :: counter_a, counter_b
 
    are_diff = counter_a%global_iteration /= counter_b%global_iteration
 
  end function iteration_counter_is_different
 
  ! ---------------------------------------------------------
  subroutine iteration_counter_restart_write(this, filename, namespace)
    class(iteration_counter_t),    intent(in) :: this
    character(len=*),  intent(in) :: filename
    type(namespace_t), intent(in) :: namespace
 
    type(restart_basic_t) :: restart
    integer :: restart_file_unit
    integer :: ierr
 
    call restart%init(namespace, restart_iteration, restart_type_dump, ierr)
 
    if (ierr == 0) then
      restart_file_unit = restart%open(filename)
      if (restart%do_i_write()) write(restart_file_unit, *) this%iteration, this%step
      call restart%close(restart_file_unit)
    else
      write(message(1), *) "Could not write restart file '",trim(filename),"'."
      call messages_warning(1)
    end if
    call restart%end()
 
  end subroutine iteration_counter_restart_write
 
  ! ---------------------------------------------------------
  logical function iteration_counter_restart_read(this, filename, namespace) result(success)
    class(iteration_counter_t),    intent(inout) :: this
    character(len=*),  intent(in) :: filename
    type(namespace_t), intent(in) :: namespace
 
    type(restart_basic_t) :: restart
    integer :: restart_file_unit
    integer :: ierr
 
    call restart%init(namespace, restart_iteration, restart_type_load, ierr)
 
    if (ierr == 0) then
      restart_file_unit = restart%open(filename)
      read(restart_file_unit, *) this%iteration, this%step
      call restart%close(restart_file_unit)
      this%global_iteration = this%iteration * this%step
 
    end if
 
    call restart%end()
 
    success = (ierr == 0)
 
  end function iteration_counter_restart_read
 
end module iteration_counter_oct_m