multipole_types.F

Go to the documentation of this file.

!--------------------------------------------------------------------------------------------------!
!   CP2K: A general program to perform molecular dynamics simulations                              !
!   Copyright 2000-2024 CP2K developers group <https://cp2k.org>                                   !
!                                                                                                  !
!   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
!--------------------------------------------------------------------------------------------------!
 
! **************************************************************************************************
!> \brief Multipole structure: for multipole (fixed and induced) in FF based MD
!> \author Teodoro Laino [tlaino] - University of Zurich - 12.2007
! **************************************************************************************************
MODULE multipole_types
   USE atomic_kind_types,               ONLY: get_atomic_kind
   USE external_potential_types,        ONLY: fist_potential_type,&
                                              get_potential
   USE input_section_types,             ONLY: section_vals_get,&
                                              section_vals_get_subs_vals,&
                                              section_vals_type,&
                                              section_vals_val_get
   USE kinds,                           ONLY: dp
   USE particle_types,                  ONLY: particle_type
#include "../base/base_uses.f90"
 
   IMPLICIT NONE
 
   PRIVATE
   PUBLIC :: multipole_type, &
             create_multipole_type, &
             release_multipole_type
 
   INTEGER, PARAMETER, PUBLIC               :: do_multipole_none = -1, &
                                               do_multipole_charge = 0, &
                                               do_multipole_dipole = 1, &
                                               do_multipole_quadrupole = 2
 
! **************************************************************************************************
!> \brief Define multipole type
!> \param error variable to control error logging, stopping,...
!>        see module cp_error_handling
!> \par History
!>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
!> \author Teodoro Laino
! **************************************************************************************************
   TYPE multipole_type
      LOGICAL, DIMENSION(3)                    :: task = .false.
      REAL(kind=dp), DIMENSION(:), POINTER     :: charges => null()
      REAL(kind=dp), DIMENSION(:), POINTER     :: radii => null()
      REAL(kind=dp), DIMENSION(:, :), POINTER   :: dipoles => null()
      REAL(kind=dp), DIMENSION(:, :, :), POINTER :: quadrupoles => null()
   END TYPE multipole_type
 
   CHARACTER(len=*), PARAMETER, PRIVATE :: modulen = 'multipole_types'
 
CONTAINS
 
! **************************************************************************************************
!> \brief Create a multipole type
!> \param multipoles ...
!> \param particle_set ...
!> \param subsys_section ...
!> \param max_multipole ...
!> \par History
!>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
!> \author Teodoro Laino
! **************************************************************************************************
   SUBROUTINE create_multipole_type(multipoles, particle_set, subsys_section, max_multipole)
      TYPE(multipole_type), INTENT(OUT)                  :: multipoles
      TYPE(particle_type), DIMENSION(:), INTENT(IN)      :: particle_set
      TYPE(section_vals_type), POINTER                   :: subsys_section
      INTEGER, INTENT(IN)                                :: max_multipole
 
      INTEGER                                            :: i, ind2, iparticle, j, n_rep, nparticles
      LOGICAL                                            :: explicit
      REAL(kind=dp), DIMENSION(:), POINTER               :: work
      TYPE(fist_potential_type), POINTER                 :: fist_potential
      TYPE(section_vals_type), POINTER                   :: work_section
 
      SELECT CASE (max_multipole)
      CASE (do_multipole_none)
         ! Do nothing..
      CASE (do_multipole_charge)
         multipoles%task(1:1) = .true.
      CASE (do_multipole_dipole)
         multipoles%task(1:2) = .true.
      CASE (do_multipole_quadrupole)
         multipoles%task(1:3) = .true.
      CASE DEFAULT
         cpabort("")
      END SELECT
      nparticles = SIZE(particle_set)
      IF (multipoles%task(1)) THEN
         ALLOCATE (multipoles%charges(nparticles))
         ALLOCATE (multipoles%radii(nparticles))
         ! Fill in charge array
         DO iparticle = 1, nparticles
            !atomic_kind =>
            CALL get_atomic_kind(particle_set(iparticle)%atomic_kind, &
                                 fist_potential=fist_potential)
            CALL get_potential(fist_potential, qeff=multipoles%charges(iparticle), &
                               mm_radius=multipoles%radii(iparticle))
         END DO
      END IF
      IF (multipoles%task(2)) THEN
         ALLOCATE (multipoles%dipoles(3, nparticles))
         ! Fill in dipole array (if specified)
         work_section => section_vals_get_subs_vals(subsys_section, "MULTIPOLES%DIPOLES")
         CALL section_vals_get(work_section, explicit=explicit)
         IF (explicit) THEN
            CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", n_rep_val=n_rep)
            cpassert(n_rep == nparticles)
            DO iparticle = 1, n_rep
               CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", i_rep_val=iparticle, r_vals=work)
               multipoles%dipoles(1:3, iparticle) = work
            END DO
         ELSE
            multipoles%dipoles = 0.0_dp
         END IF
      END IF
      IF (multipoles%task(3)) THEN
         ALLOCATE (multipoles%quadrupoles(3, 3, nparticles))
         ! Fill in quadrupole array (if specified)
         work_section => section_vals_get_subs_vals(subsys_section, "MULTIPOLES%QUADRUPOLES")
         CALL section_vals_get(work_section, explicit=explicit)
         IF (explicit) THEN
            CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", n_rep_val=n_rep)
            cpassert(n_rep == nparticles)
            DO iparticle = 1, n_rep
               CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", i_rep_val=iparticle, r_vals=work)
               DO i = 1, 3
                  DO j = 1, 3
                     ind2 = 3*(min(i, j) - 1) - (min(i, j)*(min(i, j) - 1))/2 + max(i, j)
                     multipoles%quadrupoles(i, j, iparticle) = work(ind2)
                  END DO
               END DO
            END DO
         ELSE
            multipoles%quadrupoles = 0.0_dp
         END IF
      END IF
   END SUBROUTINE create_multipole_type
 
! **************************************************************************************************
!> \brief ...
!> \param multipoles ...
!> \par History
!>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
!> \author Teodoro Laino
! **************************************************************************************************
   SUBROUTINE release_multipole_type(multipoles)
      TYPE(multipole_type), INTENT(INOUT)                :: multipoles
 
      IF (ASSOCIATED(multipoles%charges)) THEN
         DEALLOCATE (multipoles%charges)
      END IF
      IF (ASSOCIATED(multipoles%radii)) THEN
         DEALLOCATE (multipoles%radii)
      END IF
      IF (ASSOCIATED(multipoles%dipoles)) THEN
         DEALLOCATE (multipoles%dipoles)
      END IF
      IF (ASSOCIATED(multipoles%quadrupoles)) THEN
         DEALLOCATE (multipoles%quadrupoles)
      END IF
 
   END SUBROUTINE release_multipole_type
 
END MODULE multipole_types