(git:58e3e09)
qs_local_rho_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 ! **************************************************************************************************
9 
10  USE kinds, ONLY: dp
11  USE mathconstants, ONLY: fourpi,&
12  pi
13  USE memory_utilities, ONLY: reallocate
14  USE qs_grid_atom, ONLY: grid_atom_type
15  USE qs_harmonics_atom, ONLY: harmonics_atom_type
18  rho0_atom_type,&
19  rho0_mpole_type
21  rho_atom_type
22 #include "./base/base_uses.f90"
23 
24  IMPLICIT NONE
25 
26  PRIVATE
27 
28 ! *** Global parameters (only in this module)
29 
30  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_local_rho_types'
31 
32 ! *** Define rhoz and local_rho types ***
33 
34 ! **************************************************************************************************
35  TYPE rhoz_type
36  REAL(dp) :: one_atom
37  REAL(dp), DIMENSION(:), POINTER :: r_coef
38  REAL(dp), DIMENSION(:), POINTER :: dr_coef
39  REAL(dp), DIMENSION(:), POINTER :: vr_coef
40  END TYPE rhoz_type
41 
42 ! **************************************************************************************************
43  TYPE local_rho_type
44  TYPE(rho_atom_type), DIMENSION(:), POINTER :: rho_atom_set
45  TYPE(rho0_mpole_type), POINTER :: rho0_mpole
46  TYPE(rho0_atom_type), DIMENSION(:), POINTER :: rho0_atom_set
47  TYPE(rhoz_type), DIMENSION(:), POINTER :: rhoz_set
48  REAL(dp) :: rhoz_tot
49  END TYPE local_rho_type
50 
51 ! Public Types
52  PUBLIC :: local_rho_type, rhoz_type
53 
54 ! Public Subroutine
55  PUBLIC :: allocate_rhoz, calculate_rhoz, &
58 
59 CONTAINS
60 
61 ! **************************************************************************************************
62 !> \brief ...
63 !> \param rhoz_set ...
64 !> \param nkind ...
65 ! **************************************************************************************************
66  SUBROUTINE allocate_rhoz(rhoz_set, nkind)
67 
68  TYPE(rhoz_type), DIMENSION(:), POINTER :: rhoz_set
69  INTEGER :: nkind
70 
71  INTEGER :: ikind
72 
73  IF (ASSOCIATED(rhoz_set)) THEN
74  CALL deallocate_rhoz(rhoz_set)
75  END IF
76 
77  ALLOCATE (rhoz_set(nkind))
78 
79  DO ikind = 1, nkind
80  NULLIFY (rhoz_set(ikind)%r_coef)
81  NULLIFY (rhoz_set(ikind)%dr_coef)
82  NULLIFY (rhoz_set(ikind)%vr_coef)
83  END DO
84 
85  END SUBROUTINE allocate_rhoz
86 
87 ! **************************************************************************************************
88 !> \brief ...
89 !> \param rhoz ...
90 !> \param grid_atom ...
91 !> \param alpha ...
92 !> \param zeff ...
93 !> \param natom ...
94 !> \param rhoz_tot ...
95 !> \param harmonics ...
96 ! **************************************************************************************************
97  SUBROUTINE calculate_rhoz(rhoz, grid_atom, alpha, zeff, natom, rhoz_tot, harmonics)
98 
99  TYPE(rhoz_type) :: rhoz
100  TYPE(grid_atom_type) :: grid_atom
101  REAL(dp), INTENT(IN) :: alpha
102  REAL(dp) :: zeff
103  INTEGER :: natom
104  REAL(dp), INTENT(INOUT) :: rhoz_tot
105  TYPE(harmonics_atom_type) :: harmonics
106 
107  INTEGER :: ir, na, nr
108  REAL(dp) :: c1, c2, c3, prefactor1, prefactor2, &
109  prefactor3, sum
110 
111  nr = grid_atom%nr
112  na = grid_atom%ng_sphere
113  CALL reallocate(rhoz%r_coef, 1, nr)
114  CALL reallocate(rhoz%dr_coef, 1, nr)
115  CALL reallocate(rhoz%vr_coef, 1, nr)
116 
117  c1 = alpha/pi
118  c2 = c1*c1*c1*fourpi
119  c3 = sqrt(alpha)
120  prefactor1 = zeff*sqrt(c2)
121  prefactor2 = -2.0_dp*alpha
122  prefactor3 = -zeff*sqrt(fourpi)
123 
124  sum = 0.0_dp
125  DO ir = 1, nr
126  c1 = -alpha*grid_atom%rad2(ir)
127  rhoz%r_coef(ir) = -exp(c1)*prefactor1
128  IF (abs(rhoz%r_coef(ir)) < 1.0e-30_dp) THEN
129  rhoz%r_coef(ir) = 0.0_dp
130  rhoz%dr_coef(ir) = 0.0_dp
131  ELSE
132  rhoz%dr_coef(ir) = prefactor2*rhoz%r_coef(ir)
133  END IF
134  rhoz%vr_coef(ir) = prefactor3*erf(grid_atom%rad(ir)*c3)/grid_atom%rad(ir)
135  sum = sum + rhoz%r_coef(ir)*grid_atom%wr(ir)
136  END DO
137  rhoz%one_atom = sum*harmonics%slm_int(1)
138  rhoz_tot = rhoz_tot + natom*rhoz%one_atom
139 
140  END SUBROUTINE calculate_rhoz
141 
142 ! **************************************************************************************************
143 !> \brief ...
144 !> \param rhoz_set ...
145 ! **************************************************************************************************
146  SUBROUTINE deallocate_rhoz(rhoz_set)
147 
148  TYPE(rhoz_type), DIMENSION(:), POINTER :: rhoz_set
149 
150  INTEGER :: ikind, nkind
151 
152  nkind = SIZE(rhoz_set)
153 
154  DO ikind = 1, nkind
155  DEALLOCATE (rhoz_set(ikind)%r_coef)
156  DEALLOCATE (rhoz_set(ikind)%dr_coef)
157  DEALLOCATE (rhoz_set(ikind)%vr_coef)
158  END DO
159 
160  DEALLOCATE (rhoz_set)
161 
162  END SUBROUTINE deallocate_rhoz
163 
164 ! **************************************************************************************************
165 !> \brief ...
166 !> \param local_rho_set ...
167 !> \param rho_atom_set ...
168 !> \param rho0_atom_set ...
169 !> \param rho0_mpole ...
170 !> \param rhoz_set ...
171 ! **************************************************************************************************
172  SUBROUTINE get_local_rho(local_rho_set, rho_atom_set, rho0_atom_set, rho0_mpole, rhoz_set)
173 
174  TYPE(local_rho_type), POINTER :: local_rho_set
175  TYPE(rho_atom_type), DIMENSION(:), OPTIONAL, &
176  POINTER :: rho_atom_set
177  TYPE(rho0_atom_type), DIMENSION(:), OPTIONAL, &
178  POINTER :: rho0_atom_set
179  TYPE(rho0_mpole_type), OPTIONAL, POINTER :: rho0_mpole
180  TYPE(rhoz_type), DIMENSION(:), OPTIONAL, POINTER :: rhoz_set
181 
182  IF (PRESENT(rho_atom_set)) rho_atom_set => local_rho_set%rho_atom_set
183  IF (PRESENT(rho0_atom_set)) rho0_atom_set => local_rho_set%rho0_atom_set
184  IF (PRESENT(rho0_mpole)) rho0_mpole => local_rho_set%rho0_mpole
185  IF (PRESENT(rhoz_set)) rhoz_set => local_rho_set%rhoz_set
186 
187  END SUBROUTINE get_local_rho
188 
189 ! **************************************************************************************************
190 !> \brief ...
191 !> \param local_rho_set ...
192 ! **************************************************************************************************
193  SUBROUTINE local_rho_set_create(local_rho_set)
194 
195  TYPE(local_rho_type), POINTER :: local_rho_set
196 
197  ALLOCATE (local_rho_set)
198 
199  NULLIFY (local_rho_set%rho_atom_set)
200  NULLIFY (local_rho_set%rho0_atom_set)
201  NULLIFY (local_rho_set%rho0_mpole)
202  NULLIFY (local_rho_set%rhoz_set)
203 
204  local_rho_set%rhoz_tot = 0.0_dp
205 
206  END SUBROUTINE local_rho_set_create
207 
208 ! **************************************************************************************************
209 !> \brief ...
210 !> \param local_rho_set ...
211 ! **************************************************************************************************
212  SUBROUTINE local_rho_set_release(local_rho_set)
213 
214  TYPE(local_rho_type), POINTER :: local_rho_set
215 
216  IF (ASSOCIATED(local_rho_set)) THEN
217  IF (ASSOCIATED(local_rho_set%rho_atom_set)) THEN
218  CALL deallocate_rho_atom_set(local_rho_set%rho_atom_set)
219  END IF
220 
221  IF (ASSOCIATED(local_rho_set%rho0_atom_set)) THEN
222  CALL deallocate_rho0_atom(local_rho_set%rho0_atom_set)
223  END IF
224 
225  IF (ASSOCIATED(local_rho_set%rho0_mpole)) THEN
226  CALL deallocate_rho0_mpole(local_rho_set%rho0_mpole)
227  END IF
228 
229  IF (ASSOCIATED(local_rho_set%rhoz_set)) THEN
230  CALL deallocate_rhoz(local_rho_set%rhoz_set)
231  END IF
232 
233  DEALLOCATE (local_rho_set)
234  END IF
235 
236  END SUBROUTINE local_rho_set_release
237 
238 ! **************************************************************************************************
239 !> \brief ...
240 !> \param local_rho_set ...
241 !> \param rho_atom_set ...
242 !> \param rho0_atom_set ...
243 !> \param rho0_mpole ...
244 !> \param rhoz_set ...
245 ! **************************************************************************************************
246  SUBROUTINE set_local_rho(local_rho_set, rho_atom_set, rho0_atom_set, rho0_mpole, &
247  rhoz_set)
248 
249  TYPE(local_rho_type), POINTER :: local_rho_set
250  TYPE(rho_atom_type), DIMENSION(:), OPTIONAL, &
251  POINTER :: rho_atom_set
252  TYPE(rho0_atom_type), DIMENSION(:), OPTIONAL, &
253  POINTER :: rho0_atom_set
254  TYPE(rho0_mpole_type), OPTIONAL, POINTER :: rho0_mpole
255  TYPE(rhoz_type), DIMENSION(:), OPTIONAL, POINTER :: rhoz_set
256 
257  IF (PRESENT(rho_atom_set)) THEN
258  IF (ASSOCIATED(local_rho_set%rho_atom_set)) THEN
259  CALL deallocate_rho_atom_set(local_rho_set%rho_atom_set)
260  END IF
261  local_rho_set%rho_atom_set => rho_atom_set
262  END IF
263 
264  IF (PRESENT(rho0_atom_set)) THEN
265  IF (ASSOCIATED(local_rho_set%rho0_atom_set)) THEN
266  CALL deallocate_rho0_atom(local_rho_set%rho0_atom_set)
267  END IF
268  local_rho_set%rho0_atom_set => rho0_atom_set
269  END IF
270 
271  IF (PRESENT(rho0_mpole)) THEN
272  IF (ASSOCIATED(local_rho_set%rho0_mpole)) THEN
273  CALL deallocate_rho0_mpole(local_rho_set%rho0_mpole)
274  END IF
275  local_rho_set%rho0_mpole => rho0_mpole
276  END IF
277 
278  IF (PRESENT(rhoz_set)) THEN
279  IF (ASSOCIATED(local_rho_set%rhoz_set)) THEN
280  CALL deallocate_rhoz(local_rho_set%rhoz_set)
281  END IF
282  local_rho_set%rhoz_set => rhoz_set
283  END IF
284 
285  END SUBROUTINE set_local_rho
286 
287 END MODULE qs_local_rho_types
288 
Defines the basic variable types.
Definition: kinds.F:23
integer, parameter, public dp
Definition: kinds.F:34
Definition of mathematical constants and functions.
Definition: mathconstants.F:16
real(kind=dp), parameter, public pi
real(kind=dp), parameter, public fourpi
Utility routines for the memory handling.
subroutine, public local_rho_set_create(local_rho_set)
...
subroutine, public allocate_rhoz(rhoz_set, nkind)
...
subroutine, public local_rho_set_release(local_rho_set)
...
subroutine, public set_local_rho(local_rho_set, rho_atom_set, rho0_atom_set, rho0_mpole, rhoz_set)
...
subroutine, public calculate_rhoz(rhoz, grid_atom, alpha, zeff, natom, rhoz_tot, harmonics)
...
subroutine, public get_local_rho(local_rho_set, rho_atom_set, rho0_atom_set, rho0_mpole, rhoz_set)
...
subroutine, public deallocate_rho0_mpole(rho0)
...
subroutine, public deallocate_rho0_atom(rho0_atom_set)
...
subroutine, public deallocate_rho_atom_set(rho_atom_set)
...