(git:1f285aa)
atomic_kind_types.F
Go to the documentation of this file.
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 ! **************************************************************************************************
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
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, &
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  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  IF (.NOT. ASSOCIATED(atomic_kind_set)) THEN
92  CALL cp_abort(__location__, &
93  "The pointer atomic_kind_set is not associated and "// &
94  "cannot be deallocated")
95  END IF
96 
97  nkind = SIZE(atomic_kind_set)
98 
99  DO ikind = 1, nkind
100  IF (ASSOCIATED(atomic_kind_set(ikind)%fist_potential)) THEN
101  CALL deallocate_potential(atomic_kind_set(ikind)%fist_potential)
102  END IF
103  IF (ASSOCIATED(atomic_kind_set(ikind)%atom_list)) THEN
104  DEALLOCATE (atomic_kind_set(ikind)%atom_list)
105  END IF
106  IF (ASSOCIATED(atomic_kind_set(ikind)%shell)) DEALLOCATE (atomic_kind_set(ikind)%shell)
107 
108  CALL damping_p_release(atomic_kind_set(ikind)%damping)
109  END DO
110  DEALLOCATE (atomic_kind_set)
111  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  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  IF (PRESENT(fist_potential)) fist_potential => atomic_kind%fist_potential
155  IF (PRESENT(element_symbol)) element_symbol = atomic_kind%element_symbol
156  IF (PRESENT(name)) name = atomic_kind%name
157  IF (PRESENT(mass)) mass = atomic_kind%mass
158  IF (PRESENT(kind_number)) kind_number = atomic_kind%kind_number
159  IF (PRESENT(natom)) natom = atomic_kind%natom
160  IF (PRESENT(atom_list)) atom_list => atomic_kind%atom_list
161 
162  IF (PRESENT(z)) THEN
163  CALL get_ptable_info(atomic_kind%element_symbol, number=z)
164  END IF
165  IF (PRESENT(rcov)) THEN
166  CALL get_ptable_info(atomic_kind%element_symbol, covalent_radius=rcov)
167  END IF
168  IF (PRESENT(rvdw)) THEN
169  CALL get_ptable_info(atomic_kind%element_symbol, vdw_radius=rvdw)
170  END IF
171  IF (PRESENT(qeff)) THEN
172  IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
173  CALL get_potential(potential=atomic_kind%fist_potential, qeff=qeff)
174  ELSE
175  qeff = -huge(0.0_dp)
176  END IF
177  END IF
178  IF (PRESENT(apol)) THEN
179  IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
180  CALL get_potential(potential=atomic_kind%fist_potential, apol=apol)
181  ELSE
182  apol = -huge(0.0_dp)
183  END IF
184  END IF
185  IF (PRESENT(cpol)) THEN
186  IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
187  CALL get_potential(potential=atomic_kind%fist_potential, cpol=cpol)
188  ELSE
189  cpol = -huge(0.0_dp)
190  END IF
191  END IF
192  IF (PRESENT(mm_radius)) THEN
193  IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
194  CALL get_potential(potential=atomic_kind%fist_potential, mm_radius=mm_radius)
195  ELSE
196  mm_radius = -huge(0.0_dp)
197  END IF
198  END IF
199  IF (PRESENT(shell)) shell => atomic_kind%shell
200  IF (PRESENT(shell_active)) shell_active = atomic_kind%shell_active
201  IF (PRESENT(damping)) damping => atomic_kind%damping
202 
203  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  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  my_natom = 0
235  DO ikind = 1, SIZE(atomic_kind_set)
236  my_natom = my_natom + atomic_kind_set(ikind)%natom
237  END DO
238 
239  IF (PRESENT(maxatom)) maxatom = 0
240  IF (PRESENT(natom)) natom = my_natom
241  IF (PRESENT(nshell)) nshell = 0
242  IF (PRESENT(shell_present)) shell_present = .false.
243  IF (PRESENT(shell_adiabatic)) shell_adiabatic = .false.
244  IF (PRESENT(shell_check_distance)) shell_check_distance = .false.
245  IF (PRESENT(damping_present)) damping_present = .false.
246  IF (PRESENT(atom_of_kind)) THEN
247  ALLOCATE (atom_of_kind(my_natom))
248  atom_of_kind(:) = 0
249  END IF
250  IF (PRESENT(kind_of)) THEN
251  ALLOCATE (kind_of(my_natom))
252  kind_of(:) = 0
253  END IF
254  IF (PRESENT(natom_of_kind)) THEN
255  ALLOCATE (natom_of_kind(SIZE(atomic_kind_set)))
256  natom_of_kind(:) = 0
257  END IF
258 
259  DO ikind = 1, SIZE(atomic_kind_set)
260  associate(atomic_kind => atomic_kind_set(ikind))
261  IF (PRESENT(maxatom)) THEN
262  maxatom = max(maxatom, atomic_kind%natom)
263  END IF
264  IF (PRESENT(fist_potential_present)) THEN
265  IF (ASSOCIATED(atomic_kind%fist_potential)) THEN
266  fist_potential_present = .true.
267  END IF
268  END IF
269  IF (PRESENT(shell_present)) THEN
270  IF (ASSOCIATED(atomic_kind%shell)) THEN
271  shell_present = .true.
272  END IF
273  END IF
274  IF (PRESENT(shell_adiabatic) .AND. ASSOCIATED(atomic_kind%shell)) THEN
275  IF (.NOT. shell_adiabatic) THEN
276  shell_adiabatic = (atomic_kind%shell%massfrac /= 0.0_dp)
277  END IF
278  END IF
279  IF (PRESENT(shell_check_distance) .AND. ASSOCIATED(atomic_kind%shell)) THEN
280  IF (.NOT. shell_check_distance) THEN
281  shell_check_distance = (atomic_kind%shell%max_dist > 0.0_dp)
282  END IF
283  END IF
284  IF (PRESENT(damping_present)) THEN
285  IF (ASSOCIATED(atomic_kind%damping)) THEN
286  damping_present = .true.
287  END IF
288  END IF
289  IF (PRESENT(atom_of_kind)) THEN
290  DO iatom = 1, atomic_kind%natom
291  atom_a = atomic_kind%atom_list(iatom)
292  atom_of_kind(atom_a) = iatom
293  END DO
294  END IF
295  IF (PRESENT(kind_of)) THEN
296  DO iatom = 1, atomic_kind%natom
297  atom_a = atomic_kind%atom_list(iatom)
298  kind_of(atom_a) = ikind
299  END DO
300  END IF
301  IF (PRESENT(natom_of_kind)) THEN
302  natom_of_kind(ikind) = atomic_kind%natom
303  END IF
304  END associate
305  END DO
306 
307  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  SUBROUTINE set_atomic_kind(atomic_kind, element_symbol, name, mass, kind_number, &
324  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  IF (PRESENT(element_symbol)) atomic_kind%element_symbol = element_symbol
341  IF (PRESENT(name)) atomic_kind%name = name
342  IF (PRESENT(mass)) atomic_kind%mass = mass
343  IF (PRESENT(kind_number)) atomic_kind%kind_number = kind_number
344  IF (PRESENT(natom)) atomic_kind%natom = natom
345  IF (PRESENT(atom_list)) THEN
346  n = SIZE(atom_list)
347  IF (n > 0) THEN
348  IF (ASSOCIATED(atomic_kind%atom_list)) THEN
349  DEALLOCATE (atomic_kind%atom_list)
350  END IF
351  ALLOCATE (atomic_kind%atom_list(n))
352  atomic_kind%atom_list(:) = atom_list(:)
353  atomic_kind%natom = n
354  ELSE
355  cpabort("An invalid atom_list was supplied")
356  END IF
357  END IF
358  IF (PRESENT(fist_potential)) atomic_kind%fist_potential => fist_potential
359  IF (PRESENT(shell)) THEN
360  IF (ASSOCIATED(atomic_kind%shell)) THEN
361  IF (.NOT. ASSOCIATED(atomic_kind%shell, shell)) THEN
362  DEALLOCATE (atomic_kind%shell)
363  END IF
364  END IF
365  atomic_kind%shell => shell
366  END IF
367  IF (PRESENT(shell_active)) atomic_kind%shell_active = shell_active
368 
369  IF (PRESENT(damping)) atomic_kind%damping => damping
370 
371  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  ELEMENTAL FUNCTION is_hydrogen(atomic_kind) RESULT(res)
380  TYPE(atomic_kind_type), INTENT(IN) :: atomic_kind
381  LOGICAL :: res
382 
383  res = trim(atomic_kind%element_symbol) == "H"
384  END FUNCTION is_hydrogen
385 
386 END MODULE atomic_kind_types
Define the atomic kind types and their sub types.
subroutine, public get_atomic_kind_set(atomic_kind_set, atom_of_kind, kind_of, natom_of_kind, maxatom, natom, nshell, fist_potential_present, shell_present, shell_adiabatic, shell_check_distance, damping_present)
Get attributes of an atomic kind set.
subroutine, public set_atomic_kind(atomic_kind, element_symbol, name, mass, kind_number, natom, atom_list, fist_potential, shell, shell_active, damping)
Set the components of an atomic kind data set.
subroutine, public get_atomic_kind(atomic_kind, fist_potential, element_symbol, name, mass, kind_number, natom, atom_list, rcov, rvdw, z, qeff, apol, cpol, mm_radius, shell, shell_active, damping)
Get attributes of an atomic kind.
subroutine, public deallocate_atomic_kind_set(atomic_kind_set)
Destructor routine for a set of atomic kinds.
elemental logical function, public is_hydrogen(atomic_kind)
Determines if the atomic_kind is HYDROGEN.
subroutine, public damping_p_release(damping)
Release Data-structure that contains damping information.
Definition of the atomic potential types.
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
integer, parameter, public default_string_length
Definition: kinds.F:57
Periodic Table related data definitions.
subroutine, public get_ptable_info(symbol, number, amass, ielement, covalent_radius, metallic_radius, vdw_radius, found)
Pass information about the kind given the element symbol.