(git:374b731)
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-2024 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 TYPE rho_atom_p_type
44 TYPE(rho_atom_type), POINTER :: rho_atom => null()
45 END TYPE rho_atom_p_type
46
47 PUBLIC :: deallocate_rho_atom_set, get_rho_atom, rho_atom_coeff, rho_atom_type, &
48 zero_rho_atom_integrals
49
50CONTAINS
51
52! **************************************************************************************************
53!> \brief ...
54!> \param rho_atom_set ...
55! **************************************************************************************************
56 SUBROUTINE deallocate_rho_atom_set(rho_atom_set)
57
58 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
59
60 INTEGER :: i, iat, j, n, natom
61
62 IF (ASSOCIATED(rho_atom_set)) THEN
63
64 natom = SIZE(rho_atom_set)
65
66 DO iat = 1, natom
67 IF (ASSOCIATED(rho_atom_set(iat)%cpc_h)) THEN
68 IF (ASSOCIATED(rho_atom_set(iat)%cpc_h(1)%r_coef)) THEN
69 n = SIZE(rho_atom_set(iat)%cpc_h, 1)
70 DO i = 1, n
71 DEALLOCATE (rho_atom_set(iat)%cpc_h(i)%r_coef)
72 DEALLOCATE (rho_atom_set(iat)%cpc_s(i)%r_coef)
73 END DO
74 END IF
75 DEALLOCATE (rho_atom_set(iat)%cpc_h)
76 DEALLOCATE (rho_atom_set(iat)%cpc_s)
77 END IF
78 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
79 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
80 n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
81 DO i = 1, n
82 DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef)
83 DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s(i)%r_coef)
84 END DO
85 END IF
86 DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h)
87 DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s)
88 END IF
89 IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h)) THEN
90 IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h(1)%r_coef)) THEN
91 n = SIZE(rho_atom_set(iat)%int_scr_h, 1)
92 DO i = 1, n
93 DEALLOCATE (rho_atom_set(iat)%int_scr_h(i)%r_coef)
94 DEALLOCATE (rho_atom_set(iat)%int_scr_s(i)%r_coef)
95 END DO
96 END IF
97 DEALLOCATE (rho_atom_set(iat)%int_scr_h)
98 DEALLOCATE (rho_atom_set(iat)%int_scr_s)
99 END IF
100
101 IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h)) THEN
102 IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h(1)%r_coef)) THEN
103 n = SIZE(rho_atom_set(iat)%drho_rad_h, 1)
104 DO i = 1, n
105 DEALLOCATE (rho_atom_set(iat)%drho_rad_h(i)%r_coef)
106 DEALLOCATE (rho_atom_set(iat)%drho_rad_s(i)%r_coef)
107 DO j = 1, 3
108 DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d(j, i)%r_coef)
109 DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d(j, i)%r_coef)
110 END DO
111 END DO
112 END IF
113 DEALLOCATE (rho_atom_set(iat)%drho_rad_h)
114 DEALLOCATE (rho_atom_set(iat)%drho_rad_s)
115 DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d)
116 DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d)
117 END IF
118
119 IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h)) THEN
120 IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h(1)%r_coef)) THEN
121 n = SIZE(rho_atom_set(iat)%rho_rad_h)
122 DO i = 1, n
123 DEALLOCATE (rho_atom_set(iat)%rho_rad_h(i)%r_coef)
124 END DO
125 END IF
126 DEALLOCATE (rho_atom_set(iat)%rho_rad_h)
127 END IF
128
129 IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s)) THEN
130 IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s(1)%r_coef)) THEN
131 n = SIZE(rho_atom_set(iat)%rho_rad_s)
132 DO i = 1, n
133 DEALLOCATE (rho_atom_set(iat)%rho_rad_s(i)%r_coef)
134 END DO
135 END IF
136 DEALLOCATE (rho_atom_set(iat)%rho_rad_s)
137 END IF
138
139 IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h)) THEN
140 IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h(1)%r_coef)) THEN
141 n = SIZE(rho_atom_set(iat)%vrho_rad_h)
142 DO i = 1, n
143 DEALLOCATE (rho_atom_set(iat)%vrho_rad_h(i)%r_coef)
144 END DO
145 END IF
146 DEALLOCATE (rho_atom_set(iat)%vrho_rad_h)
147 END IF
148
149 IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s)) THEN
150 IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s(1)%r_coef)) THEN
151 n = SIZE(rho_atom_set(iat)%vrho_rad_s)
152 DO i = 1, n
153 DEALLOCATE (rho_atom_set(iat)%vrho_rad_s(i)%r_coef)
154 END DO
155 END IF
156 DEALLOCATE (rho_atom_set(iat)%vrho_rad_s)
157 END IF
158
159 END DO
160
161 DEALLOCATE (rho_atom_set)
162
163 ELSE
164
165 CALL cp_abort(__location__, &
166 "The pointer rho_atom_set is not associated and "// &
167 "cannot be deallocated")
168
169 END IF
170
171 END SUBROUTINE deallocate_rho_atom_set
172
173! **************************************************************************************************
174!> \brief ...
175!> \param rho_atom ...
176!> \param cpc_h ...
177!> \param cpc_s ...
178!> \param rho_rad_h ...
179!> \param rho_rad_s ...
180!> \param drho_rad_h ...
181!> \param drho_rad_s ...
182!> \param vrho_rad_h ...
183!> \param vrho_rad_s ...
184!> \param rho_rad_h_d ...
185!> \param rho_rad_s_d ...
186!> \param ga_Vlocal_gb_h ...
187!> \param ga_Vlocal_gb_s ...
188!> \param int_scr_h ...
189!> \param int_scr_s ...
190! **************************************************************************************************
191 SUBROUTINE get_rho_atom(rho_atom, cpc_h, cpc_s, rho_rad_h, rho_rad_s, &
192 drho_rad_h, drho_rad_s, vrho_rad_h, vrho_rad_s, &
193 rho_rad_h_d, rho_rad_s_d, ga_Vlocal_gb_h, ga_Vlocal_gb_s, &
194 int_scr_h, int_scr_s)
195
196 TYPE(rho_atom_type), INTENT(IN), POINTER :: rho_atom
197 TYPE(rho_atom_coeff), DIMENSION(:), OPTIONAL, &
198 POINTER :: cpc_h, cpc_s, rho_rad_h, rho_rad_s, &
199 drho_rad_h, drho_rad_s, vrho_rad_h, &
200 vrho_rad_s
201 TYPE(rho_atom_coeff), DIMENSION(:, :), OPTIONAL, &
202 POINTER :: rho_rad_h_d, rho_rad_s_d
203 TYPE(rho_atom_coeff), DIMENSION(:), OPTIONAL, &
204 POINTER :: ga_vlocal_gb_h, ga_vlocal_gb_s, &
205 int_scr_h, int_scr_s
206
207 IF (ASSOCIATED(rho_atom)) THEN
208 IF (PRESENT(cpc_h)) cpc_h => rho_atom%cpc_h
209 IF (PRESENT(cpc_s)) cpc_s => rho_atom%cpc_s
210 IF (PRESENT(rho_rad_h)) rho_rad_h => rho_atom%rho_rad_h
211 IF (PRESENT(rho_rad_s)) rho_rad_s => rho_atom%rho_rad_s
212 IF (PRESENT(drho_rad_h)) drho_rad_h => rho_atom%drho_rad_h
213 IF (PRESENT(drho_rad_s)) drho_rad_s => rho_atom%drho_rad_s
214 IF (PRESENT(rho_rad_h_d)) rho_rad_h_d => rho_atom%rho_rad_h_d
215 IF (PRESENT(rho_rad_s_d)) rho_rad_s_d => rho_atom%rho_rad_s_d
216 IF (PRESENT(vrho_rad_h)) vrho_rad_h => rho_atom%vrho_rad_h
217 IF (PRESENT(vrho_rad_s)) vrho_rad_s => rho_atom%vrho_rad_s
218 IF (PRESENT(ga_vlocal_gb_h)) ga_vlocal_gb_h => rho_atom%ga_Vlocal_gb_h
219 IF (PRESENT(ga_vlocal_gb_s)) ga_vlocal_gb_s => rho_atom%ga_Vlocal_gb_s
220 IF (PRESENT(int_scr_h)) int_scr_h => rho_atom%int_scr_h
221 IF (PRESENT(int_scr_s)) int_scr_s => rho_atom%int_scr_s
222 ELSE
223 cpabort("The pointer rho_atom is not associated")
224 END IF
225
226 END SUBROUTINE get_rho_atom
227
228! **************************************************************************************************
229!> \brief ...
230!> \param rho_atom_set ...
231! **************************************************************************************************
232 SUBROUTINE zero_rho_atom_integrals(rho_atom_set)
233 TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
234
235 INTEGER :: i, iat, n, natom
236
237 IF (ASSOCIATED(rho_atom_set)) THEN
238 natom = SIZE(rho_atom_set)
239 DO iat = 1, natom
240 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
241 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
242 n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
243 DO i = 1, n
244 rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef = 0.0_dp
245 END DO
246 END IF
247 END IF
248 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s)) THEN
249 IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s(1)%r_coef)) THEN
250 n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_s, 1)
251 DO i = 1, n
252 rho_atom_set(iat)%ga_Vlocal_gb_s(i)%r_coef = 0.0_dp
253 END DO
254 END IF
255 END IF
256 END DO
257 END IF
258 END SUBROUTINE zero_rho_atom_integrals
259
260END 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:195
qs_rho_atom_types::deallocate_rho_atom_set
subroutine, public deallocate_rho_atom_set(rho_atom_set)
...
Definition qs_rho_atom_types.F:57
qs_rho_atom_types::zero_rho_atom_integrals
subroutine, public zero_rho_atom_integrals(rho_atom_set)
...
Definition qs_rho_atom_types.F:233
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