Line data Source code
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 : ! **************************************************************************************************
9 : !> \brief contains the types and subroutines for dealing with the lri_env
10 : !> lri : local resolution of the identity
11 : !> \par History
12 : !> created JGH [08.2012]
13 : !> Dorothea Golze [02.2014] (1) extended, re-structured, cleaned
14 : !> (2) debugged
15 : !> \authors JGH
16 : !> Dorothea Golze
17 : ! **************************************************************************************************
18 : MODULE lri_environment_types
19 : USE atomic_kind_types, ONLY: atomic_kind_type,&
20 : get_atomic_kind
21 : USE basis_set_types, ONLY: deallocate_gto_basis_set,&
22 : gto_basis_set_p_type,&
23 : gto_basis_set_type
24 : USE cp_dbcsr_operations, ONLY: dbcsr_deallocate_matrix_set
25 : USE dbcsr_api, ONLY: dbcsr_p_type
26 : USE kinds, ONLY: INT_8,&
27 : dp,&
28 : sp
29 : USE mathlib, ONLY: pswitch
30 : USE qs_neighbor_list_types, ONLY: get_iterator_info,&
31 : neighbor_list_iterate,&
32 : neighbor_list_iterator_create,&
33 : neighbor_list_iterator_p_type,&
34 : neighbor_list_iterator_release,&
35 : neighbor_list_set_p_type,&
36 : release_neighbor_list_sets
37 : USE qs_o3c_types, ONLY: o3c_container_type,&
38 : release_o3c_container
39 : #include "./base/base_uses.f90"
40 :
41 : IMPLICIT NONE
42 :
43 : PRIVATE
44 :
45 : ! **************************************************************************************************
46 : ! Integral container
47 : TYPE carray
48 : INTEGER :: compression
49 : REAL(KIND=dp), DIMENSION(:), POINTER :: cdp
50 : REAL(KIND=sp), DIMENSION(:), POINTER :: csp
51 : INTEGER(INT_8), DIMENSION(:), POINTER :: cip
52 : END TYPE carray
53 : TYPE int_container
54 : INTEGER :: na, nb, nc
55 : TYPE(carray), DIMENSION(:), POINTER :: ca
56 : END TYPE int_container
57 : ! **************************************************************************************************
58 : TYPE lri_rhoab_type
59 : ! number of spherical basis functions (a)
60 : INTEGER :: nba
61 : ! number of spherical basis functions (b)
62 : INTEGER :: nbb
63 : ! number of spherical fit basis functions (ai)
64 : INTEGER :: nfa
65 : ! number of spherical fit basis functions (bi)
66 : INTEGER :: nfb
67 : ! expansion coeffs for RI density
68 : REAL(KIND=dp), DIMENSION(:), POINTER :: avec
69 : REAL(KIND=dp), DIMENSION(:), POINTER :: aveca
70 : REAL(KIND=dp), DIMENSION(:), POINTER :: avecb
71 : ! projection coeffs for RI density: SUM_ab (ab,i)*Pab
72 : REAL(KIND=dp), DIMENSION(:), POINTER :: tvec
73 : REAL(KIND=dp), DIMENSION(:), POINTER :: tveca
74 : REAL(KIND=dp), DIMENSION(:), POINTER :: tvecb
75 : ! integral (ai) * sinv * tvec
76 : REAL(KIND=dp) :: nst
77 : REAL(KIND=dp) :: nsta
78 : REAL(KIND=dp) :: nstb
79 : ! Lagrange parameter
80 : REAL(KIND=dp) :: lambda
81 : REAL(KIND=dp) :: lambdaa
82 : REAL(KIND=dp) :: lambdab
83 : ! Charge of pair density
84 : REAL(KIND=dp) :: charge
85 : REAL(KIND=dp) :: chargea
86 : REAL(KIND=dp) :: chargeb
87 : END TYPE lri_rhoab_type
88 :
89 : ! **************************************************************************************************
90 :
91 : TYPE lri_int_type
92 : ! whether to calculate force for pair
93 : LOGICAL :: calc_force_pair
94 : ! number of spherical basis functions (a)
95 : INTEGER :: nba
96 : ! number of spherical basis functions (b)
97 : INTEGER :: nbb
98 : ! number of spherical fit basis functions (ai)
99 : INTEGER :: nfa
100 : ! number of spherical fit basis functions (bi)
101 : INTEGER :: nfb
102 : ! condition number of overlap matrix
103 : REAL(KIND=dp) :: cond_num
104 : ! integrals (a,b,ai)
105 : REAL(KIND=dp), DIMENSION(:, :, :), ALLOCATABLE :: abaint
106 : REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: abascr
107 : ! integrals (a,b,b)
108 : REAL(KIND=dp), DIMENSION(:, :, :), ALLOCATABLE :: abbint
109 : REAL(KIND=dp), DIMENSION(:), ALLOCATABLE :: abbscr
110 : ! compressed aba integrals
111 : TYPE(int_container) :: cabai
112 : ! compressed abb integrals
113 : TYPE(int_container) :: cabbi
114 : ! integrals (da/dA,b,dai/dA)
115 : REAL(KIND=dp), DIMENSION(:, :, :, :), ALLOCATABLE :: dabdaint
116 : ! integrals (da/dA,b,bi)
117 : REAL(KIND=dp), DIMENSION(:, :, :, :), ALLOCATABLE :: dabbint
118 : ! integrals (a,b)
119 : REAL(KIND=dp), DIMENSION(:, :), ALLOCATABLE :: soo
120 : ! derivative d(a,b)/dA
121 : REAL(KIND=dp), DIMENSION(:, :, :), ALLOCATABLE :: dsoo
122 : ! integrals (ai,bi)
123 : REAL(KIND=dp), DIMENSION(:, :), ALLOCATABLE :: sab
124 : ! derivative d(ai,bi)/dA
125 : REAL(KIND=dp), DIMENSION(:, :, :), ALLOCATABLE :: dsab
126 : ! inverse of integrals (ai,bi)
127 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: sinv
128 : ! integral (ai) / (bi), dim(1..nfa,nfa+1..nfa+nfb)
129 : REAL(KIND=dp), DIMENSION(:), POINTER :: n
130 : ! sinv * (ai)
131 : REAL(KIND=dp), DIMENSION(:), POINTER :: sn
132 : ! (ai) * sinv * (ai)
133 : REAL(KIND=dp) :: nsn
134 : ! distant pair approximation
135 : LOGICAL :: lrisr
136 : LOGICAL :: lriff
137 : REAL(KIND=dp) :: wsr, wff, dwsr, dwff
138 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: asinv, bsinv
139 : REAL(KIND=dp), DIMENSION(:), POINTER :: na, nb
140 : REAL(KIND=dp), DIMENSION(:), POINTER :: sna, snb
141 : REAL(KIND=dp) :: nsna, nsnb
142 : !
143 : ! dmax: max deviation for integrals of primitive gtos; for debugging
144 : ! dmax for overlap integrals (ai,bi); fit bas
145 : REAL(KIND=dp) :: dmax_ab
146 : ! dmax for overlap integrals (a,b); orb bas
147 : REAL(KIND=dp) :: dmax_oo
148 : ! dmax for integrals (a,b,ai)
149 : REAL(KIND=dp) :: dmax_aba
150 : ! dmax for integrals (a,b,bi)
151 : REAL(KIND=dp) :: dmax_abb
152 : END TYPE lri_int_type
153 :
154 : TYPE lri_int_rho_type
155 : ! integrals (aa,bb), orb basis
156 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: soaabb
157 : ! dmax for (aa,bb) integrals; for debugging
158 : REAL(KIND=dp) :: dmax_aabb
159 : END TYPE lri_int_rho_type
160 :
161 : TYPE lri_node_type
162 : INTEGER :: nnode = 0
163 : TYPE(lri_int_type), DIMENSION(:), POINTER :: lri_int => NULL()
164 : TYPE(lri_int_rho_type), DIMENSION(:), POINTER :: lri_int_rho => NULL()
165 : TYPE(lri_rhoab_type), DIMENSION(:), POINTER :: lri_rhoab => NULL()
166 : END TYPE lri_node_type
167 :
168 : TYPE lri_atom_type
169 : INTEGER :: natom = 0
170 : TYPE(lri_node_type), DIMENSION(:), POINTER :: lri_node => NULL()
171 : END TYPE lri_atom_type
172 :
173 : TYPE lri_list_type
174 : INTEGER :: nkind = 0
175 : TYPE(lri_atom_type), DIMENSION(:), POINTER :: lri_atom => NULL()
176 : END TYPE lri_list_type
177 :
178 : TYPE lri_list_p_type
179 : TYPE(lri_list_type), POINTER :: lri_list => NULL()
180 : END TYPE lri_list_p_type
181 :
182 : ! **************************************************************************************************
183 :
184 : TYPE lri_bas_type
185 : INTEGER, DIMENSION(:, :, :), POINTER :: orb_index
186 : INTEGER, DIMENSION(:, :, :), POINTER :: ri_index
187 : ! integral of ri basis fbas
188 : REAL(KIND=dp), DIMENSION(:), POINTER :: int_fbas
189 : ! self overlap ri basis
190 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: ri_ovlp
191 : ! inverse of self overlap ri basis
192 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: ri_ovlp_inv
193 : ! self overlap orb basis
194 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: orb_ovlp
195 : ! self overlap (a,a,fa)
196 : REAL(KIND=dp), DIMENSION(:, :, :), ALLOCATABLE :: ovlp3
197 : ! contraction matrix for SHG integrals ri basis
198 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: scon_ri
199 : ! contraction matrix for SHG integrals orb basis
200 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: scon_orb
201 : ! contraction matrix for SHG integrals aba/abb
202 : REAL(KIND=dp), DIMENSION(:, :, :, :), POINTER :: scon_mix
203 : END TYPE lri_bas_type
204 :
205 : ! **************************************************************************************************
206 :
207 : TYPE lri_clebsch_gordon_type
208 : ! Clebsch-Gordon (CG) coefficients
209 : REAL(KIND=dp), DIMENSION(:, :, :), POINTER :: cg_coeff
210 : ! list of non-zero CG coefficients
211 : INTEGER, DIMENSION(:, :, :), POINTER :: cg_none0_list
212 : ! number of non-zero CG coefficients
213 : INTEGER, DIMENSION(:, :), POINTER :: ncg_none0
214 : END TYPE lri_clebsch_gordon_type
215 :
216 : ! **************************************************************************************************
217 :
218 : TYPE lri_ppl_type
219 : ! integrals Vppl*fbas (potential*fit basis) dim(natom,nsgf)
220 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: v_int
221 : END TYPE lri_ppl_type
222 :
223 : TYPE lri_ppl_int_type
224 : TYPE(lri_ppl_type), DIMENSION(:), POINTER :: lri_ppl
225 : REAL(KIND=dp) :: ecore_pp_ri
226 : END TYPE lri_ppl_int_type
227 :
228 : ! **************************************************************************************************
229 :
230 : TYPE ri_fit_type
231 : INTEGER, DIMENSION(:, :), POINTER :: bas_ptr
232 : REAL(KIND=dp), DIMENSION(:), POINTER :: nvec
233 : REAL(KIND=dp), DIMENSION(:), POINTER :: rm1n
234 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: tvec
235 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: rm1t
236 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: avec
237 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: fout
238 : REAL(KIND=dp) :: ntrm1n
239 : REAL(KIND=dp), DIMENSION(2) :: ftrm1n
240 : REAL(KIND=dp), DIMENSION(2) :: echarge
241 : REAL(KIND=dp), DIMENSION(2) :: lambda
242 : END TYPE ri_fit_type
243 :
244 : ! **************************************************************************************************
245 : TYPE wmat_type
246 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: mat
247 : END TYPE wmat_type
248 : TYPE wbas_type
249 : REAL(KIND=dp), DIMENSION(:), POINTER :: vec
250 : END TYPE wbas_type
251 : ! **************************************************************************************************
252 : TYPE stat_type
253 : REAL(KIND=dp) :: pairs_tt
254 : REAL(KIND=dp) :: pairs_sr
255 : REAL(KIND=dp) :: pairs_ff
256 : REAL(KIND=dp) :: overlap_error
257 : REAL(KIND=dp) :: rho_tt
258 : REAL(KIND=dp) :: rho_sr
259 : REAL(KIND=dp) :: rho_ff
260 : REAL(KIND=dp) :: rho_1c
261 : REAL(KIND=dp) :: coef_mem
262 : REAL(KIND=dp) :: oint_mem
263 : REAL(KIND=dp) :: rhos_mem
264 : REAL(KIND=dp) :: abai_mem
265 : REAL(KIND=dp) :: ppli_mem
266 : END TYPE stat_type
267 : ! **************************************************************************************************
268 :
269 : TYPE lri_environment_type
270 : ! parameter for (pseudo)inverse of overlap
271 : INTEGER :: lri_overlap_inv
272 : ! flag for debugging lri integrals
273 : LOGICAL :: debug
274 : ! flag for shg (solid haromonic Gaussian) integrals
275 : LOGICAL :: use_shg_integrals
276 : ! parameter for inversion (autoselect); maximal condition
277 : ! number up to where inversion is legal
278 : REAL(KIND=dp) :: cond_max
279 : ! parameter for checking distance between atom pairs
280 : REAL(KIND=dp) :: delta
281 : ! threshold for aba and abb integrals
282 : REAL(KIND=dp) :: eps_o3_int
283 : ! orbital basis set
284 : TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: orb_basis
285 : ! lri (fit) basis set
286 : TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: ri_basis
287 : ! orb_basis neighborlist
288 : TYPE(neighbor_list_set_p_type), DIMENSION(:), POINTER :: soo_list
289 : TYPE(neighbor_list_set_p_type), DIMENSION(:), POINTER :: saa_list
290 : TYPE(neighbor_list_set_p_type), DIMENSION(:), POINTER :: soa_list
291 : ! local RI integrals
292 : TYPE(lri_list_type), POINTER :: lri_ints
293 : ! local Vppl integrals
294 : TYPE(lri_ppl_int_type), POINTER :: lri_ppl_ints
295 : ! local integral of rho**2; for optimization
296 : TYPE(lri_list_type), POINTER :: lri_ints_rho
297 : ! properties of orb and aux basis
298 : TYPE(lri_bas_type), DIMENSION(:), POINTER :: bas_prop
299 : ! Clebsch-Gordon for solid harmonics
300 : TYPE(lri_clebsch_gordon_type), POINTER :: cg_shg
301 : ! orbital basis overlap
302 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ob_smat
303 : ! statistics
304 : LOGICAL :: statistics
305 : TYPE(stat_type) :: stat
306 : ! exact one-center terms
307 : LOGICAL :: exact_1c_terms
308 : ! use RI for local pp
309 : LOGICAL :: ppl_ri
310 : ! store integrals (needed for basis optimization)
311 : LOGICAL :: store_integrals
312 : ! distant pair approximation
313 : LOGICAL :: distant_pair_approximation
314 : CHARACTER(len=10) :: distant_pair_method
315 : REAL(KIND=dp) :: r_in
316 : REAL(KIND=dp) :: r_out
317 : REAL(KIND=dp), DIMENSION(:), POINTER :: aradius
318 : TYPE(wbas_type), DIMENSION(:), POINTER :: wbas
319 : TYPE(wmat_type), DIMENSION(:, :), POINTER :: wmat
320 : ! RI overlap and inverse
321 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: ri_smat, &
322 : ri_sinv
323 : TYPE(ri_fit_type), POINTER :: ri_fit
324 : CHARACTER(len=10) :: ri_sinv_app
325 : TYPE(o3c_container_type), POINTER :: o3c
326 : END TYPE lri_environment_type
327 :
328 : ! **************************************************************************************************
329 :
330 : TYPE lri_kind_type
331 : ! expansion coeff for lri density dim(natom,nsgf)
332 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: acoef
333 : ! integrals V*fbas (potential*fit basis) dim(natom,nsgf)
334 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: v_int
335 : ! SUM_i integral(V*fbas_i)*davec/dR dim(natom,3)
336 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: v_dadr
337 : ! integrals V*dfbas/dR
338 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: v_dfdr
339 : END TYPE lri_kind_type
340 :
341 : TYPE lri_spin_type
342 : TYPE(lri_kind_type), DIMENSION(:), POINTER :: lri_kinds
343 : END TYPE lri_spin_type
344 :
345 : ! **************************************************************************************************
346 :
347 : TYPE lri_force_type
348 : REAL(KIND=dp), DIMENSION(:), POINTER :: st
349 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: dssn, &
350 : dsst
351 : ! derivative dtvec/dR
352 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: dtvec
353 : END TYPE lri_force_type
354 :
355 : ! **************************************************************************************************
356 :
357 : TYPE lri_density_type
358 : INTEGER :: nspin = 0
359 : ! pair density expansion (nspin)
360 : TYPE(lri_list_p_type), DIMENSION(:), POINTER :: lri_rhos => NULL()
361 : ! coefficients of RI expansion and gradients (nspin)
362 : TYPE(lri_spin_type), DIMENSION(:), POINTER :: lri_coefs => NULL()
363 : END TYPE lri_density_type
364 :
365 : ! **************************************************************************************************
366 :
367 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'lri_environment_types'
368 :
369 : PUBLIC :: lri_environment_type, &
370 : lri_force_type, lri_list_type, &
371 : lri_int_type, lri_int_rho_type, lri_density_type, &
372 : lri_kind_type, lri_rhoab_type
373 : PUBLIC :: int_container, carray
374 : PUBLIC :: lri_env_create, lri_env_release, allocate_lri_coefs, &
375 : allocate_lri_ints, allocate_lri_ints_rho, lri_density_create, &
376 : allocate_lri_ppl_ints, deallocate_lri_ppl_ints, &
377 : lri_density_release, allocate_lri_rhos, allocate_lri_force_components, &
378 : deallocate_lri_ints, deallocate_lri_ints_rho, &
379 : deallocate_lri_force_components, deallocate_bas_properties
380 :
381 : ! **************************************************************************************************
382 :
383 : CONTAINS
384 :
385 : ! **************************************************************************************************
386 : !> \brief creates and initializes an lri_env
387 : !> \param lri_env the lri_environment you want to create
388 : ! **************************************************************************************************
389 60 : SUBROUTINE lri_env_create(lri_env)
390 :
391 : TYPE(lri_environment_type), INTENT(OUT) :: lri_env
392 :
393 60 : lri_env%debug = .FALSE.
394 60 : lri_env%delta = 1.E-6_dp
395 :
396 60 : lri_env%store_integrals = .FALSE.
397 :
398 60 : NULLIFY (lri_env%orb_basis)
399 60 : NULLIFY (lri_env%ri_basis)
400 :
401 60 : NULLIFY (lri_env%soo_list)
402 60 : NULLIFY (lri_env%saa_list)
403 60 : NULLIFY (lri_env%soa_list)
404 60 : NULLIFY (lri_env%lri_ints)
405 60 : NULLIFY (lri_env%lri_ppl_ints)
406 60 : NULLIFY (lri_env%lri_ints_rho)
407 60 : NULLIFY (lri_env%bas_prop)
408 :
409 60 : NULLIFY (lri_env%ob_smat)
410 60 : NULLIFY (lri_env%ri_smat)
411 60 : NULLIFY (lri_env%ri_sinv)
412 60 : NULLIFY (lri_env%ri_fit)
413 60 : NULLIFY (lri_env%o3c)
414 60 : NULLIFY (lri_env%aradius)
415 60 : NULLIFY (lri_env%wmat)
416 60 : NULLIFY (lri_env%wbas)
417 :
418 : NULLIFY (lri_env%cg_shg)
419 60 : ALLOCATE (lri_env%cg_shg)
420 60 : NULLIFY (lri_env%cg_shg%cg_coeff)
421 60 : NULLIFY (lri_env%cg_shg%cg_none0_list)
422 60 : NULLIFY (lri_env%cg_shg%ncg_none0)
423 :
424 60 : END SUBROUTINE lri_env_create
425 :
426 : ! **************************************************************************************************
427 : !> \brief releases the given lri_env
428 : !> \param lri_env the lri environment to release
429 : ! **************************************************************************************************
430 60 : SUBROUTINE lri_env_release(lri_env)
431 :
432 : TYPE(lri_environment_type), INTENT(INOUT) :: lri_env
433 :
434 : INTEGER :: i, ikind, j, nkind
435 :
436 : ! deallocate basis sets
437 60 : IF (ASSOCIATED(lri_env%orb_basis)) THEN
438 60 : nkind = SIZE(lri_env%orb_basis)
439 170 : DO ikind = 1, nkind
440 170 : CALL deallocate_gto_basis_set(lri_env%orb_basis(ikind)%gto_basis_set)
441 : END DO
442 60 : DEALLOCATE (lri_env%orb_basis)
443 : END IF
444 60 : IF (ASSOCIATED(lri_env%ri_basis)) THEN
445 60 : nkind = SIZE(lri_env%ri_basis)
446 170 : DO ikind = 1, nkind
447 170 : CALL deallocate_gto_basis_set(lri_env%ri_basis(ikind)%gto_basis_set)
448 : END DO
449 60 : DEALLOCATE (lri_env%ri_basis)
450 : END IF
451 60 : CALL release_neighbor_list_sets(lri_env%soo_list)
452 60 : CALL release_neighbor_list_sets(lri_env%saa_list)
453 60 : CALL release_neighbor_list_sets(lri_env%soa_list)
454 60 : IF (ASSOCIATED(lri_env%lri_ints)) THEN
455 58 : CALL deallocate_lri_ints(lri_env%lri_ints)
456 : END IF
457 60 : IF (ASSOCIATED(lri_env%lri_ppl_ints)) THEN
458 2 : CALL deallocate_lri_ppl_ints(lri_env%lri_ppl_ints)
459 : END IF
460 60 : IF (ASSOCIATED(lri_env%lri_ints_rho)) THEN
461 6 : CALL deallocate_lri_ints_rho(lri_env%lri_ints_rho)
462 : END IF
463 60 : CALL deallocate_bas_properties(lri_env)
464 60 : IF (ASSOCIATED(lri_env%aradius)) THEN
465 0 : DEALLOCATE (lri_env%aradius)
466 : END IF
467 60 : IF (ASSOCIATED(lri_env%wmat)) THEN
468 52 : DO i = 1, SIZE(lri_env%wmat, 1)
469 118 : DO j = 1, SIZE(lri_env%wmat, 2)
470 100 : IF (ASSOCIATED(lri_env%wmat(i, j)%mat)) THEN
471 66 : DEALLOCATE (lri_env%wmat(i, j)%mat)
472 : END IF
473 : END DO
474 : END DO
475 18 : DEALLOCATE (lri_env%wmat)
476 : END IF
477 60 : IF (ASSOCIATED(lri_env%wbas)) THEN
478 46 : DO i = 1, SIZE(lri_env%wbas, 1)
479 46 : IF (ASSOCIATED(lri_env%wbas(i)%vec)) THEN
480 30 : DEALLOCATE (lri_env%wbas(i)%vec)
481 : END IF
482 : END DO
483 16 : DEALLOCATE (lri_env%wbas)
484 : END IF
485 60 : IF (ASSOCIATED(lri_env%cg_shg)) THEN
486 60 : IF (ASSOCIATED(lri_env%cg_shg%cg_coeff)) THEN
487 60 : DEALLOCATE (lri_env%cg_shg%cg_coeff)
488 : END IF
489 60 : IF (ASSOCIATED(lri_env%cg_shg%cg_none0_list)) THEN
490 60 : DEALLOCATE (lri_env%cg_shg%cg_none0_list)
491 : END IF
492 60 : IF (ASSOCIATED(lri_env%cg_shg%ncg_none0)) THEN
493 60 : DEALLOCATE (lri_env%cg_shg%ncg_none0)
494 : END IF
495 60 : DEALLOCATE (lri_env%cg_shg)
496 : END IF
497 : ! RI
498 60 : IF (ASSOCIATED(lri_env%ob_smat)) CALL dbcsr_deallocate_matrix_set(lri_env%ob_smat)
499 60 : IF (ASSOCIATED(lri_env%ri_smat)) CALL dbcsr_deallocate_matrix_set(lri_env%ri_smat)
500 60 : IF (ASSOCIATED(lri_env%ri_sinv)) CALL dbcsr_deallocate_matrix_set(lri_env%ri_sinv)
501 60 : IF (ASSOCIATED(lri_env%ri_fit)) THEN
502 0 : IF (ASSOCIATED(lri_env%ri_fit%nvec)) THEN
503 0 : DEALLOCATE (lri_env%ri_fit%nvec)
504 : END IF
505 0 : IF (ASSOCIATED(lri_env%ri_fit%rm1n)) THEN
506 0 : DEALLOCATE (lri_env%ri_fit%rm1n)
507 : END IF
508 0 : IF (ASSOCIATED(lri_env%ri_fit%tvec)) THEN
509 0 : DEALLOCATE (lri_env%ri_fit%tvec)
510 : END IF
511 0 : IF (ASSOCIATED(lri_env%ri_fit%rm1t)) THEN
512 0 : DEALLOCATE (lri_env%ri_fit%rm1t)
513 : END IF
514 0 : IF (ASSOCIATED(lri_env%ri_fit%avec)) THEN
515 0 : DEALLOCATE (lri_env%ri_fit%avec)
516 : END IF
517 0 : IF (ASSOCIATED(lri_env%ri_fit%fout)) THEN
518 0 : DEALLOCATE (lri_env%ri_fit%fout)
519 : END IF
520 0 : IF (ASSOCIATED(lri_env%ri_fit%bas_ptr)) THEN
521 0 : DEALLOCATE (lri_env%ri_fit%bas_ptr)
522 : END IF
523 0 : DEALLOCATE (lri_env%ri_fit)
524 : END IF
525 60 : IF (ASSOCIATED(lri_env%o3c)) THEN
526 0 : CALL release_o3c_container(lri_env%o3c)
527 0 : DEALLOCATE (lri_env%o3c)
528 : END IF
529 :
530 60 : END SUBROUTINE lri_env_release
531 :
532 : ! **************************************************************************************************
533 : !> \brief creates and initializes an lri_density environment
534 : !> \param lri_density the lri_density environment you want to create
535 : ! **************************************************************************************************
536 862 : SUBROUTINE lri_density_create(lri_density)
537 :
538 : TYPE(lri_density_type), INTENT(OUT) :: lri_density
539 :
540 : lri_density%nspin = 0
541 :
542 : NULLIFY (lri_density%lri_rhos)
543 : NULLIFY (lri_density%lri_coefs)
544 :
545 862 : END SUBROUTINE lri_density_create
546 :
547 : ! **************************************************************************************************
548 : !> \brief releases the given lri_density
549 : !> \param lri_density the lri_density to release
550 : ! **************************************************************************************************
551 862 : SUBROUTINE lri_density_release(lri_density)
552 :
553 : TYPE(lri_density_type), INTENT(INOUT) :: lri_density
554 :
555 862 : CALL deallocate_lri_rhos(lri_density%lri_rhos)
556 862 : CALL deallocate_lri_coefs(lri_density%lri_coefs)
557 :
558 862 : END SUBROUTINE lri_density_release
559 :
560 : ! **************************************************************************************************
561 : !> \brief allocate lri_ints, matrices that store LRI integrals
562 : !> \param lri_env ...
563 : !> \param lri_ints structure storing the LRI integrals
564 : !> \param nkind number of atom kinds
565 : ! **************************************************************************************************
566 88 : SUBROUTINE allocate_lri_ints(lri_env, lri_ints, nkind)
567 :
568 : TYPE(lri_environment_type), POINTER :: lri_env
569 : TYPE(lri_list_type), POINTER :: lri_ints
570 : INTEGER, INTENT(IN) :: nkind
571 :
572 : INTEGER :: i, iac, iatom, ikind, ilist, jatom, &
573 : jkind, jneighbor, nba, nbb, nfa, nfb, &
574 : nlist, nn, nneighbor
575 : LOGICAL :: dpa, e1c
576 : REAL(KIND=dp) :: dab, ra, rab(3), rb
577 : TYPE(gto_basis_set_type), POINTER :: fbasa, fbasb, obasa, obasb
578 : TYPE(lri_int_type), POINTER :: lrii
579 : TYPE(neighbor_list_iterator_p_type), &
580 88 : DIMENSION(:), POINTER :: nl_iterator
581 :
582 0 : CPASSERT(ASSOCIATED(lri_env))
583 :
584 88 : NULLIFY (fbasa, fbasb, lrii, nl_iterator, obasa, obasb)
585 :
586 88 : ALLOCATE (lri_ints)
587 :
588 88 : dpa = lri_env%distant_pair_approximation
589 88 : ra = lri_env%r_in
590 88 : rb = lri_env%r_out
591 88 : lri_env%stat%oint_mem = 0.0_dp
592 :
593 88 : lri_ints%nkind = nkind
594 554 : ALLOCATE (lri_ints%lri_atom(nkind*nkind))
595 :
596 378 : DO i = 1, nkind*nkind
597 290 : NULLIFY (lri_ints%lri_atom(i)%lri_node)
598 378 : lri_ints%lri_atom(i)%natom = 0
599 : END DO
600 :
601 88 : CALL neighbor_list_iterator_create(nl_iterator, lri_env%soo_list)
602 9526 : DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
603 :
604 : CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, &
605 : nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, &
606 9438 : iatom=iatom, jatom=jatom, r=rab)
607 :
608 9438 : iac = ikind + nkind*(jkind - 1)
609 37752 : dab = SQRT(SUM(rab*rab))
610 :
611 9438 : obasa => lri_env%orb_basis(ikind)%gto_basis_set
612 9438 : obasb => lri_env%orb_basis(jkind)%gto_basis_set
613 9438 : fbasa => lri_env%ri_basis(ikind)%gto_basis_set
614 9438 : fbasb => lri_env%ri_basis(jkind)%gto_basis_set
615 :
616 9438 : IF (.NOT. ASSOCIATED(obasa)) CYCLE
617 9438 : IF (.NOT. ASSOCIATED(obasb)) CYCLE
618 :
619 9438 : IF (.NOT. ASSOCIATED(lri_ints%lri_atom(iac)%lri_node)) THEN
620 192 : lri_ints%lri_atom(iac)%natom = nlist
621 872 : ALLOCATE (lri_ints%lri_atom(iac)%lri_node(nlist))
622 488 : DO i = 1, nlist
623 296 : NULLIFY (lri_ints%lri_atom(iac)%lri_node(i)%lri_int)
624 488 : lri_ints%lri_atom(iac)%lri_node(i)%nnode = 0
625 : END DO
626 : END IF
627 9438 : IF (.NOT. ASSOCIATED(lri_ints%lri_atom(iac)%lri_node(ilist)%lri_int)) THEN
628 267 : lri_ints%lri_atom(iac)%lri_node(ilist)%nnode = nneighbor
629 10239 : ALLOCATE (lri_ints%lri_atom(iac)%lri_node(ilist)%lri_int(nneighbor))
630 : END IF
631 :
632 9438 : lrii => lri_ints%lri_atom(iac)%lri_node(ilist)%lri_int(jneighbor)
633 :
634 9438 : nba = obasa%nsgf
635 9438 : nbb = obasb%nsgf
636 9438 : nfa = fbasa%nsgf
637 9438 : nfb = fbasb%nsgf
638 9438 : nn = nfa + nfb
639 :
640 9438 : IF (iatom == jatom .AND. dab < lri_env%delta) THEN
641 159 : e1c = lri_env%exact_1c_terms
642 : ELSE
643 : e1c = .FALSE.
644 : END IF
645 :
646 159 : IF (.NOT. e1c) THEN
647 28242 : ALLOCATE (lrii%abascr(nfa))
648 778432 : lrii%abascr = 0._dp
649 28242 : ALLOCATE (lrii%abbscr(nfb))
650 778432 : lrii%abbscr = 0._dp
651 9414 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + nfa + nfb
652 : END IF
653 :
654 9438 : IF (dpa) THEN
655 8015 : lrii%wsr = pswitch(dab, ra, rb, 0)
656 8015 : lrii%wff = 1.0_dp - lrii%wsr
657 8015 : lrii%dwsr = pswitch(dab, ra, rb, 1)
658 8015 : lrii%dwff = -lrii%dwsr
659 8015 : lrii%lrisr = (lrii%wsr > 0.0_dp)
660 8015 : lrii%lriff = (lrii%wff > 0.0_dp)
661 8015 : NULLIFY (lrii%asinv, lrii%bsinv)
662 : ELSE
663 1423 : lrii%lrisr = .TRUE.
664 1423 : lrii%lriff = .FALSE.
665 1423 : lrii%wsr = 1.0_dp
666 1423 : lrii%wff = 0.0_dp
667 1423 : lrii%dwsr = 0.0_dp
668 1423 : lrii%dwff = 0.0_dp
669 1423 : NULLIFY (lrii%asinv, lrii%bsinv)
670 : END IF
671 :
672 : ! compressed storage
673 9438 : NULLIFY (lrii%cabai%ca, lrii%cabbi%ca)
674 :
675 : ! full LRI method term
676 9438 : IF (lrii%lrisr) THEN
677 2150 : IF (e1c) THEN
678 24 : NULLIFY (lrii%n, lrii%sn)
679 24 : NULLIFY (lrii%sinv)
680 : ELSE
681 8504 : ALLOCATE (lrii%soo(nba, nbb))
682 2126 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + nba*nbb
683 270365 : lrii%soo = 0._dp
684 :
685 2126 : IF (iatom == jatom .AND. dab < lri_env%delta) THEN
686 540 : ALLOCATE (lrii%sinv(nfa, nfa))
687 135 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + nfa*nfa
688 : ELSE
689 7964 : ALLOCATE (lrii%sinv(nn, nn))
690 1991 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + nn*nn
691 : END IF
692 43571014 : lrii%sinv = 0._dp
693 :
694 2126 : IF (iatom == jatom .AND. dab < lri_env%delta) THEN
695 675 : ALLOCATE (lrii%n(nfa), lrii%sn(nfa))
696 135 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + 2.*nfa
697 : ELSE
698 9955 : ALLOCATE (lrii%n(nn), lrii%sn(nn))
699 1991 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + 2.*nn
700 : END IF
701 269967 : lrii%n = 0._dp
702 269967 : lrii%sn = 0._dp
703 : END IF
704 : ELSE
705 7288 : NULLIFY (lrii%n, lrii%sn)
706 7288 : NULLIFY (lrii%sinv)
707 : END IF
708 :
709 : ! far field approximation
710 9438 : IF (lrii%lriff) THEN
711 7808 : lrii%asinv => lri_env%bas_prop(ikind)%ri_ovlp_inv
712 7808 : lrii%bsinv => lri_env%bas_prop(jkind)%ri_ovlp_inv
713 39040 : ALLOCATE (lrii%na(nfa), lrii%sna(nfa))
714 7808 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + 2.*nfa
715 683796 : lrii%na = 0._dp
716 683796 : lrii%sna = 0._dp
717 39040 : ALLOCATE (lrii%nb(nfb), lrii%snb(nfb))
718 7808 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + 2.*nfb
719 683796 : lrii%nb = 0._dp
720 683796 : lrii%snb = 0._dp
721 7808 : IF (.NOT. ALLOCATED(lrii%soo)) THEN
722 29152 : ALLOCATE (lrii%soo(nba, nbb))
723 7288 : lri_env%stat%oint_mem = lri_env%stat%oint_mem + nba*nbb
724 1210536 : lrii%soo = 0._dp
725 : ELSE
726 520 : CPASSERT(SIZE(lrii%soo, 1) == nba .AND. SIZE(lrii%soo, 2) == nbb)
727 : END IF
728 : ELSE
729 1630 : NULLIFY (lrii%na, lrii%sna)
730 1630 : NULLIFY (lrii%nb, lrii%snb)
731 : END IF
732 :
733 9438 : lrii%dmax_ab = 0._dp
734 9438 : lrii%dmax_oo = 0._dp
735 9438 : lrii%dmax_aba = 0._dp
736 9438 : lrii%dmax_abb = 0._dp
737 :
738 9438 : lrii%calc_force_pair = .FALSE.
739 :
740 : END DO
741 :
742 88 : CALL neighbor_list_iterator_release(nl_iterator)
743 :
744 88 : END SUBROUTINE allocate_lri_ints
745 :
746 : ! **************************************************************************************************
747 : !> \brief allocate lri_ppl_ints, matrices that store LRI integrals
748 : !> \param lri_env ...
749 : !> \param lri_ppl_ints structure storing the LRI ppl integrals
750 : !> \param atomic_kind_set ...
751 : ! **************************************************************************************************
752 2 : SUBROUTINE allocate_lri_ppl_ints(lri_env, lri_ppl_ints, atomic_kind_set)
753 :
754 : TYPE(lri_environment_type), POINTER :: lri_env
755 : TYPE(lri_ppl_int_type), POINTER :: lri_ppl_ints
756 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
757 :
758 : INTEGER :: ikind, natom, nfa, nkind
759 : TYPE(atomic_kind_type), POINTER :: atomic_kind
760 : TYPE(gto_basis_set_type), POINTER :: fbasa
761 :
762 2 : CPASSERT(ASSOCIATED(lri_env))
763 :
764 2 : lri_env%stat%ppli_mem = 0.0_dp
765 2 : nkind = SIZE(atomic_kind_set)
766 2 : ALLOCATE (lri_ppl_ints)
767 6 : ALLOCATE (lri_ppl_ints%lri_ppl(nkind))
768 6 : DO ikind = 1, nkind
769 4 : fbasa => lri_env%ri_basis(ikind)%gto_basis_set
770 4 : nfa = fbasa%nsgf
771 4 : atomic_kind => atomic_kind_set(ikind)
772 4 : CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom)
773 16 : ALLOCATE (lri_ppl_ints%lri_ppl(ikind)%v_int(natom, nfa))
774 10 : lri_env%stat%ppli_mem = lri_env%stat%ppli_mem + natom*nfa
775 : END DO
776 :
777 2 : END SUBROUTINE allocate_lri_ppl_ints
778 :
779 : ! **************************************************************************************************
780 : !> \brief allocate lri_ints_rho, storing integral for the exact density
781 : !> \param lri_env ...
782 : !> \param lri_ints_rho structure storing the integrals (aa,bb)
783 : !> \param nkind number of atom kinds
784 : ! **************************************************************************************************
785 6 : SUBROUTINE allocate_lri_ints_rho(lri_env, lri_ints_rho, nkind)
786 :
787 : TYPE(lri_environment_type), POINTER :: lri_env
788 : TYPE(lri_list_type), POINTER :: lri_ints_rho
789 : INTEGER, INTENT(IN) :: nkind
790 :
791 : INTEGER :: i, iac, iatom, ikind, ilist, jatom, &
792 : jkind, jneighbor, nba, nbb, nlist, &
793 : nneighbor
794 : TYPE(gto_basis_set_type), POINTER :: obasa, obasb
795 : TYPE(lri_int_rho_type), POINTER :: lriir
796 : TYPE(neighbor_list_iterator_p_type), &
797 6 : DIMENSION(:), POINTER :: nl_iterator
798 :
799 0 : CPASSERT(ASSOCIATED(lri_env))
800 :
801 6 : ALLOCATE (lri_ints_rho)
802 :
803 6 : lri_ints_rho%nkind = nkind
804 24 : ALLOCATE (lri_ints_rho%lri_atom(nkind*nkind))
805 :
806 12 : DO i = 1, nkind*nkind
807 6 : NULLIFY (lri_ints_rho%lri_atom(i)%lri_node)
808 12 : lri_ints_rho%lri_atom(i)%natom = 0
809 : END DO
810 :
811 6 : CALL neighbor_list_iterator_create(nl_iterator, lri_env%soo_list)
812 15 : DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
813 :
814 : CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, &
815 : nlist=nlist, ilist=ilist, nnode=nneighbor, inode=jneighbor, &
816 9 : iatom=iatom, jatom=jatom)
817 :
818 9 : iac = ikind + nkind*(jkind - 1)
819 :
820 9 : obasa => lri_env%orb_basis(ikind)%gto_basis_set
821 9 : obasb => lri_env%orb_basis(jkind)%gto_basis_set
822 :
823 9 : IF (.NOT. ASSOCIATED(obasa)) CYCLE
824 9 : IF (.NOT. ASSOCIATED(obasb)) CYCLE
825 :
826 9 : IF (.NOT. ASSOCIATED(lri_ints_rho%lri_atom(iac)%lri_node)) THEN
827 6 : lri_ints_rho%lri_atom(iac)%natom = nlist
828 24 : ALLOCATE (lri_ints_rho%lri_atom(iac)%lri_node(nlist))
829 12 : DO i = 1, nlist
830 6 : NULLIFY (lri_ints_rho%lri_atom(iac)%lri_node(i)%lri_int_rho)
831 12 : lri_ints_rho%lri_atom(iac)%lri_node(i)%nnode = 0
832 : END DO
833 : END IF
834 9 : IF (.NOT. ASSOCIATED(lri_ints_rho%lri_atom(iac)%lri_node(ilist)%lri_int_rho)) THEN
835 6 : lri_ints_rho%lri_atom(iac)%lri_node(ilist)%nnode = nneighbor
836 18 : ALLOCATE (lri_ints_rho%lri_atom(iac)%lri_node(ilist)%lri_int_rho(nneighbor))
837 : END IF
838 :
839 9 : lriir => lri_ints_rho%lri_atom(iac)%lri_node(ilist)%lri_int_rho(jneighbor)
840 :
841 9 : nba = obasa%nsgf
842 9 : nbb = obasb%nsgf
843 :
844 54 : ALLOCATE (lriir%soaabb(nba, nba, nbb, nbb))
845 3069 : lriir%soaabb = 0._dp
846 15 : lriir%dmax_aabb = 0._dp
847 :
848 : END DO
849 :
850 6 : CALL neighbor_list_iterator_release(nl_iterator)
851 :
852 6 : END SUBROUTINE allocate_lri_ints_rho
853 :
854 : ! **************************************************************************************************
855 : !> \brief creates and initializes lri_rhos
856 : !> \param lri_env ...
857 : !> \param lri_rhos structure storing tvec and avec
858 : !> \param nspin ...
859 : !> \param nkind number of atom kinds
860 : ! **************************************************************************************************
861 862 : SUBROUTINE allocate_lri_rhos(lri_env, lri_rhos, nspin, nkind)
862 :
863 : TYPE(lri_environment_type), POINTER :: lri_env
864 : TYPE(lri_list_p_type), DIMENSION(:), POINTER :: lri_rhos
865 : INTEGER, INTENT(IN) :: nspin, nkind
866 :
867 : INTEGER :: i, iac, iatom, ikind, ilist, ispin, &
868 : jatom, jkind, jneighbor, nfa, nfb, &
869 : nlist, nn, nneighbor
870 : REAL(KIND=dp) :: dab, rab(3)
871 : TYPE(lri_int_type), POINTER :: lrii
872 : TYPE(lri_list_type), POINTER :: lri_rho
873 : TYPE(lri_rhoab_type), POINTER :: lrho
874 : TYPE(neighbor_list_iterator_p_type), &
875 862 : DIMENSION(:), POINTER :: nl_iterator
876 :
877 0 : CPASSERT(ASSOCIATED(lri_env))
878 :
879 862 : NULLIFY (lri_rho, lrho, lrii, nl_iterator)
880 :
881 3482 : ALLOCATE (lri_rhos(nspin))
882 :
883 862 : lri_env%stat%rhos_mem = 0.0_dp
884 :
885 1758 : DO ispin = 1, nspin
886 :
887 896 : ALLOCATE (lri_rhos(ispin)%lri_list)
888 :
889 896 : lri_rhos(ispin)%lri_list%nkind = nkind
890 6198 : ALLOCATE (lri_rhos(ispin)%lri_list%lri_atom(nkind*nkind))
891 :
892 4406 : DO i = 1, nkind*nkind
893 3510 : NULLIFY (lri_rhos(ispin)%lri_list%lri_atom(i)%lri_node)
894 4406 : lri_rhos(ispin)%lri_list%lri_atom(i)%natom = 0
895 : END DO
896 :
897 896 : lri_rho => lri_rhos(ispin)%lri_list
898 :
899 896 : CALL neighbor_list_iterator_create(nl_iterator, lri_env%soo_list)
900 40632 : DO WHILE (neighbor_list_iterate(nl_iterator) == 0)
901 : CALL get_iterator_info(nl_iterator, ikind=ikind, jkind=jkind, &
902 : iatom=iatom, jatom=jatom, nlist=nlist, ilist=ilist, &
903 39736 : nnode=nneighbor, inode=jneighbor, r=rab)
904 :
905 39736 : iac = ikind + nkind*(jkind - 1)
906 158944 : dab = SQRT(SUM(rab*rab))
907 :
908 39736 : IF (.NOT. ASSOCIATED(lri_env%lri_ints%lri_atom(iac)%lri_node)) CYCLE
909 :
910 39736 : IF (.NOT. ASSOCIATED(lri_rho%lri_atom(iac)%lri_node)) THEN
911 2021 : lri_rho%lri_atom(iac)%natom = nlist
912 9224 : ALLOCATE (lri_rho%lri_atom(iac)%lri_node(nlist))
913 5182 : DO i = 1, nlist
914 3161 : NULLIFY (lri_rho%lri_atom(iac)%lri_node(i)%lri_rhoab)
915 5182 : lri_rho%lri_atom(iac)%lri_node(i)%nnode = 0
916 : END DO
917 : END IF
918 39736 : IF (.NOT. ASSOCIATED(lri_rho%lri_atom(iac)%lri_node(ilist)%lri_rhoab)) THEN
919 2771 : lri_rho%lri_atom(iac)%lri_node(ilist)%nnode = nneighbor
920 8313 : ALLOCATE (lri_rho%lri_atom(iac)%lri_node(ilist)%lri_rhoab(nneighbor))
921 : END IF
922 :
923 39736 : lrho => lri_rho%lri_atom(iac)%lri_node(ilist)%lri_rhoab(jneighbor)
924 39736 : lrii => lri_env%lri_ints%lri_atom(iac)%lri_node(ilist)%lri_int(jneighbor)
925 :
926 39736 : lrho%nba = lrii%nba
927 39736 : lrho%nbb = lrii%nbb
928 39736 : lrho%nfa = lrii%nfa
929 39736 : lrho%nfb = lrii%nfb
930 :
931 39736 : nfa = lrho%nfa
932 39736 : nfb = lrho%nfb
933 39736 : nn = nfa + nfb
934 :
935 39736 : NULLIFY (lrho%avec, lrho%tvec)
936 39736 : IF (lrii%lrisr) THEN
937 15064 : IF (iatom == jatom .AND. dab < lri_env%delta) THEN
938 1577 : IF (.NOT. lri_env%exact_1c_terms) THEN
939 4299 : ALLOCATE (lrho%avec(nfa))
940 4299 : ALLOCATE (lrho%tvec(nfa))
941 1433 : lri_env%stat%rhos_mem = lri_env%stat%rhos_mem + 2*nfa
942 : END IF
943 : ELSE
944 40461 : ALLOCATE (lrho%avec(nn))
945 40461 : ALLOCATE (lrho%tvec(nn))
946 13487 : lri_env%stat%rhos_mem = lri_env%stat%rhos_mem + 2*nn
947 : END IF
948 : END IF
949 39736 : NULLIFY (lrho%aveca, lrho%tveca)
950 39736 : NULLIFY (lrho%avecb, lrho%tvecb)
951 40632 : IF (lrii%lriff) THEN
952 79236 : ALLOCATE (lrho%aveca(nfa))
953 79236 : ALLOCATE (lrho%avecb(nfb))
954 79236 : ALLOCATE (lrho%tveca(nfa))
955 79236 : ALLOCATE (lrho%tvecb(nfb))
956 26412 : lri_env%stat%rhos_mem = lri_env%stat%rhos_mem + 2*(nfa + nfb)
957 : END IF
958 :
959 : END DO
960 :
961 1758 : CALL neighbor_list_iterator_release(nl_iterator)
962 :
963 : END DO
964 :
965 862 : END SUBROUTINE allocate_lri_rhos
966 :
967 : ! **************************************************************************************************
968 : !> \brief creates and initializes lri_coefs
969 : !> \param lri_env ...
970 : !> \param lri_density ...
971 : !> \param atomic_kind_set ...
972 : ! **************************************************************************************************
973 844 : SUBROUTINE allocate_lri_coefs(lri_env, lri_density, atomic_kind_set)
974 :
975 : TYPE(lri_environment_type), POINTER :: lri_env
976 : TYPE(lri_density_type), POINTER :: lri_density
977 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
978 :
979 : INTEGER :: ikind, ispin, natom, nkind, nsgf, nspin
980 : TYPE(atomic_kind_type), POINTER :: atomic_kind
981 : TYPE(gto_basis_set_type), POINTER :: fbas
982 844 : TYPE(lri_spin_type), DIMENSION(:), POINTER :: lri_coefs
983 :
984 0 : CPASSERT(ASSOCIATED(lri_density))
985 :
986 844 : NULLIFY (atomic_kind, fbas, lri_coefs)
987 :
988 844 : nkind = SIZE(atomic_kind_set)
989 844 : nspin = lri_density%nspin
990 :
991 844 : lri_env%stat%coef_mem = 0.0_dp
992 :
993 2532 : ALLOCATE (lri_density%lri_coefs(nspin))
994 844 : lri_coefs => lri_density%lri_coefs
995 :
996 1704 : DO ispin = 1, nspin
997 2580 : ALLOCATE (lri_coefs(ispin)%lri_kinds(nkind))
998 3422 : DO ikind = 1, nkind
999 1718 : NULLIFY (lri_coefs(ispin)%lri_kinds(ikind)%acoef)
1000 1718 : NULLIFY (lri_coefs(ispin)%lri_kinds(ikind)%v_int)
1001 1718 : NULLIFY (lri_coefs(ispin)%lri_kinds(ikind)%v_dadr)
1002 1718 : NULLIFY (lri_coefs(ispin)%lri_kinds(ikind)%v_dfdr)
1003 1718 : atomic_kind => atomic_kind_set(ikind)
1004 1718 : CALL get_atomic_kind(atomic_kind=atomic_kind, natom=natom)
1005 1718 : fbas => lri_env%ri_basis(ikind)%gto_basis_set
1006 1718 : nsgf = fbas%nsgf
1007 6872 : ALLOCATE (lri_coefs(ispin)%lri_kinds(ikind)%acoef(natom, nsgf))
1008 562296 : lri_coefs(ispin)%lri_kinds(ikind)%acoef = 0._dp
1009 6872 : ALLOCATE (lri_coefs(ispin)%lri_kinds(ikind)%v_int(natom, nsgf))
1010 562296 : lri_coefs(ispin)%lri_kinds(ikind)%v_int = 0._dp
1011 5154 : ALLOCATE (lri_coefs(ispin)%lri_kinds(ikind)%v_dadr(natom, 3))
1012 16118 : lri_coefs(ispin)%lri_kinds(ikind)%v_dadr = 0._dp
1013 5154 : ALLOCATE (lri_coefs(ispin)%lri_kinds(ikind)%v_dfdr(natom, 3))
1014 16118 : lri_coefs(ispin)%lri_kinds(ikind)%v_dfdr = 0._dp
1015 : !
1016 4296 : lri_env%stat%coef_mem = lri_env%stat%coef_mem + 2._dp*natom*(nsgf + 3)
1017 : END DO
1018 : END DO
1019 :
1020 844 : END SUBROUTINE allocate_lri_coefs
1021 :
1022 : ! **************************************************************************************************
1023 : !> \brief creates and initializes lri_force
1024 : !> \param lri_force ...
1025 : !> \param nfa and nfb number of fit functions on a/b
1026 : !> \param nfb ...
1027 : ! **************************************************************************************************
1028 11962 : SUBROUTINE allocate_lri_force_components(lri_force, nfa, nfb)
1029 :
1030 : TYPE(lri_force_type), POINTER :: lri_force
1031 : INTEGER, INTENT(IN) :: nfa, nfb
1032 :
1033 : INTEGER :: nn
1034 :
1035 11962 : nn = nfa + nfb
1036 :
1037 11962 : CPASSERT(.NOT. ASSOCIATED(lri_force))
1038 :
1039 11962 : ALLOCATE (lri_force)
1040 :
1041 35886 : ALLOCATE (lri_force%st(nn))
1042 984556 : lri_force%st = 0._dp
1043 35886 : ALLOCATE (lri_force%dsst(nn, 3))
1044 2965630 : lri_force%dsst = 0._dp
1045 35886 : ALLOCATE (lri_force%dssn(nn, 3))
1046 2965630 : lri_force%dssn = 0._dp
1047 35886 : ALLOCATE (lri_force%dtvec(nn, 3))
1048 2965630 : lri_force%dtvec = 0._dp
1049 :
1050 11962 : END SUBROUTINE allocate_lri_force_components
1051 :
1052 : ! **************************************************************************************************
1053 : !> \brief deallocates one-center overlap integrals, integral of ri basis
1054 : !> and scon matrices
1055 : !> \param lri_env ...
1056 : ! **************************************************************************************************
1057 138 : SUBROUTINE deallocate_bas_properties(lri_env)
1058 :
1059 : TYPE(lri_environment_type), INTENT(INOUT) :: lri_env
1060 :
1061 : INTEGER :: i
1062 :
1063 138 : IF (ASSOCIATED(lri_env%bas_prop)) THEN
1064 206 : DO i = 1, SIZE(lri_env%bas_prop)
1065 128 : IF (ASSOCIATED(lri_env%bas_prop(i)%int_fbas)) THEN
1066 128 : DEALLOCATE (lri_env%bas_prop(i)%int_fbas)
1067 : END IF
1068 128 : IF (ASSOCIATED(lri_env%bas_prop(i)%ri_ovlp)) THEN
1069 128 : DEALLOCATE (lri_env%bas_prop(i)%ri_ovlp)
1070 : END IF
1071 128 : IF (ASSOCIATED(lri_env%bas_prop(i)%ri_ovlp_inv)) THEN
1072 128 : DEALLOCATE (lri_env%bas_prop(i)%ri_ovlp_inv)
1073 : END IF
1074 128 : IF (ASSOCIATED(lri_env%bas_prop(i)%orb_ovlp)) THEN
1075 128 : DEALLOCATE (lri_env%bas_prop(i)%orb_ovlp)
1076 : END IF
1077 128 : IF (ALLOCATED(lri_env%bas_prop(i)%ovlp3)) THEN
1078 128 : DEALLOCATE (lri_env%bas_prop(i)%ovlp3)
1079 : END IF
1080 128 : IF (ASSOCIATED(lri_env%bas_prop(i)%scon_ri)) THEN
1081 128 : DEALLOCATE (lri_env%bas_prop(i)%scon_ri)
1082 : END IF
1083 128 : IF (ASSOCIATED(lri_env%bas_prop(i)%scon_orb)) THEN
1084 128 : DEALLOCATE (lri_env%bas_prop(i)%scon_orb)
1085 : END IF
1086 128 : IF (ASSOCIATED(lri_env%bas_prop(i)%orb_index)) THEN
1087 128 : DEALLOCATE (lri_env%bas_prop(i)%orb_index)
1088 : END IF
1089 128 : IF (ASSOCIATED(lri_env%bas_prop(i)%ri_index)) THEN
1090 128 : DEALLOCATE (lri_env%bas_prop(i)%ri_index)
1091 : END IF
1092 206 : IF (ASSOCIATED(lri_env%bas_prop(i)%scon_mix)) THEN
1093 128 : DEALLOCATE (lri_env%bas_prop(i)%scon_mix)
1094 : END IF
1095 : END DO
1096 78 : DEALLOCATE (lri_env%bas_prop)
1097 : END IF
1098 :
1099 138 : END SUBROUTINE deallocate_bas_properties
1100 :
1101 : ! **************************************************************************************************
1102 : !> \brief deallocates the given lri_ints
1103 : !> \param lri_ints ...
1104 : ! **************************************************************************************************
1105 88 : SUBROUTINE deallocate_lri_ints(lri_ints)
1106 :
1107 : TYPE(lri_list_type), POINTER :: lri_ints
1108 :
1109 : INTEGER :: i, iatom, ijkind, inode, natom, nkind, &
1110 : nnode
1111 : TYPE(lri_int_type), POINTER :: lri_int
1112 :
1113 88 : CPASSERT(ASSOCIATED(lri_ints))
1114 88 : nkind = lri_ints%nkind
1115 :
1116 88 : IF (nkind > 0) THEN
1117 378 : DO ijkind = 1, SIZE(lri_ints%lri_atom)
1118 290 : natom = lri_ints%lri_atom(ijkind)%natom
1119 378 : IF (natom > 0) THEN
1120 488 : DO iatom = 1, natom
1121 296 : nnode = lri_ints%lri_atom(ijkind)%lri_node(iatom)%nnode
1122 488 : IF (nnode > 0) THEN
1123 267 : IF (ASSOCIATED(lri_ints%lri_atom(ijkind)%lri_node(iatom)%lri_int)) THEN
1124 9705 : DO inode = 1, nnode
1125 9438 : lri_int => lri_ints%lri_atom(ijkind)%lri_node(iatom)%lri_int(inode)
1126 9438 : IF (ALLOCATED(lri_int%sab)) THEN
1127 27 : DEALLOCATE (lri_int%sab)
1128 : END IF
1129 9438 : IF (ALLOCATED(lri_int%soo)) THEN
1130 9414 : DEALLOCATE (lri_int%soo)
1131 : END IF
1132 9438 : IF (ALLOCATED(lri_int%abaint)) THEN
1133 0 : DEALLOCATE (lri_int%abaint)
1134 : END IF
1135 9438 : IF (ALLOCATED(lri_int%abascr)) THEN
1136 9414 : DEALLOCATE (lri_int%abascr)
1137 : END IF
1138 9438 : IF (ALLOCATED(lri_int%abbint)) THEN
1139 0 : DEALLOCATE (lri_int%abbint)
1140 : END IF
1141 9438 : IF (ALLOCATED(lri_int%abbscr)) THEN
1142 9414 : DEALLOCATE (lri_int%abbscr)
1143 : END IF
1144 9438 : IF (ALLOCATED(lri_int%dsab)) THEN
1145 0 : DEALLOCATE (lri_int%dsab)
1146 : END IF
1147 9438 : IF (ALLOCATED(lri_int%dsoo)) THEN
1148 0 : DEALLOCATE (lri_int%dsoo)
1149 : END IF
1150 9438 : IF (ALLOCATED(lri_int%dabbint)) THEN
1151 0 : DEALLOCATE (lri_int%dabbint)
1152 : END IF
1153 9438 : IF (ALLOCATED(lri_int%dabdaint)) THEN
1154 0 : DEALLOCATE (lri_int%dabdaint)
1155 : END IF
1156 9438 : IF (ASSOCIATED(lri_int%sinv)) THEN
1157 2126 : DEALLOCATE (lri_int%sinv)
1158 : END IF
1159 9438 : IF (ASSOCIATED(lri_int%n)) THEN
1160 2126 : DEALLOCATE (lri_int%n)
1161 : END IF
1162 9438 : IF (ASSOCIATED(lri_int%sn)) THEN
1163 2126 : DEALLOCATE (lri_int%sn)
1164 : END IF
1165 9438 : IF (ASSOCIATED(lri_int%na)) THEN
1166 7808 : DEALLOCATE (lri_int%na)
1167 : END IF
1168 9438 : IF (ASSOCIATED(lri_int%nb)) THEN
1169 7808 : DEALLOCATE (lri_int%nb)
1170 : END IF
1171 9438 : IF (ASSOCIATED(lri_int%sna)) THEN
1172 7808 : DEALLOCATE (lri_int%sna)
1173 : END IF
1174 9438 : IF (ASSOCIATED(lri_int%snb)) THEN
1175 7808 : DEALLOCATE (lri_int%snb)
1176 : END IF
1177 : ! integral container
1178 9438 : IF (ASSOCIATED(lri_int%cabai%ca)) THEN
1179 778432 : DO i = 1, SIZE(lri_int%cabai%ca)
1180 769018 : IF (ASSOCIATED(lri_int%cabai%ca(i)%cdp)) DEALLOCATE (lri_int%cabai%ca(i)%cdp)
1181 769018 : IF (ASSOCIATED(lri_int%cabai%ca(i)%csp)) DEALLOCATE (lri_int%cabai%ca(i)%csp)
1182 778432 : IF (ASSOCIATED(lri_int%cabai%ca(i)%cip)) DEALLOCATE (lri_int%cabai%ca(i)%cip)
1183 : END DO
1184 9414 : DEALLOCATE (lri_int%cabai%ca)
1185 : END IF
1186 9705 : IF (ASSOCIATED(lri_int%cabbi%ca)) THEN
1187 766606 : DO i = 1, SIZE(lri_int%cabbi%ca)
1188 757327 : IF (ASSOCIATED(lri_int%cabbi%ca(i)%cdp)) DEALLOCATE (lri_int%cabbi%ca(i)%cdp)
1189 757327 : IF (ASSOCIATED(lri_int%cabbi%ca(i)%csp)) DEALLOCATE (lri_int%cabbi%ca(i)%csp)
1190 766606 : IF (ASSOCIATED(lri_int%cabbi%ca(i)%cip)) DEALLOCATE (lri_int%cabbi%ca(i)%cip)
1191 : END DO
1192 9279 : DEALLOCATE (lri_int%cabbi%ca)
1193 : END IF
1194 : END DO
1195 267 : DEALLOCATE (lri_ints%lri_atom(ijkind)%lri_node(iatom)%lri_int)
1196 : END IF
1197 : END IF
1198 : END DO
1199 192 : DEALLOCATE (lri_ints%lri_atom(ijkind)%lri_node)
1200 : END IF
1201 : END DO
1202 88 : DEALLOCATE (lri_ints%lri_atom)
1203 : END IF
1204 88 : DEALLOCATE (lri_ints)
1205 :
1206 88 : END SUBROUTINE deallocate_lri_ints
1207 :
1208 : ! **************************************************************************************************
1209 : !> \brief deallocates the given lri_ppl_ints
1210 : !> \param lri_ppl_ints ...
1211 : ! **************************************************************************************************
1212 2 : SUBROUTINE deallocate_lri_ppl_ints(lri_ppl_ints)
1213 :
1214 : TYPE(lri_ppl_int_type), POINTER :: lri_ppl_ints
1215 :
1216 : INTEGER :: ikind, nkind
1217 :
1218 2 : CPASSERT(ASSOCIATED(lri_ppl_ints))
1219 2 : IF (ASSOCIATED(lri_ppl_ints%lri_ppl)) THEN
1220 2 : nkind = SIZE(lri_ppl_ints%lri_ppl)
1221 6 : DO ikind = 1, nkind
1222 6 : IF (ASSOCIATED(lri_ppl_ints%lri_ppl(ikind)%v_int)) THEN
1223 4 : DEALLOCATE (lri_ppl_ints%lri_ppl(ikind)%v_int)
1224 : END IF
1225 : END DO
1226 2 : DEALLOCATE (lri_ppl_ints%lri_ppl)
1227 : END IF
1228 2 : DEALLOCATE (lri_ppl_ints)
1229 :
1230 2 : END SUBROUTINE deallocate_lri_ppl_ints
1231 :
1232 : ! **************************************************************************************************
1233 : !> \brief deallocates the given lri_ints_rho
1234 : !> \param lri_ints_rho ...
1235 : ! **************************************************************************************************
1236 6 : SUBROUTINE deallocate_lri_ints_rho(lri_ints_rho)
1237 :
1238 : TYPE(lri_list_type), POINTER :: lri_ints_rho
1239 :
1240 : INTEGER :: iatom, ijkind, inode, natom, nkind, nnode
1241 :
1242 6 : CPASSERT(ASSOCIATED(lri_ints_rho))
1243 6 : nkind = lri_ints_rho%nkind
1244 :
1245 6 : IF (nkind > 0) THEN
1246 12 : DO ijkind = 1, SIZE(lri_ints_rho%lri_atom)
1247 6 : natom = lri_ints_rho%lri_atom(ijkind)%natom
1248 12 : IF (natom > 0) THEN
1249 12 : DO iatom = 1, natom
1250 6 : nnode = lri_ints_rho%lri_atom(ijkind)%lri_node(iatom)%nnode
1251 12 : IF (nnode > 0) THEN
1252 6 : IF (ASSOCIATED(lri_ints_rho%lri_atom(ijkind)%lri_node(iatom)%lri_int_rho)) THEN
1253 15 : DO inode = 1, nnode
1254 15 : IF (ASSOCIATED(lri_ints_rho%lri_atom(ijkind)%lri_node(iatom)%lri_int_rho(inode)%soaabb)) THEN
1255 9 : DEALLOCATE (lri_ints_rho%lri_atom(ijkind)%lri_node(iatom)%lri_int_rho(inode)%soaabb)
1256 : END IF
1257 : END DO
1258 6 : DEALLOCATE (lri_ints_rho%lri_atom(ijkind)%lri_node(iatom)%lri_int_rho)
1259 : END IF
1260 : END IF
1261 : END DO
1262 6 : DEALLOCATE (lri_ints_rho%lri_atom(ijkind)%lri_node)
1263 : END IF
1264 : END DO
1265 6 : DEALLOCATE (lri_ints_rho%lri_atom)
1266 : END IF
1267 6 : DEALLOCATE (lri_ints_rho)
1268 :
1269 6 : END SUBROUTINE deallocate_lri_ints_rho
1270 :
1271 : ! **************************************************************************************************
1272 : !> \brief deallocates the given lri_rhos
1273 : !> \param lri_rhos ...
1274 : ! **************************************************************************************************
1275 862 : SUBROUTINE deallocate_lri_rhos(lri_rhos)
1276 :
1277 : TYPE(lri_list_p_type), DIMENSION(:), POINTER :: lri_rhos
1278 :
1279 : INTEGER :: i, iatom, ijkind, inode, natom, nkind, &
1280 : nnode
1281 : TYPE(lri_list_type), POINTER :: lri_rho
1282 : TYPE(lri_rhoab_type), POINTER :: lri_rhoab
1283 :
1284 862 : IF (ASSOCIATED(lri_rhos)) THEN
1285 1758 : DO i = 1, SIZE(lri_rhos)
1286 896 : lri_rho => lri_rhos(i)%lri_list
1287 896 : CPASSERT(ASSOCIATED(lri_rho))
1288 896 : nkind = lri_rho%nkind
1289 896 : IF (nkind > 0) THEN
1290 896 : CPASSERT(ASSOCIATED(lri_rho%lri_atom))
1291 4406 : DO ijkind = 1, SIZE(lri_rho%lri_atom)
1292 3510 : natom = lri_rho%lri_atom(ijkind)%natom
1293 4406 : IF (natom > 0) THEN
1294 2021 : CPASSERT(ASSOCIATED(lri_rho%lri_atom(ijkind)%lri_node))
1295 5182 : DO iatom = 1, natom
1296 3161 : nnode = lri_rho%lri_atom(ijkind)%lri_node(iatom)%nnode
1297 5182 : IF (nnode > 0) THEN
1298 2771 : IF (ASSOCIATED(lri_rho%lri_atom(ijkind)%lri_node(iatom)%lri_rhoab)) THEN
1299 42507 : DO inode = 1, nnode
1300 39736 : lri_rhoab => lri_rho%lri_atom(ijkind)%lri_node(iatom)%lri_rhoab(inode)
1301 39736 : IF (ASSOCIATED(lri_rhoab%avec)) DEALLOCATE (lri_rhoab%avec)
1302 39736 : IF (ASSOCIATED(lri_rhoab%tvec)) DEALLOCATE (lri_rhoab%tvec)
1303 39736 : IF (ASSOCIATED(lri_rhoab%aveca)) DEALLOCATE (lri_rhoab%aveca)
1304 39736 : IF (ASSOCIATED(lri_rhoab%tveca)) DEALLOCATE (lri_rhoab%tveca)
1305 39736 : IF (ASSOCIATED(lri_rhoab%avecb)) DEALLOCATE (lri_rhoab%avecb)
1306 42507 : IF (ASSOCIATED(lri_rhoab%tvecb)) DEALLOCATE (lri_rhoab%tvecb)
1307 : END DO
1308 2771 : DEALLOCATE (lri_rho%lri_atom(ijkind)%lri_node(iatom)%lri_rhoab)
1309 : END IF
1310 : END IF
1311 : END DO
1312 2021 : DEALLOCATE (lri_rho%lri_atom(ijkind)%lri_node)
1313 : END IF
1314 : END DO
1315 896 : DEALLOCATE (lri_rho%lri_atom)
1316 : END IF
1317 1758 : DEALLOCATE (lri_rho)
1318 : END DO
1319 :
1320 862 : DEALLOCATE (lri_rhos)
1321 :
1322 : END IF
1323 862 : NULLIFY (lri_rhos)
1324 :
1325 862 : END SUBROUTINE deallocate_lri_rhos
1326 :
1327 : ! **************************************************************************************************
1328 : !> \brief releases the given lri_coefs
1329 : !> \param lri_coefs the integral storage environment that is released
1330 : ! **************************************************************************************************
1331 862 : SUBROUTINE deallocate_lri_coefs(lri_coefs)
1332 : TYPE(lri_spin_type), DIMENSION(:), POINTER :: lri_coefs
1333 :
1334 : INTEGER :: i, j
1335 :
1336 862 : IF (ASSOCIATED(lri_coefs)) THEN
1337 1704 : DO i = 1, SIZE(lri_coefs)
1338 2578 : DO j = 1, SIZE(lri_coefs(i)%lri_kinds)
1339 1718 : IF (ASSOCIATED(lri_coefs(i)%lri_kinds(j)%acoef)) THEN
1340 1718 : DEALLOCATE (lri_coefs(i)%lri_kinds(j)%acoef)
1341 : END IF
1342 1718 : IF (ASSOCIATED(lri_coefs(i)%lri_kinds(j)%v_int)) THEN
1343 1718 : DEALLOCATE (lri_coefs(i)%lri_kinds(j)%v_int)
1344 : END IF
1345 1718 : IF (ASSOCIATED(lri_coefs(i)%lri_kinds(j)%v_dadr)) THEN
1346 1718 : DEALLOCATE (lri_coefs(i)%lri_kinds(j)%v_dadr)
1347 : END IF
1348 2578 : IF (ASSOCIATED(lri_coefs(i)%lri_kinds(j)%v_dfdr)) THEN
1349 1718 : DEALLOCATE (lri_coefs(i)%lri_kinds(j)%v_dfdr)
1350 : END IF
1351 : END DO
1352 1704 : DEALLOCATE (lri_coefs(i)%lri_kinds)
1353 : END DO
1354 844 : DEALLOCATE (lri_coefs)
1355 : END IF
1356 :
1357 862 : NULLIFY (lri_coefs)
1358 :
1359 862 : END SUBROUTINE deallocate_lri_coefs
1360 :
1361 : ! **************************************************************************************************
1362 : !> \brief releases the given lri_force_type
1363 : !> \param lri_force the integral storage environment that is released
1364 : ! **************************************************************************************************
1365 11962 : SUBROUTINE deallocate_lri_force_components(lri_force)
1366 :
1367 : TYPE(lri_force_type), POINTER :: lri_force
1368 :
1369 11962 : IF (ASSOCIATED(lri_force)) THEN
1370 11962 : IF (ASSOCIATED(lri_force%st)) THEN
1371 11962 : DEALLOCATE (lri_force%st)
1372 : END IF
1373 11962 : IF (ASSOCIATED(lri_force%dssn)) THEN
1374 11962 : DEALLOCATE (lri_force%dssn)
1375 : END IF
1376 11962 : IF (ASSOCIATED(lri_force%dsst)) THEN
1377 11962 : DEALLOCATE (lri_force%dsst)
1378 : END IF
1379 11962 : IF (ASSOCIATED(lri_force%dtvec)) THEN
1380 11962 : DEALLOCATE (lri_force%dtvec)
1381 : END IF
1382 11962 : DEALLOCATE (lri_force)
1383 : END IF
1384 :
1385 11962 : NULLIFY (lri_force)
1386 :
1387 11962 : END SUBROUTINE deallocate_lri_force_components
1388 :
1389 0 : END MODULE lri_environment_types
|
