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 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 : !> \brief Provides a vector of pointers of type atomic_kind_type
59 : ! **************************************************************************************************
60 : TYPE atomic_kind_p_type
61 : TYPE(atomic_kind_type), DIMENSION(:), &
62 : POINTER :: atomic_kind_set => NULL()
63 : END TYPE atomic_kind_p_type
64 :
65 : ! Public subroutines
66 :
67 : PUBLIC :: deallocate_atomic_kind_set, &
68 : get_atomic_kind, &
69 : get_atomic_kind_set, &
70 : set_atomic_kind, &
71 : is_hydrogen
72 :
73 : ! Public data types
74 : PUBLIC :: atomic_kind_type
75 :
76 : CONTAINS
77 :
78 : ! **************************************************************************************************
79 : !> \brief Destructor routine for a set of atomic kinds
80 : !> \param atomic_kind_set ...
81 : !> \date 02.01.2002
82 : !> \author Matthias Krack (MK)
83 : !> \version 2.0
84 : ! **************************************************************************************************
85 16720 : SUBROUTINE deallocate_atomic_kind_set(atomic_kind_set)
86 :
87 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
88 :
89 : INTEGER :: ikind, nkind
90 :
91 16720 : IF (.NOT. ASSOCIATED(atomic_kind_set)) THEN
92 : CALL cp_abort(__LOCATION__, &
93 : "The pointer atomic_kind_set is not associated and "// &
94 0 : "cannot be deallocated")
95 : END IF
96 :
97 16720 : nkind = SIZE(atomic_kind_set)
98 :
99 48411 : DO ikind = 1, nkind
100 31691 : IF (ASSOCIATED(atomic_kind_set(ikind)%fist_potential)) THEN
101 11270 : CALL deallocate_potential(atomic_kind_set(ikind)%fist_potential)
102 : END IF
103 31691 : IF (ASSOCIATED(atomic_kind_set(ikind)%atom_list)) THEN
104 31678 : DEALLOCATE (atomic_kind_set(ikind)%atom_list)
105 : END IF
106 31691 : IF (ASSOCIATED(atomic_kind_set(ikind)%shell)) DEALLOCATE (atomic_kind_set(ikind)%shell)
107 :
108 48411 : CALL damping_p_release(atomic_kind_set(ikind)%damping)
109 : END DO
110 16720 : DEALLOCATE (atomic_kind_set)
111 16720 : END SUBROUTINE deallocate_atomic_kind_set
112 :
113 : ! **************************************************************************************************
114 : !> \brief Get attributes of an atomic kind.
115 : !> \param atomic_kind ...
116 : !> \param fist_potential ...
117 : !> \param element_symbol ...
118 : !> \param name ...
119 : !> \param mass ...
120 : !> \param kind_number ...
121 : !> \param natom ...
122 : !> \param atom_list ...
123 : !> \param rcov ...
124 : !> \param rvdw ...
125 : !> \param z ...
126 : !> \param qeff ...
127 : !> \param apol ...
128 : !> \param cpol ...
129 : !> \param mm_radius ...
130 : !> \param shell ...
131 : !> \param shell_active ...
132 : !> \param damping ...
133 : ! **************************************************************************************************
134 144207815 : SUBROUTINE get_atomic_kind(atomic_kind, fist_potential, &
135 : element_symbol, name, mass, kind_number, natom, atom_list, &
136 : rcov, rvdw, z, qeff, apol, cpol, mm_radius, &
137 : shell, shell_active, damping)
138 :
139 : TYPE(atomic_kind_type), INTENT(IN) :: atomic_kind
140 : TYPE(fist_potential_type), OPTIONAL, POINTER :: fist_potential
141 : CHARACTER(LEN=2), INTENT(OUT), OPTIONAL :: element_symbol
142 : CHARACTER(LEN=default_string_length), &
143 : INTENT(OUT), OPTIONAL :: name
144 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: mass
145 : INTEGER, INTENT(OUT), OPTIONAL :: kind_number, natom
146 : INTEGER, DIMENSION(:), OPTIONAL, POINTER :: atom_list
147 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: rcov, rvdw
148 : INTEGER, INTENT(OUT), OPTIONAL :: z
149 : REAL(KIND=dp), INTENT(OUT), OPTIONAL :: qeff, apol, cpol, mm_radius
150 : TYPE(shell_kind_type), OPTIONAL, POINTER :: shell
151 : LOGICAL, INTENT(OUT), OPTIONAL :: shell_active
152 : TYPE(damping_p_type), OPTIONAL, POINTER :: damping
153 :
154 144207815 : IF (PRESENT(fist_potential)) fist_potential => atomic_kind%fist_potential
155 144207815 : IF (PRESENT(element_symbol)) element_symbol = atomic_kind%element_symbol
156 144207815 : IF (PRESENT(name)) name = atomic_kind%name
157 144207815 : IF (PRESENT(mass)) mass = atomic_kind%mass
158 144207815 : IF (PRESENT(kind_number)) kind_number = atomic_kind%kind_number
159 144207815 : IF (PRESENT(natom)) natom = atomic_kind%natom
160 144207815 : IF (PRESENT(atom_list)) atom_list => atomic_kind%atom_list
161 :
162 144207815 : IF (PRESENT(z)) THEN
163 145226 : CALL get_ptable_info(atomic_kind%element_symbol, number=z)
164 : END IF
165 144207815 : IF (PRESENT(rcov)) THEN
166 340 : CALL get_ptable_info(atomic_kind%element_symbol, covalent_radius=rcov)
167 : END IF
168 144207815 : IF (PRESENT(rvdw)) THEN
169 6474 : CALL get_ptable_info(atomic_kind%element_symbol, vdw_radius=rvdw)
170 : END IF
171 144207815 : IF (PRESENT(qeff)) THEN
172 36984263 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
173 36433821 : CALL get_potential(potential=atomic_kind%fist_potential, qeff=qeff)
174 : ELSE
175 550442 : qeff = -HUGE(0.0_dp)
176 : END IF
177 : END IF
178 144207815 : IF (PRESENT(apol)) THEN
179 4196 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
180 4196 : CALL get_potential(potential=atomic_kind%fist_potential, apol=apol)
181 : ELSE
182 0 : apol = -HUGE(0.0_dp)
183 : END IF
184 : END IF
185 144207815 : IF (PRESENT(cpol)) THEN
186 904 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
187 904 : CALL get_potential(potential=atomic_kind%fist_potential, cpol=cpol)
188 : ELSE
189 0 : cpol = -HUGE(0.0_dp)
190 : END IF
191 : END IF
192 144207815 : IF (PRESENT(mm_radius)) THEN
193 547823 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
194 547823 : CALL get_potential(potential=atomic_kind%fist_potential, mm_radius=mm_radius)
195 : ELSE
196 0 : mm_radius = -HUGE(0.0_dp)
197 : END IF
198 : END IF
199 144207815 : IF (PRESENT(shell)) shell => atomic_kind%shell
200 144207815 : IF (PRESENT(shell_active)) shell_active = atomic_kind%shell_active
201 144207815 : IF (PRESENT(damping)) damping => atomic_kind%damping
202 :
203 144207815 : END SUBROUTINE get_atomic_kind
204 :
205 : ! **************************************************************************************************
206 : !> \brief Get attributes of an atomic kind set.
207 : !> \param atomic_kind_set ...
208 : !> \param atom_of_kind ...
209 : !> \param kind_of ...
210 : !> \param natom_of_kind ...
211 : !> \param maxatom ...
212 : !> \param natom ...
213 : !> \param nshell ...
214 : !> \param fist_potential_present ...
215 : !> \param shell_present ...
216 : !> \param shell_adiabatic ...
217 : !> \param shell_check_distance ...
218 : !> \param damping_present ...
219 : ! **************************************************************************************************
220 1201415 : SUBROUTINE get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, &
221 : natom, nshell, fist_potential_present, shell_present, &
222 : shell_adiabatic, shell_check_distance, damping_present)
223 :
224 : TYPE(atomic_kind_type), DIMENSION(:), INTENT(IN) :: atomic_kind_set
225 : INTEGER, ALLOCATABLE, DIMENSION(:), OPTIONAL :: atom_of_kind, kind_of, natom_of_kind
226 : INTEGER, INTENT(OUT), OPTIONAL :: maxatom, natom, nshell
227 : LOGICAL, INTENT(OUT), OPTIONAL :: fist_potential_present, shell_present, &
228 : shell_adiabatic, shell_check_distance, &
229 : damping_present
230 :
231 : INTEGER :: atom_a, iatom, ikind, my_natom
232 :
233 : ! Compute number of atoms which is needed for possible allocations later.
234 1201415 : my_natom = 0
235 3982501 : DO ikind = 1, SIZE(atomic_kind_set)
236 3982501 : my_natom = my_natom + atomic_kind_set(ikind)%natom
237 : END DO
238 :
239 1201415 : IF (PRESENT(maxatom)) maxatom = 0
240 1201415 : IF (PRESENT(natom)) natom = my_natom
241 1201415 : IF (PRESENT(nshell)) nshell = 0
242 1201415 : IF (PRESENT(shell_present)) shell_present = .FALSE.
243 1201415 : IF (PRESENT(shell_adiabatic)) shell_adiabatic = .FALSE.
244 1201415 : IF (PRESENT(shell_check_distance)) shell_check_distance = .FALSE.
245 1201415 : IF (PRESENT(damping_present)) damping_present = .FALSE.
246 1201415 : IF (PRESENT(atom_of_kind)) THEN
247 527214 : ALLOCATE (atom_of_kind(my_natom))
248 1263033 : atom_of_kind(:) = 0
249 : END IF
250 1201415 : IF (PRESENT(kind_of)) THEN
251 1665024 : ALLOCATE (kind_of(my_natom))
252 2550202 : kind_of(:) = 0
253 : END IF
254 1201415 : IF (PRESENT(natom_of_kind)) THEN
255 13917 : ALLOCATE (natom_of_kind(SIZE(atomic_kind_set)))
256 13495 : natom_of_kind(:) = 0
257 : END IF
258 :
259 3982501 : DO ikind = 1, SIZE(atomic_kind_set)
260 1201415 : ASSOCIATE (atomic_kind => atomic_kind_set(ikind))
261 2781086 : IF (PRESENT(maxatom)) THEN
262 104756 : maxatom = MAX(maxatom, atomic_kind%natom)
263 : END IF
264 2781086 : IF (PRESENT(fist_potential_present)) THEN
265 0 : IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
266 0 : fist_potential_present = .TRUE.
267 : END IF
268 : END IF
269 2781086 : IF (PRESENT(shell_present)) THEN
270 846755 : IF (ASSOCIATED(atomic_kind%shell)) THEN
271 50794 : shell_present = .TRUE.
272 : END IF
273 : END IF
274 2781086 : IF (PRESENT(shell_adiabatic) .AND. ASSOCIATED(atomic_kind%shell)) THEN
275 55842 : IF (.NOT. shell_adiabatic) THEN
276 31670 : shell_adiabatic = (atomic_kind%shell%massfrac /= 0.0_dp)
277 : END IF
278 : END IF
279 2781086 : IF (PRESENT(shell_check_distance) .AND. ASSOCIATED(atomic_kind%shell)) THEN
280 6360 : IF (.NOT. shell_check_distance) THEN
281 5450 : shell_check_distance = (atomic_kind%shell%max_dist > 0.0_dp)
282 : END IF
283 : END IF
284 2781086 : IF (PRESENT(damping_present)) THEN
285 0 : IF (ASSOCIATED(atomic_kind%damping)) THEN
286 0 : damping_present = .TRUE.
287 : END IF
288 : END IF
289 2781086 : IF (PRESENT(atom_of_kind)) THEN
290 1454073 : DO iatom = 1, atomic_kind%natom
291 1087295 : atom_a = atomic_kind%atom_list(iatom)
292 1454073 : atom_of_kind(atom_a) = iatom
293 : END DO
294 : END IF
295 2781086 : IF (PRESENT(kind_of)) THEN
296 3113672 : DO iatom = 1, atomic_kind%natom
297 1995194 : atom_a = atomic_kind%atom_list(iatom)
298 3113672 : kind_of(atom_a) = ikind
299 : END DO
300 : END IF
301 5562172 : IF (PRESENT(natom_of_kind)) THEN
302 8856 : natom_of_kind(ikind) = atomic_kind%natom
303 : END IF
304 : END ASSOCIATE
305 : END DO
306 :
307 1201415 : END SUBROUTINE get_atomic_kind_set
308 :
309 : ! **************************************************************************************************
310 : !> \brief Set the components of an atomic kind data set.
311 : !> \param atomic_kind ...
312 : !> \param element_symbol ...
313 : !> \param name ...
314 : !> \param mass ...
315 : !> \param kind_number ...
316 : !> \param natom ...
317 : !> \param atom_list ...
318 : !> \param fist_potential ...
319 : !> \param shell ...
320 : !> \param shell_active ...
321 : !> \param damping ...
322 : ! **************************************************************************************************
323 91181 : SUBROUTINE set_atomic_kind(atomic_kind, element_symbol, name, mass, kind_number, &
324 31678 : natom, atom_list, &
325 : fist_potential, shell, &
326 : shell_active, damping)
327 :
328 : TYPE(atomic_kind_type), INTENT(INOUT) :: atomic_kind
329 : CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: element_symbol, name
330 : REAL(KIND=dp), INTENT(IN), OPTIONAL :: mass
331 : INTEGER, INTENT(IN), OPTIONAL :: kind_number, natom
332 : INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: atom_list
333 : TYPE(fist_potential_type), OPTIONAL, POINTER :: fist_potential
334 : TYPE(shell_kind_type), OPTIONAL, POINTER :: shell
335 : LOGICAL, INTENT(IN), OPTIONAL :: shell_active
336 : TYPE(damping_p_type), OPTIONAL, POINTER :: damping
337 :
338 : INTEGER :: n
339 :
340 91181 : IF (PRESENT(element_symbol)) atomic_kind%element_symbol = element_symbol
341 91181 : IF (PRESENT(name)) atomic_kind%name = name
342 91181 : IF (PRESENT(mass)) atomic_kind%mass = mass
343 91181 : IF (PRESENT(kind_number)) atomic_kind%kind_number = kind_number
344 91181 : IF (PRESENT(natom)) atomic_kind%natom = natom
345 91181 : IF (PRESENT(atom_list)) THEN
346 31678 : n = SIZE(atom_list)
347 31678 : IF (n > 0) THEN
348 31678 : IF (ASSOCIATED(atomic_kind%atom_list)) THEN
349 0 : DEALLOCATE (atomic_kind%atom_list)
350 : END IF
351 95034 : ALLOCATE (atomic_kind%atom_list(n))
352 993789 : atomic_kind%atom_list(:) = atom_list(:)
353 31678 : atomic_kind%natom = n
354 : ELSE
355 0 : CPABORT("An invalid atom_list was supplied")
356 : END IF
357 : END IF
358 91181 : IF (PRESENT(fist_potential)) atomic_kind%fist_potential => fist_potential
359 91181 : IF (PRESENT(shell)) THEN
360 450 : IF (ASSOCIATED(atomic_kind%shell)) THEN
361 0 : IF (.NOT. ASSOCIATED(atomic_kind%shell, shell)) THEN
362 0 : DEALLOCATE (atomic_kind%shell)
363 : END IF
364 : END IF
365 450 : atomic_kind%shell => shell
366 : END IF
367 91181 : IF (PRESENT(shell_active)) atomic_kind%shell_active = shell_active
368 :
369 91181 : IF (PRESENT(damping)) atomic_kind%damping => damping
370 :
371 91181 : END SUBROUTINE set_atomic_kind
372 :
373 : ! **************************************************************************************************
374 : !> \brief Determines if the atomic_kind is HYDROGEN
375 : !> \param atomic_kind ...
376 : !> \return ...
377 : !> \author Teodoro Laino [tlaino] - University of Zurich 10.2008
378 : ! **************************************************************************************************
379 1900392 : ELEMENTAL FUNCTION is_hydrogen(atomic_kind) RESULT(res)
380 : TYPE(atomic_kind_type), INTENT(IN) :: atomic_kind
381 : LOGICAL :: res
382 :
383 1900392 : res = TRIM(atomic_kind%element_symbol) == "H"
384 1900392 : END FUNCTION is_hydrogen
385 :
386 0 : END MODULE atomic_kind_types
|