system_factory.F90

Go to the documentation of this file.

!! Copyright (C) 2020, 2022 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 system_factory_oct_m
 
  use charged_particle_oct_m
  use classical_particle_oct_m
  use debug_oct_m
  use dftb_oct_m
  use dispersive_medium_oct_m
  use electrons_oct_m
  use ensemble_oct_m
  use global_oct_m
  use ions_oct_m
  use linear_medium_oct_m
  use matter_oct_m
  use maxwell_oct_m
  use messages_oct_m
  use mpi_oct_m
  use multisystem_basic_oct_m
  use namespace_oct_m
  use parser_oct_m
  use profiling_oct_m
  use photons_oct_m
  use system_oct_m
  use system_factory_abst_oct_m
  implicit none
 
  private
  public ::                         &
    system_factory_t
 
 
  !# doc_start system_types
  integer, parameter, public ::             &
    SYSTEM_ELECTRONIC         = 1,  & !< electronic system (electrons_oct_m::electrons_t)
    system_maxwell            = 2,  & 
    system_classical_particle = 3,  & 
    system_charged_particle   = 4,  & 
    system_dftbplus           = 5,  & 
    system_linear_medium      = 6,  & 
    system_matter             = 7,  & 
    system_dispersive_medium  = 8,  & 
  !                                 !! (dispersive_medium_oct_m::dispersive_medium_t)
    system_multisystem        = 9,  & 
    system_ions               = 10, & 
    system_ensemble           = 11    
  !# doc_end
 
  type, extends(system_factory_abst_t) :: system_factory_t
  contains
    procedure :: create => system_factory_create         
  end type system_factory_t
 
contains
 
  ! ---------------------------------------------------------------------------------------
  recursive function system_factory_create(this, namespace, type, calc_mode_id, grp) result(system)
    class(system_factory_t), intent(in) :: this
    type(namespace_t),       intent(in) :: namespace
    integer,                 intent(in) :: type
    integer,                 intent(in) :: calc_mode_id
    type(mpi_grp_t),         intent(in) :: grp
    class(system_t),         pointer    :: system
 
    integer :: n_replicas, first, last
    character(len=128), allocatable :: names(:)
    integer, allocatable :: types(:)
 
    push_sub(system_factory_create)
 
    !%Variable Systems
    !%Type block
    !%Section System
    !%Description
    !% List of systems that will be treated in the calculation.
    !% The first column should be a string containing the system name.
    !% The second column should be the system type. See below for a list of
    !% available system types.
    !%Option electronic 1
    !% An electronic system. (not fully implemented yet)
    !%Option maxwell 2
    !% A maxwell system.
    !%Option classical_particle 3
    !% A classical particle. Used for testing purposes only.
    !%Option charged_particle 4
    !% A charged classical particle.
    !%Option dftbplus 5
    !% A DFTB+ system
    !%Option linear_medium 6
    !% A linear medium for classical electrodynamics.
    !%Option matter 7
    !% A matter system containing electrons and classical ions.
    !%Option dispersive_medium 8
    !% (Experimental) A dispersive medium for classical electrodynamics.
    !%Option multisystem 9
    !% A system containing other systems.
    !%Option ions 10
    !% An ensemble of classical charged particles.
    !%Option ensemble 11
    !% An ensemble for multitrajectory runs
    !%End
    select case (type)
    case (system_multisystem)
 
      call parse_subsystems(namespace, names, types)
 
      system => multisystem_basic_t(namespace, names, types, this, calc_mode_id, grp)
 
      safe_deallocate_a(names)
      safe_deallocate_a(types)
 
    case (system_electronic)
      system => electrons_t(namespace, grp, calc_mode_id)
    case (system_maxwell)
      system => maxwell_t(namespace, grp)
    case (system_classical_particle)
      system => classical_particle_t(namespace, grp)
    case (system_charged_particle)
      system => charged_particle_t(namespace, grp)
    case (system_dftbplus)
      system => dftb_t(namespace, grp)
    case (system_linear_medium)
      system => linear_medium_t(namespace, grp)
    case (system_matter)
      system => matter_t(namespace, grp)
    case (system_dispersive_medium)
      system => dispersive_medium_t(namespace, grp)
      call messages_experimental('dispersive_medium', namespace=namespace)
    case (system_ions)
      system => ions_t(namespace, grp)
    case (system_ensemble)
      !%Variable NumberOfReplicas
      !%Type integer
      !%Default 1
      !%Section System
      !%Description
      !% Number of replicas to be created for the ensemble.
      !%End
      call parse_variable(namespace, 'NumberOfReplicas', 1, n_replicas)
      if (debug%info) then
        write(message(1), '(a,i5,a)') "The ensemble has ", n_replicas, " replicas"
        call messages_info(1, namespace=namespace)
      end if
 
      !%Variable FirstReplica
      !%Type integer
      !%Default 1
      !%Section Multi-Trajectory
      !%Description
      !% First replica to be calculated in this run.
      !%End
      call parse_variable(namespace, 'FirstReplica', 1, first)
 
      !%Variable LastReplica
      !%Type integer
      !%Default 0
      !%Section Multi-Trajectory
      !%Description
      !% Last replica to be calculated in this run.
      !%End
      call parse_variable(namespace, 'LastReplica', n_replicas, last)
 
      call parse_subsystems(namespace, names, types)
 
      system => ensemble_t(namespace, n_replicas, first, last, this, names, types, calc_mode_id, grp)
 
      safe_deallocate_a(names)
      safe_deallocate_a(types)
 
    case default
      call messages_input_error(namespace, 'Systems', 'Unknown system type.')
    end select
 
    pop_sub(system_factory_create)
  end function system_factory_create
 
 
  subroutine parse_subsystems(namespace, names, types)
    type(namespace_t),               intent(in) :: namespace
    character(len=128), allocatable, intent(out) :: names(:)
    integer,            allocatable, intent(out) :: types(:)
 
    integer :: n_systems, is, ic, iother
    type(block_t) :: blk
 
    ! Parse the input file to get the list of subsystems
    if (parse_block(namespace, 'Systems', blk) == 0) then
 
      n_systems = parse_block_n(blk)
      safe_allocate(names(1:n_systems))
      safe_allocate(types(1:n_systems))
 
      do is = 1, n_systems
        ! Parse system name and type
        call parse_block_string(blk, is - 1, 0, names(is))
        if (len_trim(names(is)) == 0) then
          call messages_input_error(namespace, 'Systems', 'All systems must have a name')
        end if
        do ic = 1, len(parser_varname_excluded_characters)
          if (index(trim(names(is)), parser_varname_excluded_characters(ic:ic)) /= 0) then
            call messages_input_error(namespace, 'Systems', &
              'Illegal character "' // parser_varname_excluded_characters(ic:ic) // '" in system name', row=is-1, column=0)
          end if
        end do
        call parse_block_integer(blk, is - 1, 1, types(is))
 
        ! Check that the system name is unique
        do iother = 1, is-1
          if (names(is) == names(iother)) then
            call messages_input_error(namespace, 'Systems', 'Duplicated system in multi-system', &
              row=is-1, column=0)
          end if
        end do
 
      end do
      call parse_block_end(blk)
    else
      call messages_input_error(namespace, 'Systems', 'Missing Systems block')
    end if
 
  end subroutine parse_subsystems
 
 
end module system_factory_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: