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 Define the atomic kind types and their sub types
10 : !> \author Matthias Krack (MK)
11 : !> \date 02.01.2002
12 : !> \version 1.0
13 : !>
14 : !> <b>Modification history:</b>
15 : !> - 01.2002 creation [MK]
16 : !> - 04.2002 added pao [fawzi]
17 : !> - 09.2002 adapted for POL/KG use [GT]
18 : !> - 02.2004 flexible normalization of basis sets [jgh]
19 : !> - 03.2004 attach/detach routines [jgh]
20 : !> - 10.2004 removed pao [fawzi]
21 : !> - 08.2014 moevd qs-related stuff into new qs_kind_types.F [Ole Schuett]
22 : ! **************************************************************************************************
23 : MODULE atomic_kind_types
24 : USE damping_dipole_types, ONLY: damping_p_release,&
25 : damping_p_type
26 : USE external_potential_types, ONLY: deallocate_potential,&
27 : fist_potential_type,&
28 : get_potential
29 : USE kinds, ONLY: default_string_length,&
30 : dp
31 : USE periodic_table, ONLY: get_ptable_info
32 : USE shell_potential_types, ONLY: shell_kind_type
33 : #include "../base/base_uses.f90"
34 :
35 : IMPLICIT NONE
36 :
37 : PRIVATE
38 :
39 : ! Global parameters (only in this module)
40 :
41 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'atomic_kind_types'
42 :
43 : !> \brief Provides all information about an atomic kind
44 : ! **************************************************************************************************
45 : TYPE atomic_kind_type
46 : TYPE(fist_potential_type), POINTER :: fist_potential => Null()
47 : CHARACTER(LEN=default_string_length) :: name = ""
48 : CHARACTER(LEN=2) :: element_symbol = ""
49 : REAL(KIND=dp) :: mass = 0.0_dp
50 : INTEGER :: kind_number = -1
51 : INTEGER :: natom = -1
52 : INTEGER, DIMENSION(:), POINTER :: atom_list => Null()
53 : LOGICAL :: shell_active = .FALSE.
54 : TYPE(shell_kind_type), POINTER :: shell => Null()
55 : TYPE(damping_p_type), POINTER :: damping => Null()
56 : END TYPE atomic_kind_type
57 :
58 : ! Public subroutines
59 :
60 : PUBLIC :: deallocate_atomic_kind_set, &
61 : get_atomic_kind, &
62 : get_atomic_kind_set, &
63 : set_atomic_kind, &
64 : is_hydrogen
65 :
66 : ! Public data types
67 : PUBLIC :: atomic_kind_type
68 :
69 : CONTAINS
70 :
71 : ! **************************************************************************************************
72 : !> \brief Destructor routine for a set of atomic kinds
73 : !> \param atomic_kind_set ...
74 : !> \date 02.01.2002
75 : !> \author Matthias Krack (MK)
76 : !> \version 2.0
77 : ! **************************************************************************************************
78 22194 : SUBROUTINE deallocate_atomic_kind_set(atomic_kind_set)
79 :
80 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
81 :
82 : INTEGER :: ikind, nkind
83 :
84 22194 : IF (.NOT. ASSOCIATED(atomic_kind_set)) THEN
85 : CALL cp_abort(__LOCATION__, &
86 : "The pointer atomic_kind_set is not associated and "// &
87 0 : "cannot be deallocated")
88 : END IF
89 :
90 22194 : nkind = SIZE(atomic_kind_set)
91 :
92 61485 : DO ikind = 1, nkind
93 39291 : IF (ASSOCIATED(atomic_kind_set(ikind)%fist_potential)) THEN
94 11504 : CALL deallocate_potential(atomic_kind_set(ikind)%fist_potential)
95 : END IF
96 39291 : IF (ASSOCIATED(atomic_kind_set(ikind)%atom_list)) THEN
97 39272 : DEALLOCATE (atomic_kind_set(ikind)%atom_list)
98 : END IF
99 39291 : IF (ASSOCIATED(atomic_kind_set(ikind)%shell)) DEALLOCATE (atomic_kind_set(ikind)%shell)
100 :
101 61485 : CALL damping_p_release(atomic_kind_set(ikind)%damping)
102 : END DO
103 22194 : DEALLOCATE (atomic_kind_set)
104 22194 : END SUBROUTINE deallocate_atomic_kind_set
105 :
106 : ! **************************************************************************************************
107 : !> \brief Get attributes of an atomic kind.
108 : !> \param atomic_kind ...
109 : !> \param fist_potential ...
110 : !> \param element_symbol ...
111 : !> \param name ...
112 : !> \param mass ...
113 : !> \param kind_number ...
114 : !> \param natom ...
115 : !> \param atom_list ...
116 : !> \param rcov ...
117 : !> \param rvdw ...
118 : !> \param z ...
119 : !> \param qeff ...
120 : !> \param apol ...
121 : !> \param cpol ...
122 : !> \param mm_radius ...
123 : !> \param shell ...
124 : !> \param shell_active ...
125 : !> \param damping ...
126 : ! **************************************************************************************************
127 148270904 : SUBROUTINE get_atomic_kind(atomic_kind, fist_potential, &
128 : element_symbol, name, mass, kind_number, natom, atom_list, &
129 : rcov, rvdw, z, qeff, apol, cpol, mm_radius, &
130 : shell, shell_active, damping)
131 :
132 : TYPE(atomic_kind_type), INTENT(IN) :: atomic_kind
133 : TYPE(fist_potential_type), OPTIONAL, POINTER :: fist_potential
134 : CHARACTER(LEN=2), INTENT(OUT), OPTIONAL :: element_symbol
135 : CHARACTER(LEN=default_string_length), &
136 : INTENT(OUT), OPTIONAL :: name
137 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: mass
138 : INTEGER, INTENT(OUT), OPTIONAL :: kind_number, natom
139 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: atom_list
140 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: rcov, rvdw
141 : INTEGER, INTENT(OUT), OPTIONAL :: z
142 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: qeff, apol, cpol, mm_radius
143 : TYPE(shell_kind_type), OPTIONAL, POINTER :: shell
144 : LOGICAL, INTENT(OUT), OPTIONAL :: shell_active
145 : TYPE(damping_p_type), OPTIONAL, POINTER :: damping
146 :
147 148270904 : IF (PRESENT(fist_potential)) fist_potential => atomic_kind%fist_potential
148 148270904 : IF (PRESENT(element_symbol)) element_symbol = atomic_kind%element_symbol
149 148270904 : IF (PRESENT(name)) name = atomic_kind%name
150 148270904 : IF (PRESENT(mass)) mass = atomic_kind%mass
151 148270904 : IF (PRESENT(kind_number)) kind_number = atomic_kind%kind_number
152 148270904 : IF (PRESENT(natom)) natom = atomic_kind%natom
153 148270904 : IF (PRESENT(atom_list)) atom_list => atomic_kind%atom_list
154 :
155 148270904 : IF (PRESENT(z)) THEN
156 174545 : CALL get_ptable_info(atomic_kind%element_symbol, number=z)
157 : END IF
158 148270904 : IF (PRESENT(rcov)) THEN
159 352 : CALL get_ptable_info(atomic_kind%element_symbol, covalent_radius=rcov)
160 : END IF
161 148270904 : IF (PRESENT(rvdw)) THEN
162 6534 : CALL get_ptable_info(atomic_kind%element_symbol, vdw_radius=rvdw)
163 : END IF
164 148270904 : IF (PRESENT(qeff)) THEN
165 37915119 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
166 37053806 : CALL get_potential(potential=atomic_kind%fist_potential, qeff=qeff)
167 : ELSE
168 861313 : qeff = -HUGE(0.0_dp)
169 : END IF
170 : END IF
171 148270904 : IF (PRESENT(apol)) THEN
172 4196 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
173 4196 : CALL get_potential(potential=atomic_kind%fist_potential, apol=apol)
174 : ELSE
175 0 : apol = -HUGE(0.0_dp)
176 : END IF
177 : END IF
178 148270904 : IF (PRESENT(cpol)) THEN
179 904 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
180 904 : CALL get_potential(potential=atomic_kind%fist_potential, cpol=cpol)
181 : ELSE
182 0 : cpol = -HUGE(0.0_dp)
183 : END IF
184 : END IF
185 148270904 : IF (PRESENT(mm_radius)) THEN
186 561306 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
187 561306 : CALL get_potential(potential=atomic_kind%fist_potential, mm_radius=mm_radius)
188 : ELSE
189 0 : mm_radius = -HUGE(0.0_dp)
190 : END IF
191 : END IF
192 148270904 : IF (PRESENT(shell)) shell => atomic_kind%shell
193 148270904 : IF (PRESENT(shell_active)) shell_active = atomic_kind%shell_active
194 148270904 : IF (PRESENT(damping)) damping => atomic_kind%damping
195 :
196 148270904 : END SUBROUTINE get_atomic_kind
197 :
198 : ! **************************************************************************************************
199 : !> \brief Get attributes of an atomic kind set.
200 : !> \param atomic_kind_set ...
201 : !> \param atom_of_kind ...
202 : !> \param kind_of ...
203 : !> \param natom_of_kind ...
204 : !> \param maxatom ...
205 : !> \param natom ...
206 : !> \param nshell ...
207 : !> \param fist_potential_present ...
208 : !> \param shell_present ...
209 : !> \param shell_adiabatic ...
210 : !> \param shell_check_distance ...
211 : !> \param damping_present ...
212 : ! **************************************************************************************************
213 2074710 : SUBROUTINE get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, &
214 : natom, nshell, fist_potential_present, shell_present, &
215 : shell_adiabatic, shell_check_distance, damping_present)
216 :
217 : TYPE(atomic_kind_type), DIMENSION(:), INTENT(IN) :: atomic_kind_set
218 : INTEGER, ALLOCATABLE, DIMENSION(:), OPTIONAL :: atom_of_kind, kind_of, natom_of_kind
219 : INTEGER, INTENT(OUT), OPTIONAL :: maxatom, natom, nshell
220 : LOGICAL, INTENT(OUT), OPTIONAL :: fist_potential_present, shell_present, &
221 : shell_adiabatic, shell_check_distance, &
222 : damping_present
223 :
224 : INTEGER :: atom_a, iatom, ikind, my_natom
225 :
226 : ! Compute number of atoms which is needed for possible allocations later.
227 2074710 : my_natom = 0
228 6650482 : DO ikind = 1, SIZE(atomic_kind_set)
229 6650482 : my_natom = my_natom + atomic_kind_set(ikind)%natom
230 : END DO
231 :
232 2074710 : IF (PRESENT(maxatom)) maxatom = 0
233 2074710 : IF (PRESENT(natom)) natom = my_natom
234 2074710 : IF (PRESENT(nshell)) nshell = 0
235 2074710 : IF (PRESENT(shell_present)) shell_present = .FALSE.
236 2074710 : IF (PRESENT(shell_adiabatic)) shell_adiabatic = .FALSE.
237 2074710 : IF (PRESENT(shell_check_distance)) shell_check_distance = .FALSE.
238 2074710 : IF (PRESENT(damping_present)) damping_present = .FALSE.
239 2074710 : IF (PRESENT(atom_of_kind)) THEN
240 787353 : ALLOCATE (atom_of_kind(my_natom))
241 262451 : atom_of_kind(:) = 0
242 : END IF
243 2074710 : IF (PRESENT(kind_of)) THEN
244 4044315 : ALLOCATE (kind_of(my_natom))
245 1348105 : kind_of(:) = 0
246 : END IF
247 2074710 : IF (PRESENT(natom_of_kind)) THEN
248 17565 : ALLOCATE (natom_of_kind(SIZE(atomic_kind_set)))
249 5855 : natom_of_kind(:) = 0
250 : END IF
251 :
252 6650482 : DO ikind = 1, SIZE(atomic_kind_set)
253 2074710 : ASSOCIATE (atomic_kind => atomic_kind_set(ikind))
254 4575772 : IF (PRESENT(maxatom)) THEN
255 127309 : maxatom = MAX(maxatom, atomic_kind%natom)
256 : END IF
257 4575772 : IF (PRESENT(fist_potential_present)) THEN
258 0 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
259 0 : fist_potential_present = .TRUE.
260 : END IF
261 : END IF
262 4575772 : IF (PRESENT(shell_present)) THEN
263 870147 : IF (ASSOCIATED(atomic_kind%shell)) THEN
264 56774 : shell_present = .TRUE.
265 : END IF
266 : END IF
267 4575772 : IF (PRESENT(shell_adiabatic) .AND. ASSOCIATED(atomic_kind%shell)) THEN
268 61854 : IF (.NOT. shell_adiabatic) THEN
269 32874 : shell_adiabatic = (atomic_kind%shell%massfrac /= 0.0_dp)
270 : END IF
271 : END IF
272 4575772 : IF (PRESENT(shell_check_distance) .AND. ASSOCIATED(atomic_kind%shell)) THEN
273 6360 : IF (.NOT. shell_check_distance) THEN
274 5450 : shell_check_distance = (atomic_kind%shell%max_dist > 0.0_dp)
275 : END IF
276 : END IF
277 4575772 : IF (PRESENT(damping_present)) THEN
278 0 : IF (ASSOCIATED(atomic_kind%damping)) THEN
279 0 : damping_present = .TRUE.
280 : END IF
281 : END IF
282 4575772 : IF (PRESENT(atom_of_kind)) THEN
283 2083515 : DO iatom = 1, atomic_kind%natom
284 1528287 : atom_a = atomic_kind%atom_list(iatom)
285 2083515 : atom_of_kind(atom_a) = iatom
286 : END DO
287 : END IF
288 4575772 : IF (PRESENT(kind_of)) THEN
289 7296624 : DO iatom = 1, atomic_kind%natom
290 4581326 : atom_a = atomic_kind%atom_list(iatom)
291 7296624 : kind_of(atom_a) = ikind
292 : END DO
293 : END IF
294 9151544 : IF (PRESENT(natom_of_kind)) THEN
295 11118 : natom_of_kind(ikind) = atomic_kind%natom
296 : END IF
297 : END ASSOCIATE
298 : END DO
299 :
300 2074710 : END SUBROUTINE get_atomic_kind_set
301 :
302 : ! **************************************************************************************************
303 : !> \brief Set the components of an atomic kind data set.
304 : !> \param atomic_kind ...
305 : !> \param element_symbol ...
306 : !> \param name ...
307 : !> \param mass ...
308 : !> \param kind_number ...
309 : !> \param natom ...
310 : !> \param atom_list ...
311 : !> \param fist_potential ...
312 : !> \param shell ...
313 : !> \param shell_active ...
314 : !> \param damping ...
315 : ! **************************************************************************************************
316 104217 : SUBROUTINE set_atomic_kind(atomic_kind, element_symbol, name, mass, kind_number, &
317 39272 : natom, atom_list, &
318 : fist_potential, shell, &
319 : shell_active, damping)
320 :
321 : TYPE(atomic_kind_type), INTENT(INOUT) :: atomic_kind
322 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: element_symbol, name
323 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: mass
324 : INTEGER, INTENT(IN), OPTIONAL :: kind_number, natom
325 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: atom_list
326 : TYPE(fist_potential_type), OPTIONAL, POINTER :: fist_potential
327 : TYPE(shell_kind_type), OPTIONAL, POINTER :: shell
328 : LOGICAL, INTENT(IN), OPTIONAL :: shell_active
329 : TYPE(damping_p_type), OPTIONAL, POINTER :: damping
330 :
331 : INTEGER :: n
332 :
333 104217 : IF (PRESENT(element_symbol)) atomic_kind%element_symbol = element_symbol
334 104217 : IF (PRESENT(name)) atomic_kind%name = name
335 104217 : IF (PRESENT(mass)) atomic_kind%mass = mass
336 104217 : IF (PRESENT(kind_number)) atomic_kind%kind_number = kind_number
337 104217 : IF (PRESENT(natom)) atomic_kind%natom = natom
338 104217 : IF (PRESENT(atom_list)) THEN
339 39272 : n = SIZE(atom_list)
340 39272 : IF (n > 0) THEN
341 39272 : IF (ASSOCIATED(atomic_kind%atom_list)) THEN
342 0 : DEALLOCATE (atomic_kind%atom_list)
343 : END IF
344 117816 : ALLOCATE (atomic_kind%atom_list(n))
345 1047983 : atomic_kind%atom_list(:) = atom_list(:)
346 39272 : atomic_kind%natom = n
347 : ELSE
348 0 : CPABORT("An invalid atom_list was supplied")
349 : END IF
350 : END IF
351 104217 : IF (PRESENT(fist_potential)) atomic_kind%fist_potential => fist_potential
352 104217 : IF (PRESENT(shell)) THEN
353 450 : IF (ASSOCIATED(atomic_kind%shell)) THEN
354 0 : IF (.NOT. ASSOCIATED(atomic_kind%shell, shell)) THEN
355 0 : DEALLOCATE (atomic_kind%shell)
356 : END IF
357 : END IF
358 450 : atomic_kind%shell => shell
359 : END IF
360 104217 : IF (PRESENT(shell_active)) atomic_kind%shell_active = shell_active
361 :
362 104217 : IF (PRESENT(damping)) atomic_kind%damping => damping
363 :
364 104217 : END SUBROUTINE set_atomic_kind
365 :
366 : ! **************************************************************************************************
367 : !> \brief Determines if the atomic_kind is HYDROGEN
368 : !> \param atomic_kind ...
369 : !> \return ...
370 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
371 : ! **************************************************************************************************
372 2445894 : ELEMENTAL FUNCTION is_hydrogen(atomic_kind) RESULT(res)
373 : TYPE(atomic_kind_type), INTENT(IN) :: atomic_kind
374 : LOGICAL :: res
375 :
376 2445894 : res = TRIM(atomic_kind%element_symbol) == "H"
377 2445894 : END FUNCTION is_hydrogen
378 :
379 0 : END MODULE atomic_kind_types
|
