(git:b279b6b)
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 ! **************************************************************************************************
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  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 
260 END 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