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 : ! **************************************************************************************************
9 : !> \brief Types and set_get for real time propagation
10 : !> depending on runtype and diagonalization method different
11 : !> matrices are allocated
12 : !> exp_H_old, exp_H_new, mos_new, mos_old contain always
13 : !> real and imaginary parts of the matrices
14 : !> odd index = real part (alpha, beta spin)
15 : !> even index= imaginary part (alpha, beta spin)
16 : !> \par History
17 : !> 02.2014 switched to dbcsr matrices [Samuel Andermatt]
18 : !> \author Florian Schiffmann 02.09
19 : ! **************************************************************************************************
20 :
21 : MODULE rt_propagation_types
22 :
23 : USE bibliography, ONLY: Kunert2003,&
24 : cite_reference
25 : USE cp_control_types, ONLY: dft_control_type,&
26 : rtp_control_type
27 : USE cp_dbcsr_api, ONLY: dbcsr_create,&
28 : dbcsr_deallocate_matrix,&
29 : dbcsr_init_p,&
30 : dbcsr_p_type,&
31 : dbcsr_type
32 : USE cp_dbcsr_operations, ONLY: dbcsr_allocate_matrix_set,&
33 : dbcsr_deallocate_matrix_set
34 : USE cp_fm_pool_types, ONLY: cp_fm_pool_p_type,&
35 : fm_pool_get_el_struct
36 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
37 : cp_fm_struct_get,&
38 : cp_fm_struct_release,&
39 : cp_fm_struct_type
40 : USE cp_fm_types, ONLY: cp_fm_create,&
41 : cp_fm_release,&
42 : cp_fm_type
43 : USE cp_log_handling, ONLY: cp_to_string
44 : USE kinds, ONLY: dp
45 : USE qs_matrix_pools, ONLY: mpools_get,&
46 : qs_matrix_pools_type
47 : USE qs_mo_types, ONLY: get_mo_set,&
48 : mo_set_type
49 : #include "./base/base_uses.f90"
50 :
51 : IMPLICIT NONE
52 :
53 : PRIVATE
54 :
55 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rt_propagation_types'
56 :
57 : TYPE rtp_rho_type
58 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: new => NULL()
59 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: old => NULL()
60 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: next => NULL()
61 : END TYPE rtp_rho_type
62 :
63 : TYPE rtp_history_type
64 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:, :) :: rho_history => NULL()
65 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: s_history => NULL()
66 : TYPE(cp_fm_type), POINTER, DIMENSION(:, :) :: mo_history => NULL()
67 : END TYPE rtp_history_type
68 :
69 : TYPE rtp_mos_type
70 : TYPE(cp_fm_type), POINTER, DIMENSION(:) :: new => NULL()
71 : TYPE(cp_fm_type), POINTER, DIMENSION(:) :: old => NULL()
72 : TYPE(cp_fm_type), POINTER, DIMENSION(:) :: next => NULL()
73 : TYPE(cp_fm_type), POINTER, DIMENSION(:) :: admm => NULL()
74 : END TYPE rtp_mos_type
75 :
76 : TYPE rt_prop_type
77 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: exp_H_old => NULL()
78 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: exp_H_new => NULL()
79 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: H_last_iter => NULL()
80 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: propagator_matrix => NULL()
81 : TYPE(dbcsr_type), POINTER :: S_inv => NULL()
82 : TYPE(dbcsr_type), POINTER :: S_half => NULL()
83 : TYPE(dbcsr_type), POINTER :: S_minus_half => NULL()
84 : TYPE(dbcsr_type), POINTER :: B_mat => NULL()
85 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: C_mat => NULL()
86 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: S_der => NULL()
87 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: SinvH => NULL()
88 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: SinvH_imag => NULL()
89 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: SinvB => NULL()
90 : ! Matrix of local moments - may not be updated if ions are fixed
91 : TYPE(dbcsr_p_type), POINTER, DIMENSION(:) :: local_moments => NULL()
92 : TYPE(dbcsr_type), POINTER :: local_moments_work => NULL()
93 : TYPE(rtp_rho_type), POINTER :: rho => NULL()
94 : TYPE(rtp_mos_type), POINTER :: mos => NULL()
95 : ! Moment trace, Indices : Spin, direction, time index
96 : COMPLEX(KIND=dp), DIMENSION(:, :, :), POINTER :: moments => NULL()
97 : ! Fields do not have a spin index
98 : COMPLEX(KIND=dp), DIMENSION(:, :), POINTER :: fields => NULL()
99 : REAL(KIND=dp), DIMENSION(:), POINTER :: times => NULL()
100 : REAL(KIND=dp) :: energy_old = 0.0_dp
101 : REAL(KIND=dp) :: energy_new = 0.0_dp
102 : REAL(KIND=dp) :: dt = 0.0_dp
103 : REAL(KIND=dp) :: delta_iter = 0.0_dp
104 : REAL(KIND=dp) :: delta_iter_old = 0.0_dp
105 : REAL(KIND=dp) :: filter_eps = 0.0_dp
106 : REAL(KIND=dp) :: filter_eps_small = 0.0_dp
107 : REAL(KIND=dp) :: mixing_factor = 0.0_dp
108 : LOGICAL :: mixing = .FALSE.
109 : LOGICAL :: do_hfx = .FALSE.
110 : LOGICAL :: propagate_complex_ks = .FALSE.
111 : LOGICAL :: track_imag_density = .FALSE.
112 : INTEGER, DIMENSION(:, :), ALLOCATABLE :: orders
113 : INTEGER :: nsteps = -1
114 : INTEGER :: istep = -1
115 : INTEGER :: i_start = -1
116 : INTEGER :: max_steps = -1
117 : INTEGER :: iter = -1
118 : INTEGER :: narn_old = -1
119 : LOGICAL :: converged = .FALSE.
120 : LOGICAL :: matrix_update = .FALSE.
121 : LOGICAL :: write_restart = .FALSE.
122 : TYPE(rtp_history_type), POINTER :: history => NULL()
123 : TYPE(cp_fm_struct_type), POINTER :: ao_ao_fmstruct => NULL()
124 : INTEGER :: lanzcos_max_iter = -1
125 : REAL(KIND=dp) :: lanzcos_threshold = 0.0_dp
126 : INTEGER :: newton_schulz_order = -1
127 : LOGICAL :: linear_scaling = .FALSE.
128 : END TYPE rt_prop_type
129 :
130 : ! *** Public data types ***
131 :
132 : PUBLIC :: rt_prop_type
133 :
134 : ! *** Public subroutines ***
135 :
136 : PUBLIC :: rt_prop_create, &
137 : rtp_create_SinvH_imag, &
138 : rt_prop_create_mos, &
139 : get_rtp, &
140 : rt_prop_release, &
141 : rt_prop_release_mos, &
142 : rtp_history_create
143 : CONTAINS
144 :
145 : ! **************************************************************************************************
146 : !> \brief ...
147 : !> \param rtp ...
148 : !> \param mos ...
149 : !> \param mpools ...
150 : !> \param dft_control ...
151 : !> \param template ...
152 : !> \param linear_scaling ...
153 : !> \param mos_aux ...
154 : ! **************************************************************************************************
155 198 : SUBROUTINE rt_prop_create(rtp, mos, mpools, dft_control, template, linear_scaling, mos_aux)
156 :
157 : TYPE(rt_prop_type), POINTER :: rtp
158 : TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mos
159 : TYPE(qs_matrix_pools_type), POINTER :: mpools
160 : TYPE(dft_control_type), POINTER :: dft_control
161 : TYPE(dbcsr_type), POINTER :: template
162 : LOGICAL, INTENT(IN) :: linear_scaling
163 : TYPE(mo_set_type), DIMENSION(:), OPTIONAL, POINTER :: mos_aux
164 :
165 : INTEGER :: i, nspin
166 : TYPE(rtp_control_type), POINTER :: rtp_control
167 :
168 198 : CALL cite_reference(Kunert2003)
169 :
170 198 : NULLIFY (rtp_control)
171 :
172 198 : rtp_control => dft_control%rtp_control
173 :
174 198 : nspin = dft_control%nspins
175 :
176 198 : NULLIFY (rtp%mos, rtp%rho)
177 198 : rtp%linear_scaling = linear_scaling
178 :
179 198 : IF (rtp%linear_scaling) THEN
180 90 : ALLOCATE (rtp%rho)
181 90 : NULLIFY (rtp%rho%old)
182 90 : CALL dbcsr_allocate_matrix_set(rtp%rho%old, 2*nspin)
183 90 : NULLIFY (rtp%rho%next)
184 90 : CALL dbcsr_allocate_matrix_set(rtp%rho%next, 2*nspin)
185 90 : NULLIFY (rtp%rho%new)
186 90 : CALL dbcsr_allocate_matrix_set(rtp%rho%new, 2*nspin)
187 346 : DO i = 1, 2*nspin
188 256 : CALL dbcsr_init_p(rtp%rho%old(i)%matrix)
189 256 : CALL dbcsr_create(rtp%rho%old(i)%matrix, template=template, matrix_type="N")
190 256 : CALL dbcsr_init_p(rtp%rho%next(i)%matrix)
191 256 : CALL dbcsr_create(rtp%rho%next(i)%matrix, template=template, matrix_type="N")
192 256 : CALL dbcsr_init_p(rtp%rho%new(i)%matrix)
193 346 : CALL dbcsr_create(rtp%rho%new(i)%matrix, template=template, matrix_type="N")
194 : END DO
195 : ELSE
196 108 : IF (PRESENT(mos_aux)) THEN
197 26 : CALL rt_prop_create_mos(rtp, mos, mpools, dft_control, mos_aux)
198 : ELSE
199 82 : CALL rt_prop_create_mos(rtp, mos, mpools, dft_control)
200 : END IF
201 : END IF
202 :
203 198 : NULLIFY (rtp%exp_H_old)
204 198 : NULLIFY (rtp%exp_H_new)
205 198 : NULLIFY (rtp%H_last_iter)
206 198 : NULLIFY (rtp%propagator_matrix)
207 198 : CALL dbcsr_allocate_matrix_set(rtp%exp_H_old, 2*nspin)
208 198 : CALL dbcsr_allocate_matrix_set(rtp%exp_H_new, 2*nspin)
209 198 : CALL dbcsr_allocate_matrix_set(rtp%H_last_iter, 2*nspin)
210 198 : CALL dbcsr_allocate_matrix_set(rtp%propagator_matrix, 2*nspin)
211 730 : DO i = 1, 2*nspin
212 532 : CALL dbcsr_init_p(rtp%exp_H_old(i)%matrix)
213 532 : CALL dbcsr_create(rtp%exp_H_old(i)%matrix, template=template, matrix_type="N")
214 532 : CALL dbcsr_init_p(rtp%exp_H_new(i)%matrix)
215 532 : CALL dbcsr_create(rtp%exp_H_new(i)%matrix, template=template, matrix_type="N")
216 532 : CALL dbcsr_init_p(rtp%H_last_iter(i)%matrix)
217 532 : CALL dbcsr_create(rtp%H_last_iter(i)%matrix, template=template, matrix_type="N")
218 532 : CALL dbcsr_init_p(rtp%propagator_matrix(i)%matrix)
219 730 : CALL dbcsr_create(rtp%propagator_matrix(i)%matrix, template=template, matrix_type="N")
220 : END DO
221 198 : NULLIFY (rtp%S_inv)
222 198 : ALLOCATE (rtp%S_inv)
223 198 : CALL dbcsr_create(rtp%S_inv, template=template, matrix_type="S")
224 198 : NULLIFY (rtp%S_half)
225 198 : ALLOCATE (rtp%S_half)
226 198 : CALL dbcsr_create(rtp%S_half, template=template, matrix_type="S")
227 198 : NULLIFY (rtp%S_minus_half)
228 198 : ALLOCATE (rtp%S_minus_half)
229 198 : CALL dbcsr_create(rtp%S_minus_half, template=template, matrix_type="S")
230 198 : NULLIFY (rtp%B_mat)
231 198 : NULLIFY (rtp%C_mat)
232 198 : NULLIFY (rtp%S_der)
233 198 : NULLIFY (rtp%SinvH)
234 198 : NULLIFY (rtp%SinvB)
235 198 : IF (.NOT. rtp_control%fixed_ions) THEN
236 72 : ALLOCATE (rtp%B_mat)
237 72 : CALL dbcsr_create(rtp%B_mat, template=template, matrix_type="N")
238 72 : CALL dbcsr_allocate_matrix_set(rtp%C_mat, 3)
239 72 : CALL dbcsr_allocate_matrix_set(rtp%S_der, 9)
240 72 : CALL dbcsr_allocate_matrix_set(rtp%SinvH, nspin)
241 72 : CALL dbcsr_allocate_matrix_set(rtp%SinvB, nspin)
242 156 : DO i = 1, nspin
243 84 : CALL dbcsr_init_p(rtp%SinvH(i)%matrix)
244 84 : CALL dbcsr_create(rtp%SinvH(i)%matrix, template=template, matrix_type="N")
245 84 : CALL dbcsr_init_p(rtp%SinvB(i)%matrix)
246 156 : CALL dbcsr_create(rtp%SinvB(i)%matrix, template=template, matrix_type="N")
247 : END DO
248 288 : DO i = 1, 3
249 216 : CALL dbcsr_init_p(rtp%C_mat(i)%matrix)
250 288 : CALL dbcsr_create(rtp%C_mat(i)%matrix, template=template, matrix_type="N")
251 : END DO
252 720 : DO i = 1, 9
253 648 : CALL dbcsr_init_p(rtp%S_der(i)%matrix)
254 720 : CALL dbcsr_create(rtp%S_der(i)%matrix, template=template, matrix_type="N")
255 : END DO
256 : END IF
257 594 : ALLOCATE (rtp%orders(2, nspin))
258 198 : rtp_control%converged = .FALSE.
259 198 : rtp%matrix_update = .TRUE.
260 198 : rtp%narn_old = 0
261 198 : rtp%istep = 0
262 198 : rtp%iter = 0
263 198 : rtp%do_hfx = .FALSE.
264 198 : rtp%track_imag_density = .FALSE.
265 :
266 198 : END SUBROUTINE rt_prop_create
267 :
268 : ! **************************************************************************************************
269 : !> \brief Initialize SinvH_imag for rtp
270 : !> \param rtp ...
271 : !> \param nspins ...
272 : ! **************************************************************************************************
273 22 : SUBROUTINE rtp_create_SinvH_imag(rtp, nspins)
274 : TYPE(rt_prop_type), INTENT(INOUT) :: rtp
275 : INTEGER :: nspins
276 :
277 : INTEGER :: i
278 :
279 22 : NULLIFY (rtp%SinvH_imag)
280 22 : CALL dbcsr_allocate_matrix_set(rtp%SinvH_imag, nspins)
281 46 : DO i = 1, nspins
282 24 : CALL dbcsr_init_p(rtp%SinvH_imag(i)%matrix)
283 46 : CALL dbcsr_create(rtp%SinvH_imag(i)%matrix, template=rtp%SinvH(1)%matrix, matrix_type="N")
284 : END DO
285 :
286 22 : END SUBROUTINE rtp_create_SinvH_imag
287 :
288 : ! **************************************************************************************************
289 : !> \brief Initialize the mos for rtp
290 : !> \param rtp ...
291 : !> \param mos ...
292 : !> \param mpools ...
293 : !> \param dft_control ...
294 : !> \param mos_aux ...
295 : !> \param init_mos_old ...
296 : !> \param init_mos_new ...
297 : !> \param init_mos_next ...
298 : !> \param init_mos_admn ...
299 : ! **************************************************************************************************
300 148 : SUBROUTINE rt_prop_create_mos(rtp, mos, mpools, dft_control, mos_aux, init_mos_old, &
301 : init_mos_new, init_mos_next, init_mos_admn)
302 : TYPE(rt_prop_type), POINTER :: rtp
303 : TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mos
304 : TYPE(qs_matrix_pools_type), POINTER :: mpools
305 : TYPE(dft_control_type), POINTER :: dft_control
306 : TYPE(mo_set_type), DIMENSION(:), OPTIONAL, POINTER :: mos_aux
307 : LOGICAL, OPTIONAL :: init_mos_old, init_mos_new, &
308 : init_mos_next, init_mos_admn
309 :
310 : INTEGER :: i, j, nao, nrow_block, nspin
311 : LOGICAL :: my_mos_admn, my_mos_new, my_mos_next, &
312 : my_mos_old
313 148 : TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER :: ao_mo_fm_pools
314 : TYPE(cp_fm_struct_type), POINTER :: ao_mo_fmstruct
315 :
316 148 : IF (PRESENT(init_mos_old)) THEN
317 40 : my_mos_old = init_mos_old
318 : ELSE
319 : my_mos_old = .TRUE.
320 : END IF
321 :
322 148 : IF (PRESENT(init_mos_new)) THEN
323 40 : my_mos_new = init_mos_new
324 : ELSE
325 : my_mos_new = .TRUE.
326 : END IF
327 :
328 148 : IF (PRESENT(init_mos_next)) THEN
329 40 : my_mos_next = init_mos_next
330 : ELSE
331 : my_mos_next = .TRUE.
332 : END IF
333 :
334 148 : IF (PRESENT(init_mos_admn)) THEN
335 40 : my_mos_admn = init_mos_admn
336 : ELSE
337 : my_mos_admn = .TRUE.
338 : END IF
339 :
340 148 : nspin = dft_control%nspins
341 148 : CALL mpools_get(mpools, ao_mo_fm_pools=ao_mo_fm_pools)
342 148 : ao_mo_fmstruct => fm_pool_get_el_struct(ao_mo_fm_pools(1)%pool)
343 148 : CALL cp_fm_struct_get(ao_mo_fmstruct, nrow_block=nrow_block)
344 148 : CALL get_mo_set(mos(1), nao=nao)
345 :
346 : CALL cp_fm_struct_create(fmstruct=rtp%ao_ao_fmstruct, &
347 : nrow_block=nrow_block, ncol_block=nrow_block, &
348 : nrow_global=nao, ncol_global=nao, &
349 148 : template_fmstruct=ao_mo_fmstruct)
350 148 : IF (.NOT. (ASSOCIATED(rtp%mos))) ALLOCATE (rtp%mos)
351 852 : IF (my_mos_old) ALLOCATE (rtp%mos%old(2*nspin))
352 852 : IF (my_mos_new) ALLOCATE (rtp%mos%new(2*nspin))
353 640 : IF (my_mos_next) ALLOCATE (rtp%mos%next(2*nspin))
354 148 : NULLIFY (rtp%mos%admm)
355 148 : IF ((dft_control%do_admm) .AND. my_mos_admn) THEN
356 8 : IF (PRESENT(mos_aux)) THEN
357 8 : CPASSERT(ASSOCIATED(mos_aux))
358 : ELSE
359 0 : CPABORT("The optional argument mos_aux is missing which is required with ADMM")
360 : END IF
361 40 : ALLOCATE (rtp%mos%admm(2*nspin))
362 : END IF
363 352 : DO i = 1, nspin
364 760 : DO j = 1, 2
365 408 : IF (my_mos_old) CALL cp_fm_create(rtp%mos%old(2*(i - 1) + j), &
366 : matrix_struct=mos(i)%mo_coeff%matrix_struct, &
367 408 : name="mos_old"//TRIM(ADJUSTL(cp_to_string(2*(i - 1) + j))))
368 408 : IF (my_mos_new) CALL cp_fm_create(rtp%mos%new(2*(i - 1) + j), &
369 : matrix_struct=mos(i)%mo_coeff%matrix_struct, &
370 408 : name="mos_new"//TRIM(ADJUSTL(cp_to_string(2*(i - 1) + j))))
371 408 : IF (my_mos_next) CALL cp_fm_create(rtp%mos%next(2*(i - 1) + j), &
372 : matrix_struct=mos(i)%mo_coeff%matrix_struct, &
373 276 : name="mos_next"//TRIM(ADJUSTL(cp_to_string(2*(i - 1) + j))))
374 612 : IF ((dft_control%do_admm) .AND. my_mos_admn) THEN
375 : CALL cp_fm_create(rtp%mos%admm(2*(i - 1) + j), &
376 : matrix_struct=mos_aux(i)%mo_coeff%matrix_struct, &
377 16 : name="mos_admm"//TRIM(ADJUSTL(cp_to_string(2*(i - 1) + j))))
378 : END IF
379 : END DO
380 : END DO
381 :
382 148 : END SUBROUTINE rt_prop_create_mos
383 :
384 : ! **************************************************************************************************
385 : !> \brief ...
386 : !> \param rtp ...
387 : !> \param exp_H_old ...
388 : !> \param exp_H_new ...
389 : !> \param H_last_iter ...
390 : !> \param rho_old ...
391 : !> \param rho_next ...
392 : !> \param rho_new ...
393 : !> \param mos ...
394 : !> \param mos_new ...
395 : !> \param mos_old ...
396 : !> \param mos_next ...
397 : !> \param S_inv ...
398 : !> \param S_half ...
399 : !> \param S_minus_half ...
400 : !> \param B_mat ...
401 : !> \param C_mat ...
402 : !> \param propagator_matrix ...
403 : !> \param mixing ...
404 : !> \param mixing_factor ...
405 : !> \param S_der ...
406 : !> \param dt ...
407 : !> \param nsteps ...
408 : !> \param SinvH ...
409 : !> \param SinvH_imag ...
410 : !> \param SinvB ...
411 : !> \param admm_mos ...
412 : ! **************************************************************************************************
413 30994 : SUBROUTINE get_rtp(rtp, exp_H_old, exp_H_new, H_last_iter, rho_old, rho_next, rho_new, mos, mos_new, mos_old, mos_next, &
414 : S_inv, S_half, S_minus_half, B_mat, C_mat, propagator_matrix, mixing, mixing_factor, &
415 : S_der, dt, nsteps, SinvH, SinvH_imag, SinvB, admm_mos)
416 :
417 : TYPE(rt_prop_type), INTENT(IN) :: rtp
418 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
419 : POINTER :: exp_H_old, exp_H_new, H_last_iter, &
420 : rho_old, rho_next, rho_new
421 : TYPE(rtp_mos_type), OPTIONAL, POINTER :: mos
422 : TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: mos_new, mos_old, mos_next
423 : TYPE(dbcsr_type), OPTIONAL, POINTER :: S_inv, S_half, S_minus_half, B_mat
424 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
425 : POINTER :: C_mat, propagator_matrix
426 : LOGICAL, OPTIONAL :: mixing
427 : REAL(dp), INTENT(out), OPTIONAL :: mixing_factor
428 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
429 : POINTER :: S_der
430 : REAL(dp), INTENT(out), OPTIONAL :: dt
431 : INTEGER, INTENT(out), OPTIONAL :: nsteps
432 : TYPE(dbcsr_p_type), DIMENSION(:), OPTIONAL, &
433 : POINTER :: SinvH, SinvH_imag, SinvB
434 : TYPE(cp_fm_type), DIMENSION(:), OPTIONAL, POINTER :: admm_mos
435 :
436 30994 : IF (PRESENT(exp_H_old)) exp_H_old => rtp%exp_H_old
437 30994 : IF (PRESENT(exp_H_new)) exp_H_new => rtp%exp_H_new
438 30994 : IF (PRESENT(H_last_iter)) H_last_iter => rtp%H_last_iter
439 30994 : IF (PRESENT(propagator_matrix)) propagator_matrix => rtp%propagator_matrix
440 :
441 30994 : IF (PRESENT(rho_old)) rho_old => rtp%rho%old
442 30994 : IF (PRESENT(rho_next)) rho_next => rtp%rho%next
443 30994 : IF (PRESENT(rho_new)) rho_new => rtp%rho%new
444 30994 : IF (PRESENT(mos)) mos => rtp%mos
445 30994 : IF (PRESENT(mos_old)) mos_old => rtp%mos%old
446 30994 : IF (PRESENT(mos_new)) mos_new => rtp%mos%new
447 30994 : IF (PRESENT(mos_next)) mos_next => rtp%mos%next
448 30994 : IF (PRESENT(admm_mos)) admm_mos => rtp%mos%admm
449 :
450 30994 : IF (PRESENT(S_inv)) S_inv => rtp%S_inv
451 30994 : IF (PRESENT(S_half)) S_half => rtp%S_half
452 30994 : IF (PRESENT(S_minus_half)) S_minus_half => rtp%S_minus_half
453 30994 : IF (PRESENT(B_mat)) B_mat => rtp%B_mat
454 30994 : IF (PRESENT(C_mat)) C_mat => rtp%C_mat
455 30994 : IF (PRESENT(SinvH)) SinvH => rtp%SinvH
456 30994 : IF (PRESENT(SinvH_imag)) SinvH_imag => rtp%SinvH_imag
457 30994 : IF (PRESENT(SinvB)) SinvB => rtp%SinvB
458 30994 : IF (PRESENT(S_der)) S_der => rtp%S_der
459 :
460 30994 : IF (PRESENT(dt)) dt = rtp%dt
461 30994 : IF (PRESENT(mixing)) mixing = rtp%mixing
462 30994 : IF (PRESENT(mixing_factor)) mixing_factor = rtp%mixing_factor
463 30994 : IF (PRESENT(nsteps)) nsteps = rtp%nsteps
464 :
465 30994 : END SUBROUTINE get_rtp
466 :
467 : ! **************************************************************************************************
468 : !> \brief ...
469 : !> \param rtp ...
470 : ! **************************************************************************************************
471 198 : SUBROUTINE rt_prop_release(rtp)
472 : TYPE(rt_prop_type), INTENT(inout) :: rtp
473 :
474 198 : CALL dbcsr_deallocate_matrix_set(rtp%exp_H_old)
475 198 : CALL dbcsr_deallocate_matrix_set(rtp%exp_H_new)
476 198 : CALL dbcsr_deallocate_matrix_set(rtp%H_last_iter)
477 198 : CALL dbcsr_deallocate_matrix_set(rtp%propagator_matrix)
478 198 : IF (ASSOCIATED(rtp%rho)) THEN
479 90 : IF (ASSOCIATED(rtp%rho%old)) &
480 90 : CALL dbcsr_deallocate_matrix_set(rtp%rho%old)
481 90 : IF (ASSOCIATED(rtp%rho%next)) &
482 90 : CALL dbcsr_deallocate_matrix_set(rtp%rho%next)
483 90 : IF (ASSOCIATED(rtp%rho%new)) &
484 90 : CALL dbcsr_deallocate_matrix_set(rtp%rho%new)
485 90 : DEALLOCATE (rtp%rho)
486 : END IF
487 :
488 198 : CALL rt_prop_release_mos(rtp)
489 :
490 198 : CALL dbcsr_deallocate_matrix(rtp%S_inv)
491 198 : CALL dbcsr_deallocate_matrix(rtp%S_half)
492 198 : CALL dbcsr_deallocate_matrix(rtp%S_minus_half)
493 198 : IF (ASSOCIATED(rtp%B_mat)) &
494 72 : CALL dbcsr_deallocate_matrix(rtp%B_mat)
495 198 : IF (ASSOCIATED(rtp%C_mat)) &
496 72 : CALL dbcsr_deallocate_matrix_set(rtp%C_mat)
497 198 : IF (ASSOCIATED(rtp%S_der)) &
498 72 : CALL dbcsr_deallocate_matrix_set(rtp%S_der)
499 198 : IF (ASSOCIATED(rtp%SinvH)) &
500 72 : CALL dbcsr_deallocate_matrix_set(rtp%SinvH)
501 198 : IF (ASSOCIATED(rtp%SinvH_imag)) &
502 22 : CALL dbcsr_deallocate_matrix_set(rtp%SinvH_imag)
503 198 : IF (ASSOCIATED(rtp%SinvB)) &
504 72 : CALL dbcsr_deallocate_matrix_set(rtp%SinvB)
505 198 : IF (ASSOCIATED(rtp%history)) &
506 198 : CALL rtp_history_release(rtp)
507 198 : DEALLOCATE (rtp%orders)
508 198 : END SUBROUTINE rt_prop_release
509 :
510 : ! **************************************************************************************************
511 : !> \brief Deallocated the mos for rtp...
512 : !> \param rtp ...
513 : ! **************************************************************************************************
514 238 : SUBROUTINE rt_prop_release_mos(rtp)
515 : TYPE(rt_prop_type), INTENT(inout) :: rtp
516 :
517 238 : IF (ASSOCIATED(rtp%mos)) THEN
518 148 : IF (ASSOCIATED(rtp%mos%old)) &
519 148 : CALL cp_fm_release(rtp%mos%old)
520 148 : IF (ASSOCIATED(rtp%mos%new)) &
521 148 : CALL cp_fm_release(rtp%mos%new)
522 148 : IF (ASSOCIATED(rtp%mos%next)) &
523 108 : CALL cp_fm_release(rtp%mos%next)
524 148 : IF (ASSOCIATED(rtp%mos%admm)) &
525 8 : CALL cp_fm_release(rtp%mos%admm)
526 148 : CALL cp_fm_struct_release(rtp%ao_ao_fmstruct)
527 148 : DEALLOCATE (rtp%mos)
528 : END IF
529 :
530 238 : END SUBROUTINE rt_prop_release_mos
531 : ! **************************************************************************************************
532 : !> \brief ...
533 : !> \param rtp ...
534 : !> \param aspc_order ...
535 : ! **************************************************************************************************
536 198 : SUBROUTINE rtp_history_create(rtp, aspc_order)
537 : TYPE(rt_prop_type), INTENT(inout) :: rtp
538 : INTEGER, INTENT(in) :: aspc_order
539 :
540 : INTEGER :: i, j, nmat
541 : TYPE(rtp_history_type), POINTER :: history
542 :
543 198 : NULLIFY (history)
544 198 : ALLOCATE (rtp%history)
545 198 : history => rtp%history
546 :
547 : NULLIFY (history%rho_history, history%mo_history, history%s_history)
548 198 : IF (aspc_order > 0) THEN
549 198 : IF (rtp%linear_scaling) THEN
550 90 : nmat = SIZE(rtp%rho%new)
551 90 : CALL dbcsr_allocate_matrix_set(history%rho_history, nmat, aspc_order)
552 346 : DO i = 1, nmat
553 1114 : DO j = 1, aspc_order
554 768 : CALL dbcsr_init_p(history%rho_history(i, j)%matrix)
555 : CALL dbcsr_create(history%rho_history(i, j)%matrix, &
556 : name="rho_hist"//TRIM(ADJUSTL(cp_to_string(i))), &
557 1024 : template=rtp%rho%new(1)%matrix)
558 : END DO
559 : END DO
560 : ELSE
561 108 : nmat = SIZE(rtp%mos%old)
562 1584 : ALLOCATE (history%mo_history(nmat, aspc_order))
563 384 : DO i = 1, nmat
564 1212 : DO j = 1, aspc_order
565 : CALL cp_fm_create(history%mo_history(i, j), &
566 : matrix_struct=rtp%mos%new(i)%matrix_struct, &
567 1104 : name="mo_hist"//TRIM(ADJUSTL(cp_to_string(i))))
568 : END DO
569 : END DO
570 648 : ALLOCATE (history%s_history(aspc_order))
571 432 : DO i = 1, aspc_order
572 432 : NULLIFY (history%s_history(i)%matrix)
573 : END DO
574 : END IF
575 : END IF
576 :
577 198 : END SUBROUTINE rtp_history_create
578 :
579 : ! **************************************************************************************************
580 : !> \brief ...
581 : !> \param rtp ...
582 : ! **************************************************************************************************
583 198 : SUBROUTINE rtp_history_release(rtp)
584 : TYPE(rt_prop_type), INTENT(inout) :: rtp
585 :
586 : INTEGER :: i
587 :
588 198 : IF (ASSOCIATED(rtp%history%rho_history)) THEN
589 90 : CALL dbcsr_deallocate_matrix_set(rtp%history%rho_history)
590 : END IF
591 :
592 198 : CALL cp_fm_release(rtp%history%mo_history)
593 :
594 198 : IF (ASSOCIATED(rtp%history%s_history)) THEN
595 432 : DO i = 1, SIZE(rtp%history%s_history)
596 324 : IF (ASSOCIATED(rtp%history%s_history(i)%matrix)) &
597 316 : CALL dbcsr_deallocate_matrix(rtp%history%s_history(i)%matrix)
598 : END DO
599 108 : DEALLOCATE (rtp%history%s_history)
600 : END IF
601 198 : DEALLOCATE (rtp%history)
602 :
603 198 : END SUBROUTINE rtp_history_release
604 :
605 0 : END MODULE rt_propagation_types
|
