algorithm.F90

Go to the documentation of this file.

!! Copyright (C)  2020 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.
!!
 
#include "global.h"
 
module algorithm_oct_m
  use clock_oct_m
  use debug_oct_m
  use global_oct_m
  use linked_list_oct_m
  use loct_oct_m
  use messages_oct_m
  use profiling_oct_m
 
  implicit none
 
  private
  public ::                  &
    algorithmic_operation_t, &
    algorithm_t,             &
    algorithm_iterator_t
 
  integer, parameter, public :: ALGO_LABEL_LEN = 50
 
  type :: algorithmic_operation_t
    character(len=ALGO_LABEL_LEN) :: id
    character(len=ALGO_LABEL_LEN) :: label
  end type algorithmic_operation_t
 
  !# doc_start generic_algorithmic_operations
  ! Operations that can be used by any algorithm and, therefore, should be
  ! implemented by all systems.
  character(len=ALGO_LABEL_LEN), public, parameter ::   &
    SKIP                 = 'SKIP',                      &
    update_interactions  = 'UPDATE_INTERACTIONS',       &
    step_done            = 'STEP_DONE',                 &
    rewind_algorithm     = 'REWIND_ALGORITHM'
 
  type(algorithmic_operation_t), public, parameter :: &
    OP_SKIP                 = algorithmic_operation_t(skip,                 'Skipping algorithmic step'), &
    op_update_interactions  = algorithmic_operation_t(update_interactions,  'Algorithmic step - Updating interactions'), &
    op_step_done            = algorithmic_operation_t(step_done,            'Propagation step finished'), &
    op_rewind_algorithm     = algorithmic_operation_t(rewind_algorithm,     'Rewind algorithm')
  !# doc_end
 
 
  type, extends(linked_list_iterator_t) :: algorithm_iterator_t
    private
  contains
    procedure :: get_next => algorithm_iterator_get_next
  end type algorithm_iterator_t
 
 
  type, extends(linked_list_t), abstract :: algorithm_t
    private
    type(algorithm_iterator_t), public :: iter
    type(algorithmic_operation_t) :: current_ops
 
    type(algorithmic_operation_t), public       :: start_step
    type(algorithmic_operation_t), public       :: final_step
 
    integer, public :: algo_steps
    float, public   :: dt
 
    logical :: step_done
    logical, public :: inside_scf = .false.
 
    type(clock_t), public :: clock
    float :: start_time = m_zero
    float, public :: elapsed_time = m_zero
 
    logical, public :: is_static = .false.
  contains
    procedure :: add_operation => algorithm_add_operation
    procedure :: do_operation => algorithm_do_operation
    procedure :: update_elapsed_time => algorithm_update_elapsed_time
    procedure :: rewind => algorithm_rewind
    procedure :: next => algorithm_next
    procedure :: get_current_operation => algorithm_get_current_operation
    procedure(algorithm_finished), deferred :: finished
  end type algorithm_t
 
  abstract interface
    logical function algorithm_finished(this)
      import :: algorithm_t
      class(algorithm_t), intent(in) :: this
    end function algorithm_finished
  end interface
 
contains
 
  ! ---------------------------------------------------------
  subroutine algorithm_add_operation(this, operation)
    class(algorithm_t),            intent(inout) :: this
    type(algorithmic_operation_t), intent(in)    :: operation
 
    push_sub(algorithm_add_operation)
 
    call this%add_copy(operation)
 
    pop_sub(algorithm_add_operation)
  end subroutine algorithm_add_operation
 
  ! ---------------------------------------------------------
  logical function algorithm_do_operation(this, operation) result(done)
    class(algorithm_t),            intent(inout) :: this
    type(algorithmic_operation_t), intent(in)    :: operation
 
    ! By default no algorithm specific operation is implemented in the algorithm
    ! class. Child classes that wish to change this behaviour should override
    ! this method.
    done = .false.
 
  end function algorithm_do_operation
 
  ! ---------------------------------------------------------
  subroutine algorithm_update_elapsed_time(this)
    class(algorithm_t), intent(inout) :: this
 
    push_sub(algorithm_update_elapsed_time)
 
    this%elapsed_time = loct_clock() - this%start_time
 
    pop_sub(algorithm_update_elapsed_time)
  end subroutine algorithm_update_elapsed_time
 
  ! ---------------------------------------------------------
  subroutine algorithm_rewind(this)
    class(algorithm_t), intent(inout) :: this
 
    push_sub(algorithm_rewind)
 
    call this%iter%start(this)
    call this%next()
    this%start_time = loct_clock()
 
    pop_sub(algorithm_rewind)
  end subroutine algorithm_rewind
 
  ! ---------------------------------------------------------
  subroutine algorithm_next(this)
    class(algorithm_t), intent(inout) :: this
 
    push_sub(algorithm_next)
 
    this%current_ops = this%iter%get_next()
 
    pop_sub(algorithm_next)
  end subroutine algorithm_next
 
  ! ---------------------------------------------------------
  type(algorithmic_operation_t) function algorithm_get_current_operation(this) result(operation)
    class(algorithm_t), intent(in) :: this
 
    push_sub(algorithm_get_current_operation)
 
    operation = this%current_ops
 
    pop_sub(algorithm_get_current_operation)
  end function algorithm_get_current_operation
 
  ! ---------------------------------------------------------
  function algorithm_iterator_get_next(this) result(operation)
    class(algorithm_iterator_t),  intent(inout) :: this
    type(algorithmic_operation_t)               :: operation
 
    push_sub(algorithm_iterator_get_next)
 
    select type (ptr => this%get_next_ptr())
    class is (algorithmic_operation_t)
      operation = ptr
    class default
      assert(.false.)
    end select
 
    pop_sub(algorithm_iterator_get_next)
  end function algorithm_iterator_get_next
 
end module algorithm_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: