(git:d077e66)
Loading...
Searching...
No Matches
qs_rho_atom_types.F
Go to the documentation of this file.
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! **************************************************************************************************
8MODULE qs_rho_atom_types
9
10 USE kinds, ONLY: dp
11#include "./base/base_uses.f90"
12
13 IMPLICIT NONE
14
15 PRIVATE
16
17 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_rho_atom_types'
18
19 TYPE rho_atom_coeff
20 REAL(dp), DIMENSION(:, :), POINTER :: r_coef => null()
21 END TYPE rho_atom_coeff
22
23 TYPE rho_atom_type
24 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cpc_h => null()
25 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: cpc_s => null()
26 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: rho_rad_h => null()
27 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: rho_rad_s => null()
28 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: vrho_rad_h => null()
29 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: vrho_rad_s => null()
30 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: drho_rad_h => null()
31 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: drho_rad_s => null()
32 TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER :: rho_rad_h_d => null()
33 TYPE(rho_atom_coeff), DIMENSION(:, :), POINTER :: rho_rad_s_d => null()
34 INTEGER :: rhoa_of_atom = -1
35 REAL(dp) :: exc_h = 0.0_dp
36 REAL(dp) :: exc_s = 0.0_dp
37 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: ga_vlocal_gb_h => null()
38 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: ga_vlocal_gb_s => null()
39 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: int_scr_h => null()
40 TYPE(rho_atom_coeff), DIMENSION(:), POINTER :: int_scr_s => null()
41 END TYPE rho_atom_type
42
43 PUBLIC :: deallocate_rho_atom_set, get_rho_atom, rho_atom_coeff, rho_atom_type, &
44 zero_rho_atom_integrals
45
46CONTAINS
47
48! **************************************************************************************************
49!> \brief ...
50!> \param rho_atom_set ...
51! **************************************************************************************************
52 SUBROUTINE deallocate_rho_atom_set(rho_atom_set)
53
54 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
55
56 INTEGER :: i, iat, j, n, natom
57
58 IF (ASSOCIATED(rho_atom_set)) THEN
59
60 natom = SIZE(rho_atom_set)
61
62 DO iat = 1, natom
63 IF (ASSOCIATED(rho_atom_set(iat)%cpc_h)) THEN
64 IF (ASSOCIATED(rho_atom_set(iat)%cpc_h(1)%r_coef)) THEN
65 n = SIZE(rho_atom_set(iat)%cpc_h, 1)
66 DO i = 1, n
67 DEALLOCATE (rho_atom_set(iat)%cpc_h(i)%r_coef)
68 DEALLOCATE (rho_atom_set(iat)%cpc_s(i)%r_coef)
69 END DO
70 END IF
71 DEALLOCATE (rho_atom_set(iat)%cpc_h)
72 DEALLOCATE (rho_atom_set(iat)%cpc_s)
73 END IF
74 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
75 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
76 n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
77 DO i = 1, n
78 DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef)
79 DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s(i)%r_coef)
80 END DO
81 END IF
82 DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h)
83 DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s)
84 END IF
85 IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h)) THEN
86 IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h(1)%r_coef)) THEN
87 n = SIZE(rho_atom_set(iat)%int_scr_h, 1)
88 DO i = 1, n
89 DEALLOCATE (rho_atom_set(iat)%int_scr_h(i)%r_coef)
90 DEALLOCATE (rho_atom_set(iat)%int_scr_s(i)%r_coef)
91 END DO
92 END IF
93 DEALLOCATE (rho_atom_set(iat)%int_scr_h)
94 DEALLOCATE (rho_atom_set(iat)%int_scr_s)
95 END IF
96
97 IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h)) THEN
98 IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h(1)%r_coef)) THEN
99 n = SIZE(rho_atom_set(iat)%drho_rad_h, 1)
100 DO i = 1, n
101 DEALLOCATE (rho_atom_set(iat)%drho_rad_h(i)%r_coef)
102 DEALLOCATE (rho_atom_set(iat)%drho_rad_s(i)%r_coef)
103 DO j = 1, 3
104 DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d(j, i)%r_coef)
105 DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d(j, i)%r_coef)
106 END DO
107 END DO
108 END IF
109 DEALLOCATE (rho_atom_set(iat)%drho_rad_h)
110 DEALLOCATE (rho_atom_set(iat)%drho_rad_s)
111 DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d)
112 DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d)
113 END IF
114
115 IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h)) THEN
116 IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h(1)%r_coef)) THEN
117 n = SIZE(rho_atom_set(iat)%rho_rad_h)
118 DO i = 1, n
119 DEALLOCATE (rho_atom_set(iat)%rho_rad_h(i)%r_coef)
120 END DO
121 END IF
122 DEALLOCATE (rho_atom_set(iat)%rho_rad_h)
123 END IF
124
125 IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s)) THEN
126 IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s(1)%r_coef)) THEN
127 n = SIZE(rho_atom_set(iat)%rho_rad_s)
128 DO i = 1, n
129 DEALLOCATE (rho_atom_set(iat)%rho_rad_s(i)%r_coef)
130 END DO
131 END IF
132 DEALLOCATE (rho_atom_set(iat)%rho_rad_s)
133 END IF
134
135 IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h)) THEN
136 IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h(1)%r_coef)) THEN
137 n = SIZE(rho_atom_set(iat)%vrho_rad_h)
138 DO i = 1, n
139 DEALLOCATE (rho_atom_set(iat)%vrho_rad_h(i)%r_coef)
140 END DO
141 END IF
142 DEALLOCATE (rho_atom_set(iat)%vrho_rad_h)
143 END IF
144
145 IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s)) THEN
146 IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s(1)%r_coef)) THEN
147 n = SIZE(rho_atom_set(iat)%vrho_rad_s)
148 DO i = 1, n
149 DEALLOCATE (rho_atom_set(iat)%vrho_rad_s(i)%r_coef)
150 END DO
151 END IF
152 DEALLOCATE (rho_atom_set(iat)%vrho_rad_s)
153 END IF
154
155 END DO
156
157 DEALLOCATE (rho_atom_set)
158
159 ELSE
160
161 CALL cp_abort(__location__, &
162 "The pointer rho_atom_set is not associated and "// &
163 "cannot be deallocated")
164
165 END IF
166
167 END SUBROUTINE deallocate_rho_atom_set
168
169! **************************************************************************************************
170!> \brief ...
171!> \param rho_atom ...
172!> \param cpc_h ...
173!> \param cpc_s ...
174!> \param rho_rad_h ...
175!> \param rho_rad_s ...
176!> \param drho_rad_h ...
177!> \param drho_rad_s ...
178!> \param vrho_rad_h ...
179!> \param vrho_rad_s ...
180!> \param rho_rad_h_d ...
181!> \param rho_rad_s_d ...
182!> \param ga_Vlocal_gb_h ...
183!> \param ga_Vlocal_gb_s ...
184!> \param int_scr_h ...
185!> \param int_scr_s ...
186! **************************************************************************************************
187 SUBROUTINE get_rho_atom(rho_atom, cpc_h, cpc_s, rho_rad_h, rho_rad_s, &
188 drho_rad_h, drho_rad_s, vrho_rad_h, vrho_rad_s, &
189 rho_rad_h_d, rho_rad_s_d, ga_Vlocal_gb_h, ga_Vlocal_gb_s, &
190 int_scr_h, int_scr_s)
191
192 TYPE(rho_atom_type), INTENT(IN), POINTER :: rho_atom
193 TYPE(rho_atom_coeff), DIMENSION(:), OPTIONAL, &
194 POINTER :: cpc_h, cpc_s, rho_rad_h, rho_rad_s, &
195 drho_rad_h, drho_rad_s, vrho_rad_h, &
196 vrho_rad_s
197 TYPE(rho_atom_coeff), DIMENSION(:, :), OPTIONAL, &
198 POINTER :: rho_rad_h_d, rho_rad_s_d
199 TYPE(rho_atom_coeff), DIMENSION(:), OPTIONAL, &
200 POINTER :: ga_vlocal_gb_h, ga_vlocal_gb_s, &
201 int_scr_h, int_scr_s
202
203 IF (ASSOCIATED(rho_atom)) THEN
204 IF (PRESENT(cpc_h)) cpc_h => rho_atom%cpc_h
205 IF (PRESENT(cpc_s)) cpc_s => rho_atom%cpc_s
206 IF (PRESENT(rho_rad_h)) rho_rad_h => rho_atom%rho_rad_h
207 IF (PRESENT(rho_rad_s)) rho_rad_s => rho_atom%rho_rad_s
208 IF (PRESENT(drho_rad_h)) drho_rad_h => rho_atom%drho_rad_h
209 IF (PRESENT(drho_rad_s)) drho_rad_s => rho_atom%drho_rad_s
210 IF (PRESENT(rho_rad_h_d)) rho_rad_h_d => rho_atom%rho_rad_h_d
211 IF (PRESENT(rho_rad_s_d)) rho_rad_s_d => rho_atom%rho_rad_s_d
212 IF (PRESENT(vrho_rad_h)) vrho_rad_h => rho_atom%vrho_rad_h
213 IF (PRESENT(vrho_rad_s)) vrho_rad_s => rho_atom%vrho_rad_s
214 IF (PRESENT(ga_vlocal_gb_h)) ga_vlocal_gb_h => rho_atom%ga_Vlocal_gb_h
215 IF (PRESENT(ga_vlocal_gb_s)) ga_vlocal_gb_s => rho_atom%ga_Vlocal_gb_s
216 IF (PRESENT(int_scr_h)) int_scr_h => rho_atom%int_scr_h
217 IF (PRESENT(int_scr_s)) int_scr_s => rho_atom%int_scr_s
218 ELSE
219 cpabort("The pointer rho_atom is not associated")
220 END IF
221
222 END SUBROUTINE get_rho_atom
223
224! **************************************************************************************************
225!> \brief ...
226!> \param rho_atom_set ...
227! **************************************************************************************************
228 SUBROUTINE zero_rho_atom_integrals(rho_atom_set)
229 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
230
231 INTEGER :: i, iat, n, natom
232
233 IF (ASSOCIATED(rho_atom_set)) THEN
234 natom = SIZE(rho_atom_set)
235 DO iat = 1, natom
236 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
237 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
238 n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
239 DO i = 1, n
240 rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef = 0.0_dp
241 END DO
242 END IF
243 END IF
244 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s)) THEN
245 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s(1)%r_coef)) THEN
246 n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_s, 1)
247 DO i = 1, n
248 rho_atom_set(iat)%ga_Vlocal_gb_s(i)%r_coef = 0.0_dp
249 END DO
250 END IF
251 END IF
252 END DO
253 END IF
254 END SUBROUTINE zero_rho_atom_integrals
255
256END MODULE qs_rho_atom_types
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
qs_rho_atom_types
Definition qs_rho_atom_types.F:8
qs_rho_atom_types::get_rho_atom
subroutine, public get_rho_atom(rho_atom, cpc_h, cpc_s, rho_rad_h, rho_rad_s, drho_rad_h, drho_rad_s, vrho_rad_h, vrho_rad_s, rho_rad_h_d, rho_rad_s_d, ga_vlocal_gb_h, ga_vlocal_gb_s, int_scr_h, int_scr_s)
...
Definition qs_rho_atom_types.F:191
qs_rho_atom_types::deallocate_rho_atom_set
subroutine, public deallocate_rho_atom_set(rho_atom_set)
...
Definition qs_rho_atom_types.F:53
qs_rho_atom_types::zero_rho_atom_integrals
subroutine, public zero_rho_atom_integrals(rho_atom_set)
...
Definition qs_rho_atom_types.F:229
qs_rho_atom_types::rho_atom_coeff
Definition qs_rho_atom_types.F:19
qs_rho_atom_types::rho_atom_type
Definition qs_rho_atom_types.F:23