algorithm.F90

Go to the documentation of this file.

!! Copyright (C)  2020 M. Oliveira
!!
!! This Source Code Form is subject to the terms of the Mozilla Public
!! License, v. 2.0. If a copy of the MPL was not distributed with this
!! file, You can obtain one at https://mozilla.org/MPL/2.0/.
!!
 
#include "global.h"
 
! The following pseudocode shows how multiple algorithms, one per system, are executed:
! @code
!  repeat
!    for all systems do
!      algo_op ← next algorithmic operation
!      break ← f alse
!      while not break do
!        if algo_op != update interactions then
!          execute algorithmic operation
!          algo_op ← next algorithmic operation
!        else
!          try updating interactions
!          if interactions updated then
!            algo_op ← next algorithmic operation
!          end if
!          break ← true
!        end if
!      end while
!    end for
!  until all algorithms finished
! @endcode
!
! Note: The above codeblock is not enabled for doxygen, as the formatting is broken in doxygen.
!
!TODO: the concept of granularity also needs to be explained more in detail.
module algorithm_oct_m
  use debug_oct_m
  use global_oct_m
  use iteration_counter_oct_m
  use linked_list_oct_m
  use loct_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
  character(len=ALGO_LABEL_LEN), public, parameter ::   &
    SKIP                 = 'SKIP',                      &
    update_couplings     = 'UPDATE_COUPLINGS',          &
    update_interactions  = 'UPDATE_INTERACTIONS',       &
    iteration_done       = 'ITERATION_DONE',            &
    rewind_algorithm     = 'REWIND_ALGORITHM'
 
  type(algorithmic_operation_t), public, parameter :: &
    OP_SKIP                = algorithmic_operation_t(skip,                'Skipping algorithmic operation'), &
    op_update_couplings    = algorithmic_operation_t(update_couplings,    'Algorithmic operation - Updating couplings'), &
    op_update_interactions = algorithmic_operation_t(update_interactions, 'Algorithmic operation - Updating interactions'), &
    op_iteration_done      = algorithmic_operation_t(iteration_done,      'Iteration 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_operation
 
    type(algorithmic_operation_t), public  :: final_operation
 
    integer, public :: algo_steps
 
    logical :: iteration_done
 
    type(iteration_counter_t), public :: iteration
    real(real64) :: start_time = m_zero                          
    real(real64), public :: elapsed_time = m_zero                
 
  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
    procedure(algorithm_init_iteration_counters), deferred :: init_iteration_counters
    procedure(algorithm_write_output_header), deferred :: write_output_header
    procedure(algorithm_continues_after_finished), deferred :: continues_after_finished
    procedure(algorithm_print_speed), deferred :: print_speed
  end type algorithm_t
 
  abstract interface
 
    !
    logical function algorithm_finished(this)
      import :: algorithm_t
      class(algorithm_t), intent(in) :: this
    end function algorithm_finished
 
    !
    subroutine algorithm_init_iteration_counters(this)
      import :: algorithm_t
      class(algorithm_t), intent(inout) :: this
    end subroutine algorithm_init_iteration_counters
 
    !
    subroutine algorithm_write_output_header(this)
      import :: algorithm_t
      class(algorithm_t), intent(in) :: this
    end subroutine algorithm_write_output_header
 
    !
    logical function algorithm_continues_after_finished(this)
      import :: algorithm_t
      class(algorithm_t), intent(in) :: this
    end function algorithm_continues_after_finished
 
    !
    subroutine algorithm_print_speed(this)
      import :: algorithm_t
      class(algorithm_t), intent(in) :: this
    end subroutine algorithm_print_speed
  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)
 
    ! Note that both lines are necessary to get the first element of the list.
    ! For more information, see the linked_list_t implementation.
    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)
 
    assert(this%has_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: