atom.F90

Go to the documentation of this file.

#include "global.h"
 
module atom_oct_m
  use debug_oct_m
  use global_oct_m
  use jellium_oct_m
  use messages_oct_m
  use profiling_oct_m
  use species_oct_m
  use unit_oct_m
 
  implicit none
 
  private
  public ::                               &
    atom_init,                            &
    atom_set_species,                     &
    atom_get_species,                     &
    atom_same_species,                    &
    all_species_are_jellium_slab,         &
    any_species_is_jellium_sphere
 
  type, public :: atom_t
    !private
    character(len=LABEL_LEN)  :: label = ""
    class(species_t), pointer  :: species => null() 
    integer, allocatable       :: c(:)
 
    !Components of the force
    real(real64), allocatable :: f_ii(:)
    real(real64), allocatable :: f_vdw(:)
    real(real64), allocatable :: f_loc(:)
    real(real64), allocatable :: f_nl(:)
    real(real64), allocatable :: f_fields(:)
    real(real64), allocatable :: f_u(:)
    real(real64), allocatable :: f_scf(:)
    real(real64), allocatable :: f_nlcc(:)
    real(real64), allocatable :: f_photons(:)
  contains
    procedure :: copy => atom_copy
    generic   :: assignment(=) => copy
    procedure :: get_label => atom_get_label
    final :: atom_finalize
  end type atom_t
 
  interface atom_same_species
    module procedure atom_same_species_aa
    module procedure atom_same_species_as
  end interface atom_same_species
 
contains
 
  ! ---------------------------------------------------------
  subroutine atom_init(this, dim, label, species)
    type(atom_t),                      intent(out) :: this
    integer,                           intent(in)  :: dim
    character(len=*),                  intent(in)  :: label
    class(species_t), target, optional, intent(in)  :: species
 
    push_sub(atom_init)
 
    this%label = trim(adjustl(label))
    this%species => null()
    if (present(species)) this%species => species
 
    safe_allocate(this%c(1:dim))
    this%c = 0
 
    safe_allocate(this%f_ii(1:dim))
    safe_allocate(this%f_vdw(1:dim))
    safe_allocate(this%f_loc(1:dim))
    safe_allocate(this%f_nl(1:dim))
    safe_allocate(this%f_fields(1:dim))
    safe_allocate(this%f_u(1:dim))
    safe_allocate(this%f_scf(1:dim))
    safe_allocate(this%f_nlcc(1:dim))
    safe_allocate(this%f_photons(1:dim))
    this%f_ii      = m_zero
    this%f_vdw     = m_zero
    this%f_loc     = m_zero
    this%f_nl      = m_zero
    this%f_fields  = m_zero
    this%f_u       = m_zero
    this%f_scf     = m_zero
    this%f_nlcc    = m_zero
    this%f_photons = m_zero
 
    pop_sub(atom_init)
  end subroutine atom_init
 
  ! ---------------------------------------------------------
  subroutine atom_copy(atom_out, atom_in)
    class(atom_t), intent(out) :: atom_out
    class(atom_t), intent(in)  :: atom_in
 
    push_sub(atom_copy)
 
    atom_out%label = atom_in%label
    atom_out%species => atom_in%species
 
    safe_allocate_source_a(atom_out%c,         atom_in%c)
    safe_allocate_source_a(atom_out%f_ii,      atom_in%f_ii)
    safe_allocate_source_a(atom_out%f_vdw,     atom_in%f_vdw)
    safe_allocate_source_a(atom_out%f_loc,     atom_in%f_loc)
    safe_allocate_source_a(atom_out%f_nl,      atom_in%f_nl)
    safe_allocate_source_a(atom_out%f_fields,  atom_in%f_fields)
    safe_allocate_source_a(atom_out%f_u,       atom_in%f_u)
    safe_allocate_source_a(atom_out%f_scf,     atom_in%f_scf)
    safe_allocate_source_a(atom_out%f_nlcc,    atom_in%f_nlcc)
    safe_allocate_source_a(atom_out%f_photons, atom_in%f_photons)
 
    pop_sub(atom_copy)
  end subroutine atom_copy
 
  ! ---------------------------------------------------------
  impure elemental subroutine atom_finalize(this)
    type(atom_t), intent(inout) :: this
 
    push_sub(atom_finalize)
 
    this%label = ""
    this%species => null()
 
    safe_deallocate_a(this%c)
 
    safe_deallocate_a(this%f_ii)
    safe_deallocate_a(this%f_vdw)
    safe_deallocate_a(this%f_loc)
    safe_deallocate_a(this%f_nl)
    safe_deallocate_a(this%f_fields)
    safe_deallocate_a(this%f_u)
    safe_deallocate_a(this%f_scf)
    safe_deallocate_a(this%f_nlcc)
    safe_deallocate_a(this%f_photons)
 
    pop_sub(atom_finalize)
  end subroutine atom_finalize
 
  ! ---------------------------------------------------------
 
  pure function atom_get_label(this) result(label)
    class(atom_t), intent(in) :: this
 
    character(len=len_trim(adjustl(this%label))) :: label
 
    label=trim(adjustl(this%label))
 
  end function atom_get_label
 
  ! ---------------------------------------------------------
  subroutine atom_set_species(this, species)
    type(atom_t),             intent(inout) :: this
    class(species_t), target, intent(in)    :: species
 
    push_sub(atom_set_species)
 
    this%species => species
    pop_sub(atom_set_species)
 
  end subroutine atom_set_species
 
  ! ---------------------------------------------------------
  subroutine atom_get_species(this, species)
    type(atom_t),     target,  intent(in)  :: this
    class(species_t), pointer, intent(out) :: species
 
    ! NO PUSH_SUB, called too often
 
    species => null()
    if (associated(this%species)) species => this%species
 
  end subroutine atom_get_species
 
  ! ---------------------------------------------------------
  elemental function atom_same_species_aa(this, that) result(is)
    type(atom_t), intent(in) :: this
    type(atom_t), intent(in) :: that
 
    logical :: is
 
    is = this%label == that%label
 
  end function atom_same_species_aa
 
  ! ---------------------------------------------------------
  elemental function atom_same_species_as(this, species) result(is)
    type(atom_t),     intent(in) :: this
    class(species_t), intent(in) :: species
 
    logical :: is
 
    is = this%label == species%get_label()
 
  end function atom_same_species_as
 
  pure logical function all_species_are_jellium_slab(atom)
    type(atom_t), intent(in)  :: atom(:)
 
    integer                   :: i
 
    all_species_are_jellium_slab = .true.
    do i = 1, size(atom)
      select type(spec => atom(i)%species)
      type is(jellium_slab_t)
      class default
        all_species_are_jellium_slab = .false.
      end select
    enddo
 
  end function all_species_are_jellium_slab
 
  pure logical function any_species_is_jellium_sphere(atom)
    type(atom_t), intent(in)  :: atom(:)
 
    integer                   :: i
 
    any_species_is_jellium_sphere = .false.
    do i = 1, size(atom)
      select type(spec => atom(i)%species)
      type is(jellium_sphere_t)
        any_species_is_jellium_sphere = .true.
      end select
    enddo
 
  end function any_species_is_jellium_sphere
 
end module atom_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: