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 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 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,  & 
    system_multisystem        = 9,  & 
    system_ions               = 10    
  !# 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) result(system)
    class(system_factory_t), intent(in) :: this
    type(namespace_t),       intent(in) :: namespace
    integer,                 intent(in) :: type
    class(system_t),         pointer    :: system
 
    integer :: n_systems, is, ic, iother
    type(block_t) :: blk
    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.
    !%End
    select case (type)
    case (system_multisystem)
 
      ! 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
 
      system => multisystem_basic_t(namespace, names, types, this)
 
      safe_deallocate_a(names)
      safe_deallocate_a(types)
 
    case (system_electronic)
      system => electrons_t(namespace)
    case (system_maxwell)
      system => maxwell_t(namespace)
    case (system_classical_particle)
      system => classical_particle_t(namespace)
    case (system_charged_particle)
      system => charged_particle_t(namespace)
    case (system_dftbplus)
      system => dftb_t(namespace)
    case (system_linear_medium)
      system => linear_medium_t(namespace)
    case (system_matter)
      system => matter_t(namespace)
    case (system_dispersive_medium)
      system => dispersive_medium_t(namespace)
      call messages_experimental('dispersive_medium', namespace=namespace)
    case (system_ions)
      system => ions_t(namespace)
    case default
      call messages_input_error(namespace, 'Systems', 'Unknown system type.')
    end select
 
    pop_sub(system_factory_create)
  end function system_factory_create
 
end module system_factory_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: