Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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
|
