Line data Source code
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 : ! **************************************************************************************************
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 : PUBLIC :: deallocate_rho_atom_set, get_rho_atom, rho_atom_coeff, rho_atom_type, &
44 : zero_rho_atom_integrals
45 :
46 : CONTAINS
47 :
48 : ! **************************************************************************************************
49 : !> \brief ...
50 : !> \param rho_atom_set ...
51 : ! **************************************************************************************************
52 5710 : 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 5710 : IF (ASSOCIATED(rho_atom_set)) THEN
59 :
60 5710 : natom = SIZE(rho_atom_set)
61 :
62 23206 : DO iat = 1, natom
63 17496 : IF (ASSOCIATED(rho_atom_set(iat)%cpc_h)) THEN
64 17496 : IF (ASSOCIATED(rho_atom_set(iat)%cpc_h(1)%r_coef)) THEN
65 15518 : n = SIZE(rho_atom_set(iat)%cpc_h, 1)
66 32592 : DO i = 1, n
67 17074 : DEALLOCATE (rho_atom_set(iat)%cpc_h(i)%r_coef)
68 32592 : DEALLOCATE (rho_atom_set(iat)%cpc_s(i)%r_coef)
69 : END DO
70 : END IF
71 17496 : DEALLOCATE (rho_atom_set(iat)%cpc_h)
72 17496 : DEALLOCATE (rho_atom_set(iat)%cpc_s)
73 : END IF
74 17496 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
75 8748 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
76 7759 : n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
77 16296 : DO i = 1, n
78 8537 : DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef)
79 16296 : DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s(i)%r_coef)
80 : END DO
81 : END IF
82 8748 : DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_h)
83 8748 : DEALLOCATE (rho_atom_set(iat)%ga_Vlocal_gb_s)
84 : END IF
85 17496 : IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h)) THEN
86 17496 : IF (ASSOCIATED(rho_atom_set(iat)%int_scr_h(1)%r_coef)) THEN
87 15518 : n = SIZE(rho_atom_set(iat)%int_scr_h, 1)
88 32592 : DO i = 1, n
89 17074 : DEALLOCATE (rho_atom_set(iat)%int_scr_h(i)%r_coef)
90 32592 : DEALLOCATE (rho_atom_set(iat)%int_scr_s(i)%r_coef)
91 : END DO
92 : END IF
93 17496 : DEALLOCATE (rho_atom_set(iat)%int_scr_h)
94 17496 : DEALLOCATE (rho_atom_set(iat)%int_scr_s)
95 : END IF
96 :
97 17496 : IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h)) THEN
98 17496 : IF (ASSOCIATED(rho_atom_set(iat)%drho_rad_h(1)%r_coef)) THEN
99 7611 : n = SIZE(rho_atom_set(iat)%drho_rad_h, 1)
100 15945 : DO i = 1, n
101 8334 : DEALLOCATE (rho_atom_set(iat)%drho_rad_h(i)%r_coef)
102 8334 : DEALLOCATE (rho_atom_set(iat)%drho_rad_s(i)%r_coef)
103 40947 : DO j = 1, 3
104 25002 : DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d(j, i)%r_coef)
105 33336 : DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d(j, i)%r_coef)
106 : END DO
107 : END DO
108 : END IF
109 17496 : DEALLOCATE (rho_atom_set(iat)%drho_rad_h)
110 17496 : DEALLOCATE (rho_atom_set(iat)%drho_rad_s)
111 17496 : DEALLOCATE (rho_atom_set(iat)%rho_rad_h_d)
112 17496 : DEALLOCATE (rho_atom_set(iat)%rho_rad_s_d)
113 : END IF
114 :
115 17496 : IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h)) THEN
116 17496 : IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_h(1)%r_coef)) THEN
117 7611 : n = SIZE(rho_atom_set(iat)%rho_rad_h)
118 15945 : DO i = 1, n
119 15945 : DEALLOCATE (rho_atom_set(iat)%rho_rad_h(i)%r_coef)
120 : END DO
121 : END IF
122 17496 : DEALLOCATE (rho_atom_set(iat)%rho_rad_h)
123 : END IF
124 :
125 17496 : IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s)) THEN
126 17496 : IF (ASSOCIATED(rho_atom_set(iat)%rho_rad_s(1)%r_coef)) THEN
127 7611 : n = SIZE(rho_atom_set(iat)%rho_rad_s)
128 15945 : DO i = 1, n
129 15945 : DEALLOCATE (rho_atom_set(iat)%rho_rad_s(i)%r_coef)
130 : END DO
131 : END IF
132 17496 : DEALLOCATE (rho_atom_set(iat)%rho_rad_s)
133 : END IF
134 :
135 17496 : IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h)) THEN
136 17496 : IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_h(1)%r_coef)) THEN
137 7611 : n = SIZE(rho_atom_set(iat)%vrho_rad_h)
138 15945 : DO i = 1, n
139 15945 : DEALLOCATE (rho_atom_set(iat)%vrho_rad_h(i)%r_coef)
140 : END DO
141 : END IF
142 17496 : DEALLOCATE (rho_atom_set(iat)%vrho_rad_h)
143 : END IF
144 :
145 23206 : IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s)) THEN
146 17496 : IF (ASSOCIATED(rho_atom_set(iat)%vrho_rad_s(1)%r_coef)) THEN
147 7611 : n = SIZE(rho_atom_set(iat)%vrho_rad_s)
148 15945 : DO i = 1, n
149 15945 : DEALLOCATE (rho_atom_set(iat)%vrho_rad_s(i)%r_coef)
150 : END DO
151 : END IF
152 17496 : DEALLOCATE (rho_atom_set(iat)%vrho_rad_s)
153 : END IF
154 :
155 : END DO
156 :
157 5710 : DEALLOCATE (rho_atom_set)
158 :
159 : ELSE
160 :
161 : CALL cp_abort(__LOCATION__, &
162 : "The pointer rho_atom_set is not associated and "// &
163 0 : "cannot be deallocated")
164 :
165 : END IF
166 :
167 5710 : 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 8647170 : 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 8647170 : IF (ASSOCIATED(rho_atom)) THEN
204 8647170 : IF (PRESENT(cpc_h)) cpc_h => rho_atom%cpc_h
205 8647170 : IF (PRESENT(cpc_s)) cpc_s => rho_atom%cpc_s
206 8647170 : IF (PRESENT(rho_rad_h)) rho_rad_h => rho_atom%rho_rad_h
207 8647170 : IF (PRESENT(rho_rad_s)) rho_rad_s => rho_atom%rho_rad_s
208 8647170 : IF (PRESENT(drho_rad_h)) drho_rad_h => rho_atom%drho_rad_h
209 8647170 : IF (PRESENT(drho_rad_s)) drho_rad_s => rho_atom%drho_rad_s
210 8647170 : IF (PRESENT(rho_rad_h_d)) rho_rad_h_d => rho_atom%rho_rad_h_d
211 8647170 : IF (PRESENT(rho_rad_s_d)) rho_rad_s_d => rho_atom%rho_rad_s_d
212 8647170 : IF (PRESENT(vrho_rad_h)) vrho_rad_h => rho_atom%vrho_rad_h
213 8647170 : IF (PRESENT(vrho_rad_s)) vrho_rad_s => rho_atom%vrho_rad_s
214 8647170 : IF (PRESENT(ga_Vlocal_gb_h)) ga_Vlocal_gb_h => rho_atom%ga_Vlocal_gb_h
215 8647170 : IF (PRESENT(ga_Vlocal_gb_s)) ga_Vlocal_gb_s => rho_atom%ga_Vlocal_gb_s
216 8647170 : IF (PRESENT(int_scr_h)) int_scr_h => rho_atom%int_scr_h
217 8647170 : IF (PRESENT(int_scr_s)) int_scr_s => rho_atom%int_scr_s
218 : ELSE
219 0 : CPABORT("The pointer rho_atom is not associated")
220 : END IF
221 :
222 8647170 : END SUBROUTINE get_rho_atom
223 :
224 : ! **************************************************************************************************
225 : !> \brief ...
226 : !> \param rho_atom_set ...
227 : ! **************************************************************************************************
228 232 : 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 232 : IF (ASSOCIATED(rho_atom_set)) THEN
234 232 : natom = SIZE(rho_atom_set)
235 716 : DO iat = 1, natom
236 484 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h)) THEN
237 242 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_h(1)%r_coef)) THEN
238 242 : n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_h, 1)
239 692 : DO i = 1, n
240 1007884 : rho_atom_set(iat)%ga_Vlocal_gb_h(i)%r_coef = 0.0_dp
241 : END DO
242 : END IF
243 : END IF
244 716 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s)) THEN
245 242 : IF (ASSOCIATED(rho_atom_set(iat)%ga_Vlocal_gb_s(1)%r_coef)) THEN
246 242 : n = SIZE(rho_atom_set(iat)%ga_Vlocal_gb_s, 1)
247 692 : DO i = 1, n
248 1007884 : 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 232 : END SUBROUTINE zero_rho_atom_integrals
255 :
256 0 : END MODULE qs_rho_atom_types
|
