Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 : ! **************************************************************************************************
8 : MODULE 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 :
50 : CONTAINS
51 :
52 : ! **************************************************************************************************
53 : !> \brief ...
54 : !> \param rho_atom_set ...
55 : ! **************************************************************************************************
56 2712 : 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 2712 : IF (ASSOCIATED(rho_atom_set)) THEN
63 :
64 2712 : natom = SIZE(rho_atom_set)
65 :
66 11708 : DO iat = 1, natom
67 8996 : IF (ASSOCIATED(rho_atom_set(iat)%cpc_h)) THEN
68 8996 : IF (ASSOCIATED(rho_atom_set(iat)%cpc_h(1)%r_coef)) THEN
69 7730 : n = SIZE(rho_atom_set(iat)%cpc_h, 1)
70 16552 : DO i = 1, n
71 8822 : DEALLOCATE (rho_atom_set(iat)%cpc_h(i)%r_coef)
72 16552 : DEALLOCATE (rho_atom_set(iat)%cpc_s(i)%r_coef)
73 : END DO
74 : END IF
75 8996 : DEALLOCATE (rho_atom_set(iat)%cpc_h)
76 8996 : DEALLOCATE (rho_atom_set(iat)%cpc_s)
77 : END IF
78 8996 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
79 4498 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
80 3865 : n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
81 8276 : DO i = 1, n
82 4411 : DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef)
83 8276 : DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s(i)%r_coef)
84 : END DO
85 : END IF
86 4498 : DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h)
87 4498 : DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s)
88 : END IF
89 8996 : IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h)) THEN
90 8996 : IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h(1)%r_coef)) THEN
91 7730 : n = SIZE(rho_atom_set(iat)%int_scr_h, 1)
92 16552 : DO i = 1, n
93 8822 : DEALLOCATE (rho_atom_set(iat)%int_scr_h(i)%r_coef)
94 16552 : DEALLOCATE (rho_atom_set(iat)%int_scr_s(i)%r_coef)
95 : END DO
96 : END IF
97 8996 : DEALLOCATE (rho_atom_set(iat)%int_scr_h)
98 8996 : DEALLOCATE (rho_atom_set(iat)%int_scr_s)
99 : END IF
100 :
101 8996 : IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h)) THEN
102 8996 : IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h(1)%r_coef)) THEN
103 3731 : n = SIZE(rho_atom_set(iat)%drho_rad_h, 1)
104 7953 : DO i = 1, n
105 4222 : DEALLOCATE (rho_atom_set(iat)%drho_rad_h(i)%r_coef)
106 4222 : DEALLOCATE (rho_atom_set(iat)%drho_rad_s(i)%r_coef)
107 20619 : DO j = 1, 3
108 12666 : DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d(j, i)%r_coef)
109 16888 : DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d(j, i)%r_coef)
110 : END DO
111 : END DO
112 : END IF
113 8996 : DEALLOCATE (rho_atom_set(iat)%drho_rad_h)
114 8996 : DEALLOCATE (rho_atom_set(iat)%drho_rad_s)
115 8996 : DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d)
116 8996 : DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d)
117 : END IF
118 :
119 8996 : IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h)) THEN
120 8996 : IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h(1)%r_coef)) THEN
121 3731 : n = SIZE(rho_atom_set(iat)%rho_rad_h)
122 7953 : DO i = 1, n
123 7953 : DEALLOCATE (rho_atom_set(iat)%rho_rad_h(i)%r_coef)
124 : END DO
125 : END IF
126 8996 : DEALLOCATE (rho_atom_set(iat)%rho_rad_h)
127 : END IF
128 :
129 8996 : IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s)) THEN
130 8996 : IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s(1)%r_coef)) THEN
131 3731 : n = SIZE(rho_atom_set(iat)%rho_rad_s)
132 7953 : DO i = 1, n
133 7953 : DEALLOCATE (rho_atom_set(iat)%rho_rad_s(i)%r_coef)
134 : END DO
135 : END IF
136 8996 : DEALLOCATE (rho_atom_set(iat)%rho_rad_s)
137 : END IF
138 :
139 8996 : IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h)) THEN
140 8996 : IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h(1)%r_coef)) THEN
141 3731 : n = SIZE(rho_atom_set(iat)%vrho_rad_h)
142 7953 : DO i = 1, n
143 7953 : DEALLOCATE (rho_atom_set(iat)%vrho_rad_h(i)%r_coef)
144 : END DO
145 : END IF
146 8996 : DEALLOCATE (rho_atom_set(iat)%vrho_rad_h)
147 : END IF
148 :
149 11708 : IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s)) THEN
150 8996 : IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s(1)%r_coef)) THEN
151 3731 : n = SIZE(rho_atom_set(iat)%vrho_rad_s)
152 7953 : DO i = 1, n
153 7953 : DEALLOCATE (rho_atom_set(iat)%vrho_rad_s(i)%r_coef)
154 : END DO
155 : END IF
156 8996 : DEALLOCATE (rho_atom_set(iat)%vrho_rad_s)
157 : END IF
158 :
159 : END DO
160 :
161 2712 : DEALLOCATE (rho_atom_set)
162 :
163 : ELSE
164 :
165 : CALL cp_abort(__LOCATION__, &
166 : "The pointer rho_atom_set is not associated and "// &
167 0 : "cannot be deallocated")
168 :
169 : END IF
170 :
171 2712 : 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 4989418 : 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 4989418 : IF (ASSOCIATED(rho_atom)) THEN
208 4989418 : IF (PRESENT(cpc_h)) cpc_h => rho_atom%cpc_h
209 4989418 : IF (PRESENT(cpc_s)) cpc_s => rho_atom%cpc_s
210 4989418 : IF (PRESENT(rho_rad_h)) rho_rad_h => rho_atom%rho_rad_h
211 4989418 : IF (PRESENT(rho_rad_s)) rho_rad_s => rho_atom%rho_rad_s
212 4989418 : IF (PRESENT(drho_rad_h)) drho_rad_h => rho_atom%drho_rad_h
213 4989418 : IF (PRESENT(drho_rad_s)) drho_rad_s => rho_atom%drho_rad_s
214 4989418 : IF (PRESENT(rho_rad_h_d)) rho_rad_h_d => rho_atom%rho_rad_h_d
215 4989418 : IF (PRESENT(rho_rad_s_d)) rho_rad_s_d => rho_atom%rho_rad_s_d
216 4989418 : IF (PRESENT(vrho_rad_h)) vrho_rad_h => rho_atom%vrho_rad_h
217 4989418 : IF (PRESENT(vrho_rad_s)) vrho_rad_s => rho_atom%vrho_rad_s
218 4989418 : IF (PRESENT(ga_Vlocal_gb_h)) ga_Vlocal_gb_h => rho_atom%ga_Vlocal_gb_h
219 4989418 : IF (PRESENT(ga_Vlocal_gb_s)) ga_Vlocal_gb_s => rho_atom%ga_Vlocal_gb_s
220 4989418 : IF (PRESENT(int_scr_h)) int_scr_h => rho_atom%int_scr_h
221 4989418 : IF (PRESENT(int_scr_s)) int_scr_s => rho_atom%int_scr_s
222 : ELSE
223 0 : CPABORT("The pointer rho_atom is not associated")
224 : END IF
225 :
226 4989418 : END SUBROUTINE get_rho_atom
227 :
228 : ! **************************************************************************************************
229 : !> \brief ...
230 : !> \param rho_atom_set ...
231 : ! **************************************************************************************************
232 20 : 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 20 : IF (ASSOCIATED(rho_atom_set)) THEN
238 20 : natom = SIZE(rho_atom_set)
239 80 : DO iat = 1, natom
240 60 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
241 30 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
242 30 : n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
243 60 : DO i = 1, n
244 28700 : rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef = 0.0_dp
245 : END DO
246 : END IF
247 : END IF
248 80 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s)) THEN
249 30 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s(1)%r_coef)) THEN
250 30 : n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_s, 1)
251 60 : DO i = 1, n
252 28700 : 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 20 : END SUBROUTINE zero_rho_atom_integrals
259 :
260 0 : END MODULE qs_rho_atom_types
|
