Line data    Source code

       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2022 CP2K developers group <https://cp2k.org>                                   !
       4             : !                                                                                                  !
       5             : !   SPDX-License-Identifier: GPL-2.0-or-later                                                      !
       6             : !--------------------------------------------------------------------------------------------------!
       7             : 
       8             : ! **************************************************************************************************
       9             : !> \brief Multipole structure: for multipole (fixed and induced) in FF based MD
      10             : !> \author Teodoro Laino [tlaino] - University of Zurich - 12.2007
      11             : ! **************************************************************************************************
      12             : MODULE multipole_types
      13             :    USE atomic_kind_types,               ONLY: get_atomic_kind
      14             :    USE external_potential_types,        ONLY: fist_potential_type,&
      15             :                                               get_potential
      16             :    USE input_section_types,             ONLY: section_vals_get,&
      17             :                                               section_vals_get_subs_vals,&
      18             :                                               section_vals_type,&
      19             :                                               section_vals_val_get
      20             :    USE kinds,                           ONLY: dp
      21             :    USE particle_types,                  ONLY: particle_type
      22             : #include "../base/base_uses.f90"
      23             : 
      24             :    IMPLICIT NONE
      25             : 
      26             :    PRIVATE
      27             :    PUBLIC :: multipole_type, &
      28             :              create_multipole_type, &
      29             :              release_multipole_type, &
      30             :              retain_multipole_type
      31             : 
      32             :    INTEGER, PARAMETER, PUBLIC               :: do_multipole_none = -1, &
      33             :                                                do_multipole_charge = 0, &
      34             :                                                do_multipole_dipole = 1, &
      35             :                                                do_multipole_quadrupole = 2
      36             : 
      37             : ! **************************************************************************************************
      38             : !> \brief Define multipole type
      39             : !> \param error variable to control error logging, stopping,...
      40             : !>        see module cp_error_handling
      41             : !> \par History
      42             : !>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
      43             : !> \author Teodoro Laino
      44             : ! **************************************************************************************************
      45             :    TYPE multipole_type
      46             :       INTEGER :: id_nr, ref_count
      47             :       LOGICAL, DIMENSION(3)                    :: task
      48             :       REAL(KIND=dp), DIMENSION(:), POINTER     :: charges
      49             :       REAL(KIND=dp), DIMENSION(:), POINTER     :: radii
      50             :       REAL(KIND=dp), DIMENSION(:, :), POINTER   :: dipoles
      51             :       REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: quadrupoles
      52             :    END TYPE multipole_type
      53             : 
      54             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'multipole_types'
      55             :    INTEGER, PRIVATE, SAVE :: last_multipole_id_nr = 0
      56             : 
      57             : CONTAINS
      58             : 
      59             : ! **************************************************************************************************
      60             : !> \brief Create a multipole type
      61             : !> \param multipoles ...
      62             : !> \param particle_set ...
      63             : !> \param subsys_section ...
      64             : !> \param max_multipole ...
      65             : !> \par History
      66             : !>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
      67             : !> \author Teodoro Laino
      68             : ! **************************************************************************************************
      69         134 :    SUBROUTINE create_multipole_type(multipoles, particle_set, subsys_section, max_multipole)
      70             :       TYPE(multipole_type), POINTER                      :: multipoles
      71             :       TYPE(particle_type), DIMENSION(:), POINTER         :: particle_set
      72             :       TYPE(section_vals_type), POINTER                   :: subsys_section
      73             :       INTEGER, INTENT(IN)                                :: max_multipole
      74             : 
      75             :       INTEGER                                            :: i, ind2, iparticle, j, n_rep, nparticles
      76             :       LOGICAL                                            :: explicit
      77         134 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: work
      78             :       TYPE(fist_potential_type), POINTER                 :: fist_potential
      79             :       TYPE(section_vals_type), POINTER                   :: work_section
      80             : 
      81           0 :       ALLOCATE (multipoles)
      82             : 
      83         134 :       last_multipole_id_nr = last_multipole_id_nr + 1
      84         134 :       multipoles%id_nr = last_multipole_id_nr
      85         134 :       multipoles%ref_count = 1
      86         536 :       multipoles%task = .FALSE.
      87         134 :       NULLIFY (multipoles%charges)
      88         134 :       NULLIFY (multipoles%radii)
      89         134 :       NULLIFY (multipoles%dipoles)
      90         134 :       NULLIFY (multipoles%quadrupoles)
      91         134 :       SELECT CASE (max_multipole)
      92             :       CASE (do_multipole_none)
      93             :          ! Do nothing..
      94             :       CASE (do_multipole_charge)
      95           0 :          multipoles%task(1:1) = .TRUE.
      96             :       CASE (do_multipole_dipole)
      97         180 :          multipoles%task(1:2) = .TRUE.
      98             :       CASE (do_multipole_quadrupole)
      99         296 :          multipoles%task(1:3) = .TRUE.
     100             :       CASE DEFAULT
     101         134 :          CPABORT("")
     102             :       END SELECT
     103         134 :       nparticles = SIZE(particle_set)
     104         134 :       IF (multipoles%task(1)) THEN
     105         402 :          ALLOCATE (multipoles%charges(nparticles))
     106         402 :          ALLOCATE (multipoles%radii(nparticles))
     107             :          ! Fill in charge array
     108        7584 :          DO iparticle = 1, nparticles
     109             :             !atomic_kind =>
     110             :             CALL get_atomic_kind(particle_set(iparticle)%atomic_kind, &
     111        7450 :                                  fist_potential=fist_potential)
     112             :             CALL get_potential(fist_potential, qeff=multipoles%charges(iparticle), &
     113        7584 :                                mm_radius=multipoles%radii(iparticle))
     114             :          END DO
     115             :       END IF
     116         134 :       IF (multipoles%task(2)) THEN
     117         402 :          ALLOCATE (multipoles%dipoles(3, nparticles))
     118             :          ! Fill in dipole array (if specified)
     119         134 :          work_section => section_vals_get_subs_vals(subsys_section, "MULTIPOLES%DIPOLES")
     120         134 :          CALL section_vals_get(work_section, explicit=explicit)
     121         134 :          IF (explicit) THEN
     122          66 :             CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", n_rep_val=n_rep)
     123          66 :             CPASSERT(n_rep == nparticles)
     124         224 :             DO iparticle = 1, n_rep
     125         158 :                CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", i_rep_val=iparticle, r_vals=work)
     126        1330 :                multipoles%dipoles(1:3, iparticle) = work
     127             :             END DO
     128             :          ELSE
     129       29236 :             multipoles%dipoles = 0.0_dp
     130             :          END IF
     131             :       END IF
     132         134 :       IF (multipoles%task(3)) THEN
     133         222 :          ALLOCATE (multipoles%quadrupoles(3, 3, nparticles))
     134             :          ! Fill in quadrupole array (if specified)
     135          74 :          work_section => section_vals_get_subs_vals(subsys_section, "MULTIPOLES%QUADRUPOLES")
     136          74 :          CALL section_vals_get(work_section, explicit=explicit)
     137          74 :          IF (explicit) THEN
     138          34 :             CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", n_rep_val=n_rep)
     139          34 :             CPASSERT(n_rep == nparticles)
     140         130 :             DO iparticle = 1, n_rep
     141          96 :                CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", i_rep_val=iparticle, r_vals=work)
     142         418 :                DO i = 1, 3
     143        1248 :                   DO j = 1, 3
     144         864 :                      ind2 = 3*(MIN(i, j) - 1) - (MIN(i, j)*(MIN(i, j) - 1))/2 + MAX(i, j)
     145        1152 :                      multipoles%quadrupoles(i, j, iparticle) = work(ind2)
     146             :                   END DO
     147             :                END DO
     148             :             END DO
     149             :          ELSE
     150        4616 :             multipoles%quadrupoles = 0.0_dp
     151             :          END IF
     152             :       END IF
     153         134 :    END SUBROUTINE create_multipole_type
     154             : 
     155             : ! **************************************************************************************************
     156             : !> \brief ...
     157             : !> \param multipoles ...
     158             : !> \par History
     159             : !>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
     160             : !> \author Teodoro Laino
     161             : ! **************************************************************************************************
     162       13741 :    SUBROUTINE release_multipole_type(multipoles)
     163             :       TYPE(multipole_type), POINTER                      :: multipoles
     164             : 
     165       13741 :       IF (ASSOCIATED(multipoles)) THEN
     166         268 :          CPASSERT(multipoles%ref_count > 0)
     167         268 :          multipoles%ref_count = multipoles%ref_count - 1
     168         268 :          IF (multipoles%ref_count == 0) THEN
     169         134 :             IF (ASSOCIATED(multipoles%charges)) THEN
     170         134 :                DEALLOCATE (multipoles%charges)
     171             :             END IF
     172         134 :             IF (ASSOCIATED(multipoles%radii)) THEN
     173         134 :                DEALLOCATE (multipoles%radii)
     174             :             END IF
     175         134 :             IF (ASSOCIATED(multipoles%dipoles)) THEN
     176         134 :                DEALLOCATE (multipoles%dipoles)
     177             :             END IF
     178         134 :             IF (ASSOCIATED(multipoles%quadrupoles)) THEN
     179          74 :                DEALLOCATE (multipoles%quadrupoles)
     180             :             END IF
     181         134 :             DEALLOCATE (multipoles)
     182             :          END IF
     183             :       END IF
     184       13741 :    END SUBROUTINE release_multipole_type
     185             : 
     186             : ! **************************************************************************************************
     187             : !> \brief ...
     188             : !> \param multipoles ...
     189             : !> \par History
     190             : !>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
     191             : !> \author Teodoro Laino
     192             : ! **************************************************************************************************
     193        2579 :    SUBROUTINE retain_multipole_type(multipoles)
     194             :       TYPE(multipole_type), POINTER                      :: multipoles
     195             : 
     196        2579 :       IF (ASSOCIATED(multipoles)) THEN
     197         134 :          CPASSERT(multipoles%ref_count > 0)
     198         134 :          multipoles%ref_count = multipoles%ref_count + 1
     199             :       END IF
     200        2579 :    END SUBROUTINE retain_multipole_type
     201             : 
     202           0 : END MODULE multipole_types