box_minimum.F90

Go to the documentation of this file.

!! Copyright (C) 2002-2006 M. Marques, A. Castro, A. Rubio, G. Bertsch
!! Copyright (C) 2021 M. Oliveira, K. Lively, A. Obzhirov, I. Albar
!!
!! 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 box_minimum_oct_m
  use box_oct_m
  use box_shape_oct_m
  use debug_oct_m
  use global_oct_m
  use lookup_oct_m
  use math_oct_m
  use messages_oct_m
  use namespace_oct_m
  use profiling_oct_m
  use unit_oct_m
  use unit_system_oct_m
 
  implicit none
 
  private
  public :: box_minimum_t
 
  type, extends(box_shape_t) :: box_minimum_t
    private
    real(real64), public :: radius = m_zero 
    integer :: n_sites
    real(real64), allocatable :: site_position(:,:)
    type(lookup_t) :: site_lookup
  contains
    procedure :: shape_contains_points => box_minimum_shape_contains_points
    procedure :: write_info => box_minimum_write_info
    procedure :: short_info => box_minimum_short_info
    final     :: box_minimum_finalize
  end type box_minimum_t
 
  interface box_minimum_t
    procedure box_minimum_constructor
  end interface box_minimum_t
 
contains
 
  !--------------------------------------------------------------
  function box_minimum_constructor(dim, radius, n_sites, site_position, namespace) result(box)
    integer,                  intent(in) :: dim
    real(real64),             intent(in) :: radius
    integer,                  intent(in) :: n_sites
    real(real64),             intent(in) :: site_position(1:dim,1:n_sites)
    type(namespace_t),        intent(in) :: namespace
    class(box_minimum_t), pointer :: box
 
    real(real64) :: center(dim)
 
    push_sub(box_minimum_constructor)
 
    ! Allocate memory
    safe_allocate(box)
 
    ! Initialize box
    center = m_zero
    call box_shape_init(box, namespace, dim, center, bounding_box_min=minval(abs(site_position), dim=2) - radius, &
      bounding_box_max=maxval(abs(site_position), dim=2) + radius)
    box%radius = radius
    box%n_sites = n_sites
    safe_allocate_source(box%site_position, site_position)
 
    box%bounding_box_l = maxval(abs(site_position), dim=2) + box%radius
 
    call lookup_init(box%site_lookup, box%dim, box%n_sites, box%site_position)
 
    pop_sub(box_minimum_constructor)
  end function box_minimum_constructor
 
  !--------------------------------------------------------------
  subroutine box_minimum_finalize(this)
    type(box_minimum_t), intent(inout) :: this
 
    push_sub(box_minimum_finalize)
 
    call lookup_end(this%site_lookup)
 
    safe_deallocate_a(this%site_position)
 
    call box_shape_end(this)
 
    pop_sub(box_minimum_finalize)
  end subroutine box_minimum_finalize
 
  !--------------------------------------------------------------
  function box_minimum_shape_contains_points(this, nn, xx) result(contained)
    class(box_minimum_t), intent(in)  :: this
    integer,              intent(in)  :: nn
    real(real64), contiguous,    intent(in)  :: xx(:,:)
    logical :: contained(1:nn)
 
    integer :: ip
    integer, allocatable :: nlist(:)
 
    safe_allocate(nlist(1:nn))
 
    call lookup_get_list(this%site_lookup, nn, xx, this%radius + box_boundary_delta, nlist)
 
    do ip = 1, nn
      contained(ip) = nlist(ip) /= 0 .neqv. this%is_inside_out()
    end do
 
    safe_deallocate_a(nlist)
 
  end function box_minimum_shape_contains_points
 
  !--------------------------------------------------------------
  subroutine box_minimum_write_info(this, iunit, namespace)
    class(box_minimum_t),        intent(in) :: this
    integer,           optional, intent(in) :: iunit
    type(namespace_t), optional, intent(in) :: namespace
 
    push_sub(box_minimum_write_info)
 
    write(message(1), '(2x,a)') 'Type = minimum'
    call messages_info(1, iunit, namespace=namespace)
    write(message(1),'(2x,3a,f7.3)') 'Radius  [', trim(units_abbrev(units_out%length)), '] = ', &
      units_from_atomic(units_out%length, this%radius)
    call messages_info(1, iunit, namespace=namespace)
 
    pop_sub(box_minimum_write_info)
  end subroutine box_minimum_write_info
 
  !--------------------------------------------------------------
  character(len=BOX_INFO_LEN) function box_minimum_short_info(this, unit_length) result(info)
    class(box_minimum_t), intent(in) :: this
    type(unit_t),         intent(in) :: unit_length
 
    push_sub(box_minimum_short_info)
 
    write(info,'(a,f11.6,a,a)') 'BoxShape = minimum; Radius =', units_from_atomic(unit_length, this%radius), ' ', &
      trim(units_abbrev(unit_length))
 
    pop_sub(box_minimum_short_info)
  end function box_minimum_short_info
 
end module box_minimum_oct_m
 
!! Local Variables:
!! mode: f90
!! coding: utf-8
!! End: