LCOV - code coverage report
Current view: top level - src/subsys - multipole_types.F (source / functions) Hit Total Coverage
Test: CP2K Regtests (git:e7e05ae) Lines: 49 51 96.1 %
Date: 2024-04-18 06:59:28 Functions: 2 3 66.7 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------------------------!
       2             : !   CP2K: A general program to perform molecular dynamics simulations                              !
       3             : !   Copyright 2000-2024 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             : 
      31             :    INTEGER, PARAMETER, PUBLIC               :: do_multipole_none = -1, &
      32             :                                                do_multipole_charge = 0, &
      33             :                                                do_multipole_dipole = 1, &
      34             :                                                do_multipole_quadrupole = 2
      35             : 
      36             : ! **************************************************************************************************
      37             : !> \brief Define multipole type
      38             : !> \param error variable to control error logging, stopping,...
      39             : !>        see module cp_error_handling
      40             : !> \par History
      41             : !>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
      42             : !> \author Teodoro Laino
      43             : ! **************************************************************************************************
      44             :    TYPE multipole_type
      45             :       LOGICAL, DIMENSION(3)                    :: task = .FALSE.
      46             :       REAL(KIND=dp), DIMENSION(:), POINTER     :: charges => NULL()
      47             :       REAL(KIND=dp), DIMENSION(:), POINTER     :: radii => NULL()
      48             :       REAL(KIND=dp), DIMENSION(:, :), POINTER   :: dipoles => NULL()
      49             :       REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: quadrupoles => NULL()
      50             :    END TYPE multipole_type
      51             : 
      52             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'multipole_types'
      53             : 
      54             : CONTAINS
      55             : 
      56             : ! **************************************************************************************************
      57             : !> \brief Create a multipole type
      58             : !> \param multipoles ...
      59             : !> \param particle_set ...
      60             : !> \param subsys_section ...
      61             : !> \param max_multipole ...
      62             : !> \par History
      63             : !>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
      64             : !> \author Teodoro Laino
      65             : ! **************************************************************************************************
      66         690 :    SUBROUTINE create_multipole_type(multipoles, particle_set, subsys_section, max_multipole)
      67             :       TYPE(multipole_type), INTENT(OUT)                  :: multipoles
      68             :       TYPE(particle_type), DIMENSION(:), INTENT(IN)      :: particle_set
      69             :       TYPE(section_vals_type), POINTER                   :: subsys_section
      70             :       INTEGER, INTENT(IN)                                :: max_multipole
      71             : 
      72             :       INTEGER                                            :: i, ind2, iparticle, j, n_rep, nparticles
      73             :       LOGICAL                                            :: explicit
      74         138 :       REAL(KIND=dp), DIMENSION(:), POINTER               :: work
      75             :       TYPE(fist_potential_type), POINTER                 :: fist_potential
      76             :       TYPE(section_vals_type), POINTER                   :: work_section
      77             : 
      78         138 :       SELECT CASE (max_multipole)
      79             :       CASE (do_multipole_none)
      80             :          ! Do nothing..
      81             :       CASE (do_multipole_charge)
      82           0 :          multipoles%task(1:1) = .TRUE.
      83             :       CASE (do_multipole_dipole)
      84         192 :          multipoles%task(1:2) = .TRUE.
      85             :       CASE (do_multipole_quadrupole)
      86         296 :          multipoles%task(1:3) = .TRUE.
      87             :       CASE DEFAULT
      88         138 :          CPABORT("")
      89             :       END SELECT
      90         138 :       nparticles = SIZE(particle_set)
      91         138 :       IF (multipoles%task(1)) THEN
      92         414 :          ALLOCATE (multipoles%charges(nparticles))
      93         414 :          ALLOCATE (multipoles%radii(nparticles))
      94             :          ! Fill in charge array
      95        7620 :          DO iparticle = 1, nparticles
      96             :             !atomic_kind =>
      97             :             CALL get_atomic_kind(particle_set(iparticle)%atomic_kind, &
      98        7482 :                                  fist_potential=fist_potential)
      99             :             CALL get_potential(fist_potential, qeff=multipoles%charges(iparticle), &
     100        7620 :                                mm_radius=multipoles%radii(iparticle))
     101             :          END DO
     102             :       END IF
     103         138 :       IF (multipoles%task(2)) THEN
     104         414 :          ALLOCATE (multipoles%dipoles(3, nparticles))
     105             :          ! Fill in dipole array (if specified)
     106         138 :          work_section => section_vals_get_subs_vals(subsys_section, "MULTIPOLES%DIPOLES")
     107         138 :          CALL section_vals_get(work_section, explicit=explicit)
     108         138 :          IF (explicit) THEN
     109          66 :             CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", n_rep_val=n_rep)
     110          66 :             CPASSERT(n_rep == nparticles)
     111         224 :             DO iparticle = 1, n_rep
     112         158 :                CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", i_rep_val=iparticle, r_vals=work)
     113         698 :                multipoles%dipoles(1:3, iparticle) = work
     114             :             END DO
     115             :          ELSE
     116       29368 :             multipoles%dipoles = 0.0_dp
     117             :          END IF
     118             :       END IF
     119         138 :       IF (multipoles%task(3)) THEN
     120         222 :          ALLOCATE (multipoles%quadrupoles(3, 3, nparticles))
     121             :          ! Fill in quadrupole array (if specified)
     122          74 :          work_section => section_vals_get_subs_vals(subsys_section, "MULTIPOLES%QUADRUPOLES")
     123          74 :          CALL section_vals_get(work_section, explicit=explicit)
     124          74 :          IF (explicit) THEN
     125          34 :             CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", n_rep_val=n_rep)
     126          34 :             CPASSERT(n_rep == nparticles)
     127         130 :             DO iparticle = 1, n_rep
     128          96 :                CALL section_vals_val_get(work_section, "_DEFAULT_KEYWORD_", i_rep_val=iparticle, r_vals=work)
     129         418 :                DO i = 1, 3
     130        1248 :                   DO j = 1, 3
     131         864 :                      ind2 = 3*(MIN(i, j) - 1) - (MIN(i, j)*(MIN(i, j) - 1))/2 + MAX(i, j)
     132        1152 :                      multipoles%quadrupoles(i, j, iparticle) = work(ind2)
     133             :                   END DO
     134             :                END DO
     135             :             END DO
     136             :          ELSE
     137        4616 :             multipoles%quadrupoles = 0.0_dp
     138             :          END IF
     139             :       END IF
     140         138 :    END SUBROUTINE create_multipole_type
     141             : 
     142             : ! **************************************************************************************************
     143             : !> \brief ...
     144             : !> \param multipoles ...
     145             : !> \par History
     146             : !>      12.2007 created [tlaino] - Teodoro Laino - University of Zurich
     147             : !> \author Teodoro Laino
     148             : ! **************************************************************************************************
     149         138 :    SUBROUTINE release_multipole_type(multipoles)
     150             :       TYPE(multipole_type), INTENT(INOUT)                :: multipoles
     151             : 
     152         138 :       IF (ASSOCIATED(multipoles%charges)) THEN
     153         138 :          DEALLOCATE (multipoles%charges)
     154             :       END IF
     155         138 :       IF (ASSOCIATED(multipoles%radii)) THEN
     156         138 :          DEALLOCATE (multipoles%radii)
     157             :       END IF
     158         138 :       IF (ASSOCIATED(multipoles%dipoles)) THEN
     159         138 :          DEALLOCATE (multipoles%dipoles)
     160             :       END IF
     161         138 :       IF (ASSOCIATED(multipoles%quadrupoles)) THEN
     162          74 :          DEALLOCATE (multipoles%quadrupoles)
     163             :       END IF
     164             : 
     165         138 :    END SUBROUTINE release_multipole_type
     166             : 
     167           0 : END MODULE multipole_types

Generated by: LCOV version 1.15