quantity.F90

Go to the documentation of this file.

!! Copyright (C) 2020 N. Tancogne-Dejean
!!
!! 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 quantity_oct_m
  use iteration_counter_oct_m
  use linked_list_oct_m
  implicit none
 
  private
  public ::                   &
    quantity_t,               &
    quantity_list_t,          &
    quantity_iterator_t
 
  type, extends(linked_list_t) :: quantity_list_t
    private
  contains
    procedure :: add => quantity_list_add_node 
    procedure :: get => quantity_list_get 
    procedure :: always_available => quantity_list_always_available  
    procedure :: iteration_equal => quantity_list_iteration_equal  
  end type quantity_list_t
 
  type, extends(linked_list_iterator_t) :: quantity_iterator_t
    private
  contains
    procedure :: get_next => quantity_iterator_get_next 
  end type quantity_iterator_t
 
  type quantity_t
    private
    character(len=:), allocatable, public :: label
    !                                                   !!
    !                                                   !! @note It is the responsibility of the developers to ensure the labels are unique.
 
    type(iteration_counter_t), public :: iteration
    !                                                   !!
    !                                                   !! @note The iteration counter is initialized automatically
    !                                                   !! for extensions of system_t, but needs to be initialized explicitly for extensions of
    !                                                   !! interaction_partner_t, which are not systems. This can be done via the constructor of quantity_t.
 
    logical,       public :: always_available = .false. 
    !                                                   !!
    !                                                   !! (e.g., this will be true for a static quantity,
    !                                                   !! but false for a quantity that is only updated at specific iterations)
 
    logical,       public :: updated_on_demand = .true. 
    !                                                   !!
    !                                                   !! If true, the quantity is only updated when requested. The quantity should be calculated (updated)
    !                                                   !! in the systems update_quantity() routine.
    !                                                   !!
    !                                                   !! If false, the quantity is updated automatically during the execution of an algorithm.
    !                                                   !! In this case, the quantity should be updated inside the do_algorithmic_operation() routine.
 
    character(len=100), allocatable, public :: parents(:)
  end type quantity_t
 
  interface quantity_t
    module procedure quantity_constructor
  end interface quantity_t
 
contains
 
  function quantity_constructor(label, always_available, updated_on_demand, iteration, parents) result(quantity)
    character(len=*),                    intent(in) :: label
    logical,                   optional, intent(in) :: always_available
    logical,                   optional, intent(in) :: updated_on_demand
    type(iteration_counter_t), optional, intent(in) :: iteration
    character(len=*),          optional, intent(in) :: parents(:)
    type(quantity_t) :: quantity
 
    integer :: i
 
    quantity%label = trim(label)
    if (present(always_available)) then
      quantity%always_available = always_available
    end if
    if (present(updated_on_demand)) then
      quantity%updated_on_demand = updated_on_demand
    end if
    if (present(iteration)) then
      quantity%iteration = iteration
    end if
    if (present(parents)) then
      allocate(quantity%parents(size(parents)))
      do i = 1, size(parents)
        quantity%parents(i) = trim(parents(i))
      end do
    else
      allocate(quantity%parents(0))
    end if
 
  end function quantity_constructor
 
  ! ---------------------------------------------------------
  subroutine quantity_list_add_node(this, quantity)
    class(quantity_list_t)       :: this
    class(quantity_t),    target :: quantity
 
    call this%add_copy(quantity)
 
  end subroutine quantity_list_add_node
 
  ! ---------------------------------------------------------
  function quantity_list_get(this, label) result(quantity)
    class(quantity_list_t), intent(in) :: this
    character(len=*),       intent(in) :: label
    class(quantity_t),      pointer    :: quantity
 
    logical :: have
    type(quantity_iterator_t) :: iterator
 
    ! The following loop is not very efficient, but lists of quantities should
    ! not be larger than a few dozen at most
    have = .false.
    call iterator%start(this)
    do while (iterator%has_next() .and. .not. have)
      quantity => iterator%get_next()
      have = trim(quantity%label) == trim(label)
    end do
    if (.not. have) then
      nullify(quantity)
    end if
 
  end function quantity_list_get
 
  ! ---------------------------------------------------------
  function quantity_list_always_available(this, labels) result(always_available)
    class(quantity_list_t), intent(in) :: this
    character(len=*),       intent(in) :: labels(:)
    logical :: always_available(size(labels))
 
    integer :: i
    class(quantity_t), pointer :: quantity
 
    do i = 1, size(labels)
      quantity => this%get(labels(i))
      always_available(i) = quantity%always_available
    end do
 
  end function quantity_list_always_available
 
  ! ---------------------------------------------------------
  function quantity_list_iteration_equal(this, labels, iteration) result(equal)
    class(quantity_list_t),    intent(in) :: this
    character(len=*),          intent(in) :: labels(:)
    type(iteration_counter_t), intent(in) :: iteration
    logical :: equal(size(labels))
 
    integer :: i
    class(quantity_t), pointer :: quantity
 
    do i = 1, size(labels)
      quantity => this%get(labels(i))
      ! We need to ignore static quantities:
      equal(i) = quantity%iteration == iteration
    end do
 
  end function quantity_list_iteration_equal
 
  ! ---------------------------------------------------------
  function quantity_iterator_get_next(this) result(quantity)
    class(quantity_iterator_t), intent(inout) :: this
    class(quantity_t),          pointer       :: quantity
 
    select type (ptr => this%get_next_ptr())
    class is (quantity_t)
      quantity => ptr
    class default
      assert(.false.)
    end select
 
  end function quantity_iterator_get_next
 
end module quantity_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: