38 dbt_batched_contract_finalize, dbt_batched_contract_init, dbt_contract, dbt_copy, &
39 dbt_copy_matrix_to_tensor, dbt_copy_tensor_to_matrix, dbt_create, dbt_destroy, dbt_filter, &
40 dbt_get_info, dbt_nblks_total, dbt_nd_mp_comm, dbt_pgrid_destroy, dbt_pgrid_type, dbt_type
65#include "./base/base_uses.f90"
71 CHARACTER(len=*),
PARAMETER,
PRIVATE :: moduleN =
'rpa_im_time'
96 TYPE(
dbcsr_p_type),
DIMENSION(:, :, :),
POINTER :: propagator
97 INTEGER,
INTENT(IN) :: ntime
98 TYPE(
dbcsr_type),
INTENT(IN) :: matrix_template
99 INTEGER,
DIMENSION(:, :),
INTENT(IN) :: index_to_cell
101 INTEGER :: icell, isector, jtime, ncell
104 cpassert(
SIZE(index_to_cell, 1) == 3)
105 ncell =
SIZE(index_to_cell, 2)
113 ALLOCATE (propagator(isector, jtime, icell)%matrix)
114 CALL dbcsr_create(matrix=propagator(isector, jtime, icell)%matrix, &
115 template=matrix_template, &
116 matrix_type=dbcsr_type_no_symmetry)
166 t_3c_M, t_3c_O, t_3c_O_compressed, t_3c_O_ind, &
167 starts_array_mc, ends_array_mc, &
168 starts_array_mc_block, ends_array_mc_block, &
169 weights_cos_tf_t_to_w, &
170 tj, tau_tj, e_fermi, eps_filter, &
171 alpha, eps_filter_im_time, Eigenval, nmo, &
172 num_integ_points, cut_memory, unit_nr, &
174 qs_env, do_kpoints_from_Gamma, &
175 index_to_cell_3c, cell_to_index_3c, &
176 has_mat_P_blocks, do_ri_sos_laplace_mp2, &
177 dbcsr_time, dbcsr_nflop)
178 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
INTENT(IN) :: mat_p_omega
180 INTEGER,
INTENT(IN) :: homo
183 INTEGER,
INTENT(IN) :: ispin
184 TYPE(dbt_type),
INTENT(INOUT) :: t_3c_m
185 TYPE(dbt_type),
DIMENSION(:, :),
INTENT(INOUT) :: t_3c_o
187 INTENT(INOUT) :: t_3c_o_compressed
189 INTENT(INOUT) :: t_3c_o_ind
190 INTEGER,
DIMENSION(:),
INTENT(IN) :: starts_array_mc, ends_array_mc, &
191 starts_array_mc_block, &
193 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:, :), &
194 INTENT(IN) :: weights_cos_tf_t_to_w
195 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:), &
197 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: tau_tj
198 REAL(kind=
dp),
INTENT(IN) :: e_fermi, eps_filter, alpha, &
200 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: eigenval
201 INTEGER,
INTENT(IN) :: nmo, num_integ_points, cut_memory, &
206 LOGICAL,
INTENT(IN) :: do_kpoints_from_gamma
207 INTEGER,
ALLOCATABLE,
DIMENSION(:, :),
INTENT(IN) :: index_to_cell_3c
208 INTEGER,
ALLOCATABLE,
DIMENSION(:, :, :), &
209 INTENT(IN) :: cell_to_index_3c
210 LOGICAL,
DIMENSION(:, :, :, :, :),
INTENT(INOUT) :: has_mat_p_blocks
211 LOGICAL,
INTENT(IN) :: do_ri_sos_laplace_mp2
212 REAL(
dp),
INTENT(INOUT) :: dbcsr_time
213 INTEGER(int_8),
INTENT(INOUT) :: dbcsr_nflop
215 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_mat_P_omega'
217 INTEGER :: comm_2d_handle, handle, handle2, handle3, i, i_cell, i_cell_r_1, &
218 i_cell_r_1_minus_s, i_cell_r_1_minus_t, i_cell_r_2, i_cell_r_2_minus_s_minus_t, i_cell_s, &
219 i_cell_t, i_mem, iquad, j, j_mem, jquad, num_3c_repl, num_cells_dm, unit_nr_dbcsr
220 INTEGER(int_8) :: nze, nze_dm_occ, nze_dm_virt, nze_m_occ, &
222 INTEGER(KIND=int_8) :: flops_1_occ, flops_1_virt, flops_2
223 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: dist_1, dist_2, mc_ranges, size_dm, &
225 INTEGER,
DIMENSION(2) :: pdims_2d
226 INTEGER,
DIMENSION(2, 1) :: ibounds_2, jbounds_2
227 INTEGER,
DIMENSION(2, 2) :: ibounds_1, jbounds_1
228 INTEGER,
DIMENSION(3) :: bounds_3c
229 INTEGER,
DIMENSION(:, :),
POINTER :: index_to_cell_dm
230 LOGICAL :: do_gamma_rpa, do_kpoints_cubic_rpa, first_cycle_im_time, first_cycle_omega_loop, &
231 memory_info, r_1_minus_s_needed, r_1_minus_t_needed, r_2_minus_s_minus_t_needed
232 REAL(
dp) :: occ, occ_dm_occ, occ_dm_virt, occ_m_occ, &
233 occ_m_virt, occ_o, t1_flop
234 REAL(kind=
dp) :: omega, omega_old, t1, t2, tau, weight, &
237 TYPE(
dbcsr_p_type),
DIMENSION(:, :, :),
POINTER :: propagator
238 TYPE(dbt_pgrid_type) :: pgrid_2d
239 TYPE(dbt_type) :: t_3c_m_occ, t_3c_m_occ_tmp, t_3c_m_virt, &
240 t_3c_m_virt_tmp, t_dm, t_dm_tmp, t_p, &
242 TYPE(dbt_type),
ALLOCATABLE,
DIMENSION(:) :: t_dm_occ, t_dm_virt
243 TYPE(dbt_type),
ALLOCATABLE,
DIMENSION(:, :) :: t_3c_o_occ, t_3c_o_virt
246 CALL timeset(routinen, handle)
250 memory_info = mp2_env%ri_rpa_im_time%memory_info
251 IF (memory_info)
THEN
252 unit_nr_dbcsr = unit_nr
257 do_kpoints_cubic_rpa = qs_env%mp2_env%ri_rpa_im_time%do_im_time_kpoints
258 do_gamma_rpa = .NOT. do_kpoints_cubic_rpa
259 num_3c_repl = maxval(cell_to_index_3c)
261 first_cycle_im_time = .true.
262 ALLOCATE (t_3c_o_occ(
SIZE(t_3c_o, 1),
SIZE(t_3c_o, 2)), t_3c_o_virt(
SIZE(t_3c_o, 1),
SIZE(t_3c_o, 2)))
263 DO i = 1,
SIZE(t_3c_o, 1)
264 DO j = 1,
SIZE(t_3c_o, 2)
265 CALL dbt_create(t_3c_o(i, j), t_3c_o_occ(i, j))
266 CALL dbt_create(t_3c_o(i, j), t_3c_o_virt(i, j))
270 CALL dbt_create(t_3c_m, t_3c_m_occ, name=
"M occ (RI | AO AO)")
271 CALL dbt_create(t_3c_m, t_3c_m_virt, name=
"M virt (RI | AO AO)")
273 ALLOCATE (mc_ranges(cut_memory + 1))
274 mc_ranges(:cut_memory) = starts_array_mc_block(:)
275 mc_ranges(cut_memory + 1) = ends_array_mc_block(cut_memory) + 1
277 DO jquad = 1, num_integ_points
284 eigenval, e_fermi, eps_filter, memory_info, unit_nr, &
285 jquad, do_kpoints_cubic_rpa, do_kpoints_from_gamma, qs_env, &
286 num_cells_dm, index_to_cell_dm, para_env)
288 ALLOCATE (t_dm_virt(num_cells_dm))
289 ALLOCATE (t_dm_occ(num_cells_dm))
292 CALL comm_2d%set_handle(comm_2d_handle)
294 pgrid_2d = dbt_nd_mp_comm(comm_2d, [1], [2], pdims_2d=pdims_2d)
295 ALLOCATE (size_p(dbt_nblks_total(t_3c_m, 1)))
296 CALL dbt_get_info(t_3c_m, blk_size_1=size_p)
298 ALLOCATE (size_dm(dbt_nblks_total(t_3c_o(1, 1), 3)))
299 CALL dbt_get_info(t_3c_o(1, 1), blk_size_3=size_dm)
300 CALL create_2c_tensor(t_dm, dist_1, dist_2, pgrid_2d, size_dm, size_dm, name=
"D (AO | AO)")
302 DEALLOCATE (dist_1, dist_2)
303 CALL create_2c_tensor(t_p, dist_1, dist_2, pgrid_2d, size_p, size_p, name=
"P (RI | RI)")
305 DEALLOCATE (dist_1, dist_2)
306 CALL dbt_pgrid_destroy(pgrid_2d)
308 DO i_cell = 1, num_cells_dm
309 CALL dbt_create(t_dm, t_dm_virt(i_cell), name=
"D virt (AO | AO)")
312 CALL dbt_copy(t_dm_tmp, t_dm_virt(i_cell), move_data=.true.)
315 CALL dbt_create(t_dm, t_dm_occ(i_cell), name=
"D occ (AO | AO)")
317 CALL dbt_copy(t_dm_tmp, t_dm_occ(i_cell), move_data=.true.)
318 CALL dbt_destroy(t_dm_tmp)
325 CALL dbt_destroy(t_dm)
327 CALL dbt_create(t_3c_o_occ(1, 1), t_3c_m_occ_tmp, name=
"M (RI AO | AO)")
328 CALL dbt_create(t_3c_o_virt(1, 1), t_3c_m_virt_tmp, name=
"M (RI AO | AO)")
330 CALL timeset(routinen//
"_contract", handle2)
335 DO i = 1,
SIZE(t_3c_o_occ, 1)
336 DO j = 1,
SIZE(t_3c_o_occ, 2)
337 CALL dbt_batched_contract_init(t_3c_o_occ(i, j), batch_range_2=mc_ranges, batch_range_3=mc_ranges)
340 DO i = 1,
SIZE(t_3c_o_virt, 1)
341 DO j = 1,
SIZE(t_3c_o_virt, 2)
342 CALL dbt_batched_contract_init(t_3c_o_virt(i, j), batch_range_2=mc_ranges, batch_range_3=mc_ranges)
345 CALL dbt_batched_contract_init(t_3c_m_occ_tmp, batch_range_2=mc_ranges, batch_range_3=mc_ranges)
346 CALL dbt_batched_contract_init(t_3c_m_virt_tmp, batch_range_2=mc_ranges, batch_range_3=mc_ranges)
347 CALL dbt_batched_contract_init(t_3c_m_occ, batch_range_2=mc_ranges, batch_range_3=mc_ranges)
348 CALL dbt_batched_contract_init(t_3c_m_virt, batch_range_2=mc_ranges, batch_range_3=mc_ranges)
350 DO i_cell_t = 1, num_cells_dm/2 + 1
352 IF (.NOT. any(has_mat_p_blocks(i_cell_t, :, :, :, :))) cycle
354 CALL dbt_batched_contract_init(t_p)
356 IF (do_gamma_rpa)
THEN
365 DO j_mem = 1, cut_memory
367 CALL dbt_get_info(t_3c_o_occ(1, 1), nfull_total=bounds_3c)
369 jbounds_1(:, 1) = [1, bounds_3c(1)]
370 jbounds_1(:, 2) = [starts_array_mc(j_mem), ends_array_mc(j_mem)]
372 jbounds_2(:, 1) = [starts_array_mc(j_mem), ends_array_mc(j_mem)]
374 IF (do_gamma_rpa)
CALL dbt_batched_contract_init(t_dm_virt(1))
376 DO i_mem = 1, cut_memory
378 IF (.NOT. any(has_mat_p_blocks(i_cell_t, i_mem, j_mem, :, :))) cycle
380 ibounds_1(:, 1) = [1, bounds_3c(1)]
381 ibounds_1(:, 2) = [starts_array_mc(i_mem), ends_array_mc(i_mem)]
383 ibounds_2(:, 1) = [starts_array_mc(i_mem), ends_array_mc(i_mem)]
385 IF (unit_nr_dbcsr > 0)
WRITE (unit=unit_nr_dbcsr, fmt=
"(T3,A,I3,1X,I3)") &
386 "RPA_LOW_SCALING_INFO| Memory Cut iteration", i_mem, j_mem
388 DO i_cell_r_1 = 1, num_3c_repl
390 DO i_cell_r_2 = 1, num_3c_repl
392 IF (.NOT. has_mat_p_blocks(i_cell_t, i_mem, j_mem, i_cell_r_1, i_cell_r_2)) cycle
394 CALL get_diff_index_3c(i_cell_r_1, i_cell_t, i_cell_r_1_minus_t, &
395 index_to_cell_3c, cell_to_index_3c, index_to_cell_dm, &
396 r_1_minus_t_needed, do_kpoints_cubic_rpa)
398 IF (do_gamma_rpa)
CALL dbt_batched_contract_init(t_dm_occ(1))
399 DO i_cell_s = 1, num_cells_dm
400 CALL get_diff_index_3c(i_cell_r_1, i_cell_s, i_cell_r_1_minus_s, index_to_cell_3c, &
401 cell_to_index_3c, index_to_cell_dm, r_1_minus_s_needed, &
402 do_kpoints_cubic_rpa)
403 IF (r_1_minus_s_needed)
THEN
405 CALL timeset(routinen//
"_calc_M_occ_t", handle3)
407 t_3c_o_ind(i_cell_r_1_minus_s, i_cell_r_2, j_mem)%ind, &
408 t_3c_o_compressed(i_cell_r_1_minus_s, i_cell_r_2, j_mem), &
409 qs_env%mp2_env%ri_rpa_im_time%eps_compress)
411 IF (do_gamma_rpa .AND. i_mem == 1)
THEN
417 CALL dbt_copy(t_3c_o(i_cell_r_1_minus_s, i_cell_r_2), &
418 t_3c_o_occ(i_cell_r_1_minus_s, i_cell_r_2), move_data=.true.)
420 CALL dbt_contract(alpha=1.0_dp, &
421 tensor_1=t_3c_o_occ(i_cell_r_1_minus_s, i_cell_r_2), &
422 tensor_2=t_dm_occ(i_cell_s), &
424 tensor_3=t_3c_m_occ_tmp, &
425 contract_1=[3], notcontract_1=[1, 2], &
426 contract_2=[2], notcontract_2=[1], &
427 map_1=[1, 2], map_2=[3], &
428 bounds_2=jbounds_1, bounds_3=ibounds_2, &
429 filter_eps=eps_filter, unit_nr=unit_nr_dbcsr, &
431 CALL timestop(handle3)
433 dbcsr_nflop = dbcsr_nflop + flops_1_occ
438 IF (do_gamma_rpa)
CALL dbt_batched_contract_finalize(t_dm_occ(1))
443 CALL timeset(routinen//
"_copy_M_occ_t", handle3)
444 CALL dbt_copy(t_3c_m_occ_tmp, t_3c_m_occ, order=[1, 3, 2], move_data=.true.)
445 CALL dbt_filter(t_3c_m_occ, eps_filter)
446 CALL timestop(handle3)
448 IF (do_gamma_rpa)
THEN
450 nze_m_occ = nze_m_occ + nze
451 occ_m_occ = occ_m_occ + occ
454 DO i_cell_s = 1, num_cells_dm
455 CALL get_diff_diff_index_3c(i_cell_r_2, i_cell_s, i_cell_t, i_cell_r_2_minus_s_minus_t, &
456 index_to_cell_3c, cell_to_index_3c, index_to_cell_dm, &
457 r_2_minus_s_minus_t_needed, do_kpoints_cubic_rpa)
459 IF (r_1_minus_t_needed .AND. r_2_minus_s_minus_t_needed)
THEN
461 t_3c_o_ind(i_cell_r_2_minus_s_minus_t, i_cell_r_1_minus_t, i_mem)%ind, &
462 t_3c_o_compressed(i_cell_r_2_minus_s_minus_t, i_cell_r_1_minus_t, i_mem), &
463 qs_env%mp2_env%ri_rpa_im_time%eps_compress)
465 CALL dbt_copy(t_3c_o(i_cell_r_2_minus_s_minus_t, i_cell_r_1_minus_t), &
466 t_3c_o_virt(i_cell_r_2_minus_s_minus_t, i_cell_r_1_minus_t), move_data=.true.)
468 CALL timeset(routinen//
"_calc_M_virt_t", handle3)
469 CALL dbt_contract(alpha=alpha/2.0_dp, &
470 tensor_1=t_3c_o_virt( &
471 i_cell_r_2_minus_s_minus_t, i_cell_r_1_minus_t), &
472 tensor_2=t_dm_virt(i_cell_s), &
474 tensor_3=t_3c_m_virt_tmp, &
475 contract_1=[3], notcontract_1=[1, 2], &
476 contract_2=[2], notcontract_2=[1], &
477 map_1=[1, 2], map_2=[3], &
478 bounds_2=ibounds_1, bounds_3=jbounds_2, &
479 filter_eps=eps_filter, unit_nr=unit_nr_dbcsr, &
481 CALL timestop(handle3)
483 dbcsr_nflop = dbcsr_nflop + flops_1_virt
488 CALL timeset(routinen//
"_copy_M_virt_t", handle3)
489 CALL dbt_copy(t_3c_m_virt_tmp, t_3c_m_virt, move_data=.true.)
490 CALL dbt_filter(t_3c_m_virt, eps_filter)
491 CALL timestop(handle3)
493 IF (do_gamma_rpa)
THEN
495 nze_m_virt = nze_m_virt + nze
496 occ_m_virt = occ_m_virt + occ
501 CALL timeset(routinen//
"_calc_P_t", handle3)
503 CALL dbt_contract(alpha=1.0_dp, tensor_1=t_3c_m_occ, &
504 tensor_2=t_3c_m_virt, &
507 contract_1=[2, 3], notcontract_1=[1], &
508 contract_2=[2, 3], notcontract_2=[1], &
509 map_1=[1], map_2=[2], &
510 filter_eps=eps_filter_im_time/real(cut_memory**2, kind=
dp), &
513 unit_nr=unit_nr_dbcsr)
515 CALL timestop(handle3)
517 first_cycle_im_time = .false.
519 IF (jquad == 1 .AND. flops_2 == 0)
THEN
520 has_mat_p_blocks(i_cell_t, i_mem, j_mem, i_cell_r_1, i_cell_r_2) = .false.
526 IF (do_gamma_rpa)
CALL dbt_batched_contract_finalize(t_dm_virt(1))
529 CALL dbt_batched_contract_finalize(t_p, unit_nr=unit_nr_dbcsr)
531 CALL dbt_create(mat_p_global%matrix, t_p_tmp)
532 CALL dbt_copy(t_p, t_p_tmp, move_data=.true.)
533 CALL dbt_copy_tensor_to_matrix(t_p_tmp, mat_p_global%matrix)
534 CALL dbt_destroy(t_p_tmp)
536 IF (do_ri_sos_laplace_mp2)
THEN
540 CALL dbcsr_add(mat_p_omega(jquad, i_cell_t)%matrix, mat_p_global%matrix, 1.0_dp, 1.0_dp)
542 CALL timeset(routinen//
"_Fourier_transform", handle3)
545 first_cycle_omega_loop = .true.
549 DO iquad = 1, num_integ_points
552 weight = weights_cos_tf_t_to_w(iquad, jquad)
554 IF (first_cycle_omega_loop)
THEN
557 CALL dbcsr_scale(mat_p_global%matrix, cos(omega*tau)*weight)
559 CALL dbcsr_scale(mat_p_global%matrix, cos(omega*tau)/cos(omega_old*tau)*weight/weight_old)
562 CALL dbcsr_add(mat_p_omega(iquad, i_cell_t)%matrix, mat_p_global%matrix, 1.0_dp, 1.0_dp)
564 first_cycle_omega_loop = .false.
571 CALL timestop(handle3)
576 CALL timestop(handle2)
578 CALL dbt_batched_contract_finalize(t_3c_m_occ_tmp)
579 CALL dbt_batched_contract_finalize(t_3c_m_virt_tmp)
580 CALL dbt_batched_contract_finalize(t_3c_m_occ)
581 CALL dbt_batched_contract_finalize(t_3c_m_virt)
583 DO i = 1,
SIZE(t_3c_o_occ, 1)
584 DO j = 1,
SIZE(t_3c_o_occ, 2)
585 CALL dbt_batched_contract_finalize(t_3c_o_occ(i, j))
589 DO i = 1,
SIZE(t_3c_o_virt, 1)
590 DO j = 1,
SIZE(t_3c_o_virt, 2)
591 CALL dbt_batched_contract_finalize(t_3c_o_virt(i, j))
595 CALL dbt_destroy(t_p)
596 DO i_cell = 1, num_cells_dm
597 CALL dbt_destroy(t_dm_virt(i_cell))
598 CALL dbt_destroy(t_dm_occ(i_cell))
601 CALL dbt_destroy(t_3c_m_occ_tmp)
602 CALL dbt_destroy(t_3c_m_virt_tmp)
603 DEALLOCATE (t_dm_virt)
604 DEALLOCATE (t_dm_occ)
609 dbcsr_time = dbcsr_time + t2 - t1_flop
611 IF (unit_nr > 0)
THEN
612 WRITE (unit_nr,
'(/T3,A,1X,I3)') &
613 'RPA_LOW_SCALING_INFO| Info for time point', jquad
614 WRITE (unit_nr,
'(T6,A,T56,F25.1)') &
615 'Execution time (s):', t2 - t1
616 WRITE (unit_nr,
'(T6,A,T63,ES7.1,1X,A1,1X,F7.3,A1)') &
617 'Occupancy of D occ:', real(nze_dm_occ,
dp),
'/', occ_dm_occ*100,
'%'
618 WRITE (unit_nr,
'(T6,A,T63,ES7.1,1X,A1,1X,F7.3,A1)') &
619 'Occupancy of D virt:', real(nze_dm_virt,
dp),
'/', occ_dm_virt*100,
'%'
620 IF (do_gamma_rpa)
THEN
621 WRITE (unit_nr,
'(T6,A,T63,ES7.1,1X,A1,1X,F7.3,A1)') &
622 'Occupancy of 3c ints:', real(nze_o,
dp),
'/', occ_o*100,
'%'
623 WRITE (unit_nr,
'(T6,A,T63,ES7.1,1X,A1,1X,F7.3,A1)') &
624 'Occupancy of M occ:', real(nze_m_occ,
dp),
'/', occ_m_occ*100,
'%'
625 WRITE (unit_nr,
'(T6,A,T63,ES7.1,1X,A1,1X,F7.3,A1)') &
626 'Occupancy of M virt:', real(nze_m_virt,
dp),
'/', occ_m_virt*100,
'%'
634 CALL dbt_destroy(t_3c_m_occ)
635 CALL dbt_destroy(t_3c_m_virt)
637 DO i = 1,
SIZE(t_3c_o, 1)
638 DO j = 1,
SIZE(t_3c_o, 2)
639 CALL dbt_destroy(t_3c_o_occ(i, j))
640 CALL dbt_destroy(t_3c_o_virt(i, j))
646 CALL timestop(handle)
655 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
INTENT(IN) :: mat_p_omega
657 INTEGER :: i_kp, jquad
659 DO jquad = 1,
SIZE(mat_p_omega, 1)
660 DO i_kp = 1,
SIZE(mat_p_omega, 2)
662 CALL dbcsr_set(mat_p_omega(jquad, i_kp)%matrix, 0.0_dp)
694 Eigenval, e_fermi, eps_filter, memory_info, unit_nr, &
695 jquad, do_kpoints_cubic_RPA, do_kpoints_from_Gamma, qs_env, &
696 num_cells_dm, index_to_cell_dm, para_env)
698 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: tau_tj
699 INTEGER,
INTENT(IN) :: num_integ_points, nmo
701 INTEGER,
INTENT(IN) :: homo
703 INTENT(INOUT),
POINTER :: propagator
704 TYPE(
dbcsr_p_type),
DIMENSION(:),
INTENT(IN) :: matrix_s
705 INTEGER,
INTENT(IN) :: ispin
706 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: eigenval
707 REAL(kind=
dp),
INTENT(IN) :: e_fermi, eps_filter
708 LOGICAL,
INTENT(IN) :: memory_info
709 INTEGER,
INTENT(IN) :: unit_nr, jquad
710 LOGICAL,
INTENT(IN) :: do_kpoints_cubic_rpa, &
711 do_kpoints_from_gamma
713 INTEGER,
INTENT(OUT) :: num_cells_dm
714 INTEGER,
DIMENSION(:, :),
POINTER :: index_to_cell_dm
717 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_mat_dm_global'
720 INTEGER,
DIMENSION(3, 1) :: index_to_cell_zero
723 index_to_cell_zero = 0
725 CALL timeset(routinen, handle)
727 IF (memory_info .AND. unit_nr > 0)
WRITE (unit=unit_nr, fmt=
"(T3,A,T75,i6)") &
728 "RPA_LOW_SCALING_INFO| Started with time point: ", jquad
732 IF (do_kpoints_cubic_rpa)
THEN
735 ispin, num_integ_points, jquad, e_fermi, tau, &
736 eps_filter, num_cells_dm, index_to_cell_dm, &
740 ispin, num_integ_points, jquad, e_fermi, tau, &
741 eps_filter, num_cells_dm, index_to_cell_dm, &
744 ELSE IF (do_kpoints_from_gamma)
THEN
747 ispin, num_integ_points, jquad, e_fermi, tau, &
751 ispin, num_integ_points, jquad, e_fermi, tau, &
766 eps_filter, e_fermi, tau, para_env)
778 CALL timestop(handle)
796 eps_filter, e_fermi, tau, para_env)
798 INTENT(INOUT),
POINTER :: propagator
799 INTEGER,
INTENT(IN) :: jquad
801 INTEGER,
INTENT(IN) :: homo
802 REAL(kind=
dp),
DIMENSION(:),
INTENT(IN) :: eigenval
803 INTEGER,
INTENT(IN) :: nmo
804 REAL(kind=
dp),
INTENT(IN) :: eps_filter, e_fermi, tau
807 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_gamma_propagator'
808 REAL(kind=
dp),
PARAMETER :: stabilize_exp = 70.0_dp
810 INTEGER :: handle, i_global, iib, jjb, nao, &
811 ncol_local, nrow_local
812 INTEGER,
DIMENSION(:),
POINTER :: col_indices, row_indices
814 cfm_mo_coeff_virt_scaled, &
815 cfm_scaled_dm_occ_tau, &
816 cfm_scaled_dm_virt_tau
818 fm_scaled_dm_virt_tau
819 TYPE(
dbcsr_type),
POINTER :: mat_occ, mat_virt
821 CALL timeset(routinen, handle)
829 nrow_local=nrow_local, &
830 ncol_local=ncol_local, &
831 row_indices=row_indices, &
832 col_indices=col_indices)
834 CALL cp_cfm_create(cfm_scaled_dm_occ_tau, cfm_mo_coeff%matrix_struct, nrow=nao, ncol=nao)
835 CALL cp_cfm_create(cfm_scaled_dm_virt_tau, cfm_mo_coeff%matrix_struct, nrow=nao, ncol=nao)
836 CALL cp_cfm_create(cfm_mo_coeff_occ_scaled, cfm_mo_coeff%matrix_struct)
837 CALL cp_cfm_create(cfm_mo_coeff_virt_scaled, cfm_mo_coeff%matrix_struct)
839 DO jjb = 1, nrow_local
840 DO iib = 1, ncol_local
841 i_global = col_indices(iib)
842 IF (i_global <= homo .AND. abs(tau*0.5_dp*(eigenval(i_global) - e_fermi)) < stabilize_exp)
THEN
843 cfm_mo_coeff_occ_scaled%local_data(jjb, iib) = &
844 cfm_mo_coeff%local_data(jjb, iib)*exp(tau*0.5_dp*(eigenval(i_global) - e_fermi))
846 cfm_mo_coeff_occ_scaled%local_data(jjb, iib) = (0.0_dp, 0.0_dp)
851 DO jjb = 1, nrow_local
852 DO iib = 1, ncol_local
853 i_global = col_indices(iib)
854 IF (i_global > homo .AND. abs(tau*0.5_dp*(eigenval(i_global) - e_fermi)) < stabilize_exp)
THEN
855 cfm_mo_coeff_virt_scaled%local_data(jjb, iib) = &
856 cfm_mo_coeff%local_data(jjb, iib)*exp(-tau*0.5_dp*(eigenval(i_global) - e_fermi))
858 cfm_mo_coeff_virt_scaled%local_data(jjb, iib) = (0.0_dp, 0.0_dp)
865 CALL parallel_gemm(transa=
"N", transb=
"C", m=nao, n=nao, k=nmo, alpha=(1.0_dp, 0.0_dp), &
866 matrix_a=cfm_mo_coeff_occ_scaled, matrix_b=cfm_mo_coeff_occ_scaled, beta=(0.0_dp, 0.0_dp), &
867 matrix_c=cfm_scaled_dm_occ_tau)
868 CALL parallel_gemm(transa=
"N", transb=
"C", m=nao, n=nao, k=nmo, alpha=(1.0_dp, 0.0_dp), &
869 matrix_a=cfm_mo_coeff_virt_scaled, matrix_b=cfm_mo_coeff_virt_scaled, beta=(0.0_dp, 0.0_dp), &
870 matrix_c=cfm_scaled_dm_virt_tau)
872 CALL cp_fm_create(fm_scaled_dm_occ_tau, cfm_scaled_dm_occ_tau%matrix_struct)
873 CALL cp_fm_create(fm_scaled_dm_virt_tau, cfm_scaled_dm_virt_tau%matrix_struct)
874 CALL cp_cfm_to_fm(cfm_scaled_dm_occ_tau, fm_scaled_dm_occ_tau)
875 CALL cp_cfm_to_fm(cfm_scaled_dm_virt_tau, fm_scaled_dm_virt_tau)
881 CALL copy_fm_to_dbcsr(fm_scaled_dm_virt_tau, mat_virt, keep_sparsity=.false.)
890 CALL timestop(handle)
904 SUBROUTINE build_kpoint_density_matrix_rpa(kpoint, ikpgr, ispin, tau, e_fermi, sector, density)
907 INTEGER,
INTENT(IN) :: ikpgr, ispin
908 REAL(kind=
dp),
INTENT(IN) :: tau, e_fermi
909 INTEGER,
INTENT(IN) :: sector
912 CHARACTER(LEN=*),
PARAMETER :: routinen =
'build_kpoint_density_matrix_rpa'
913 REAL(kind=
dp),
PARAMETER :: stabilize_exp = 70.0_dp
915 INTEGER :: handle, i_mo, nao, nmo, nspin
916 REAL(kind=
dp),
DIMENSION(:),
POINTER :: eigenvalues, exp_scaling, occupation
921 CALL timeset(routinen, handle)
924 cpassert(kpoint%use_real_wfn .EQV. .false.)
926 kp => kpoint%kp_env(ikpgr)%kpoint_env
927 nspin =
SIZE(kp%mos, 2)
928 cpassert(ispin >= 1 .AND. ispin <= nspin)
929 mo_set => kp%mos(1, ispin)
930 mo_set_im => kp%mos(2, ispin)
931 CALL get_mo_set(mo_set, nao=nao, nmo=nmo, eigenvalues=eigenvalues, occupation_numbers=occupation)
937 ALLOCATE (exp_scaling(nmo))
938 CALL cp_cfm_create(cfm_mo_coeff, mo_set%mo_coeff%matrix_struct)
940 CALL cp_fm_to_cfm(msourcer=mo_set%mo_coeff, msourcei=mo_set_im%mo_coeff, &
941 mtarget=cfm_mo_coeff)
948 cmplx(2.0_dp/real(nspin, kind=
dp) - occupation, 0.0_dp, kind=
dp))
956 IF (abs(tau*0.5_dp*(eigenvalues(i_mo) - e_fermi)) < stabilize_exp)
THEN
957 exp_scaling(i_mo) = exp(-abs(tau*(eigenvalues(i_mo) - e_fermi)))
959 exp_scaling(i_mo) = 0.0_dp
964 CALL parallel_gemm(
"N",
"C", nao, nao, nmo, (1.0_dp, 0.0_dp), cfm_mo_coeff, cfm_work, &
965 (0.0_dp, 0.0_dp), density)
969 DEALLOCATE (exp_scaling)
971 CALL timestop(handle)
973 END SUBROUTINE build_kpoint_density_matrix_rpa
989 SUBROUTINE compute_transl_dm(propagator, qs_env, ispin, num_integ_points, jquad, e_fermi, tau, &
990 eps_filter, num_cells_dm, index_to_cell_dm, &
993 INTENT(INOUT),
POINTER :: propagator
995 INTEGER,
INTENT(IN) :: ispin, num_integ_points, jquad
996 REAL(kind=
dp),
INTENT(IN) :: e_fermi, tau, eps_filter
997 INTEGER,
INTENT(OUT) :: num_cells_dm
998 INTEGER,
DIMENSION(:, :),
POINTER :: index_to_cell_dm
999 INTEGER,
INTENT(IN) :: sector
1001 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_transl_dm'
1003 INTEGER :: handle, i_dim, i_img, nao
1004 INTEGER,
DIMENSION(3) :: cell_grid_dm
1007 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: mat_dm_global_work
1008 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_s_kp
1011 CALL timeset(routinen, handle)
1014 matrix_s_kp=matrix_s_kp, &
1021 cell_grid_dm(i_dim) = (kpoints%nkp_grid(i_dim)/2)*2 - 1
1024 num_cells_dm = cell_grid_dm(1)*cell_grid_dm(2)*cell_grid_dm(3)
1026 NULLIFY (mat_dm_global_work)
1030 DO i_img = 1, num_cells_dm
1032 ALLOCATE (mat_dm_global_work(i_img)%matrix)
1033 CALL dbcsr_create(matrix=mat_dm_global_work(i_img)%matrix, &
1034 template=matrix_s_kp(1, 1)%matrix, &
1036 matrix_type=dbcsr_type_no_symmetry)
1043 CALL get_mo_set(kpoints%kp_env(1)%kpoint_env%mos(1, 1), nao=nao)
1044 CALL cp_cfm_create(cfm_density, kpoints%kp_env(1)%kpoint_env%mos(1, 1)%mo_coeff%matrix_struct, &
1048 CALL init_cell_index_rpa(cell_grid_dm, kpoints%cell_to_index, kpoints%index_to_cell, cell)
1052 CALL density_matrix_from_kp_to_transl(kpoints, cfm_density, mat_dm_global_work, kpoints%index_to_cell, &
1053 ispin, tau, e_fermi, sector)
1058 index_to_cell_dm => kpoints%index_to_cell
1061 IF (.NOT.
ASSOCIATED(propagator))
THEN
1063 kpoints%index_to_cell)
1066 DO i_img = 1, num_cells_dm
1069 CALL dbcsr_filter(mat_dm_global_work(i_img)%matrix, eps_filter)
1071 CALL dbcsr_copy(propagator(sector, jquad, i_img)%matrix, &
1072 mat_dm_global_work(i_img)%matrix)
1078 CALL timestop(handle)
1096 INTENT(INOUT),
POINTER :: propagator
1098 INTEGER,
INTENT(IN) :: ispin, num_integ_points, jquad
1099 REAL(kind=
dp),
INTENT(IN) :: e_fermi, tau
1100 INTEGER,
INTENT(IN) :: sector
1102 CHARACTER(LEN=*),
PARAMETER :: routinen =
'compute_periodic_dm'
1104 INTEGER :: handle, nao, num_cells_dm
1105 INTEGER,
DIMENSION(3, 1) :: index_to_cell_zero
1107 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: mat_dm_global_work
1108 TYPE(
dbcsr_p_type),
DIMENSION(:, :),
POINTER :: matrix_s_kp
1111 CALL timeset(routinen, handle)
1113 NULLIFY (matrix_s_kp)
1116 matrix_s_kp=matrix_s_kp)
1118 kpoints_g => qs_env%mp2_env%ri_rpa_im_time%kpoints_G
1121 index_to_cell_zero = 0
1123 NULLIFY (mat_dm_global_work)
1128 IF (.NOT.
ASSOCIATED(propagator))
THEN
1133 ALLOCATE (mat_dm_global_work(1)%matrix)
1134 CALL dbcsr_create(matrix=mat_dm_global_work(1)%matrix, &
1135 template=matrix_s_kp(1, 1)%matrix, &
1136 matrix_type=dbcsr_type_no_symmetry)
1140 CALL dbcsr_set(mat_dm_global_work(1)%matrix, 0.0_dp)
1143 CALL get_mo_set(kpoints_g%kp_env(1)%kpoint_env%mos(1, 1), nao=nao)
1144 CALL cp_cfm_create(cfm_density, kpoints_g%kp_env(1)%kpoint_env%mos(1, 1)%mo_coeff%matrix_struct, &
1147 CALL density_matrix_from_kp_to_mic(kpoints_g, cfm_density, mat_dm_global_work, qs_env, ispin, tau, e_fermi, sector)
1151 CALL dbcsr_copy(propagator(sector, jquad, 1)%matrix, &
1152 mat_dm_global_work(1)%matrix)
1156 CALL timestop(handle)
1171 SUBROUTINE density_matrix_from_kp_to_mic(kpoints_G, density, mat_dm_global_work, qs_env, ispin, tau, e_fermi, sector)
1175 TYPE(
dbcsr_p_type),
DIMENSION(:),
POINTER :: mat_dm_global_work
1177 INTEGER,
INTENT(IN) :: ispin
1178 REAL(kind=
dp),
INTENT(IN) :: tau, e_fermi
1179 INTEGER,
INTENT(IN) :: sector
1181 CHARACTER(LEN=*),
PARAMETER :: routinen =
'density_matrix_from_kp_to_mic'
1183 COMPLEX(KIND=dp),
CONTIGUOUS,
DIMENSION(:, :), &
1185 INTEGER :: handle, iatom, iatom_old, ik, ik_global, &
1186 ik_old, irow, jatom, jatom_old, jcol, &
1187 nao, ncol_local, nrow_local, num_cells
1188 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: atom_from_ao_index
1189 INTEGER,
DIMENSION(:),
POINTER :: col_indices, row_indices
1190 INTEGER,
DIMENSION(:, :),
POINTER :: index_to_cell
1191 REAL(kind=
dp) :: contribution, weight_im, weight_re
1192 REAL(kind=
dp),
DIMENSION(3, 3) :: hmat
1193 REAL(kind=
dp),
DIMENSION(:),
POINTER :: wkp
1194 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: xkp
1200 CALL timeset(routinen, handle)
1205 index_to_cell => kpoints_g%index_to_cell
1206 num_cells =
SIZE(index_to_cell, 2)
1208 CALL cp_cfm_get_info(density, nrow_global=nao, nrow_local=nrow_local, ncol_local=ncol_local, &
1209 row_indices=row_indices, col_indices=col_indices)
1210 CALL cp_fm_create(fm_mat_work, density%matrix_struct, set_zero=.true.)
1212 ALLOCATE (atom_from_ao_index(nao))
1216 NULLIFY (cell, particle_set)
1217 CALL get_qs_env(qs_env, cell=cell, particle_set=particle_set)
1224 CALL dbcsr_set(mat_dm_global_work(1)%matrix, 0.0_dp)
1226 DO ik = 1,
SIZE(kpoints_g%kp_env)
1228 kp => kpoints_g%kp_env(ik)%kpoint_env
1229 ik_global = kp%nkpoint
1230 CALL build_kpoint_density_matrix_rpa(kpoints_g, ik, ispin, tau, e_fermi, sector, density)
1233 DO irow = 1, nrow_local
1234 DO jcol = 1, ncol_local
1236 iatom = atom_from_ao_index(row_indices(irow))
1237 jatom = atom_from_ao_index(col_indices(jcol))
1239 IF (ik_global /= ik_old .OR. iatom /= iatom_old .OR. jatom /= jatom_old)
THEN
1242 num_cells, iatom, jatom, xkp(1:3, ik_global), wkp(ik_global), &
1243 cell, index_to_cell, hmat, particle_set)
1251 contribution = real(cmplx(weight_re, -weight_im, kind=
dp)*cfm_data(irow, jcol), kind=
dp)
1253 fm_mat_work%local_data(irow, jcol) = fm_mat_work%local_data(irow, jcol) + contribution
1260 CALL copy_fm_to_dbcsr(fm_mat_work, mat_dm_global_work(1)%matrix, keep_sparsity=.false.)
1265 DEALLOCATE (atom_from_ao_index)
1267 CALL timestop(handle)
1269 END SUBROUTINE density_matrix_from_kp_to_mic
1282 SUBROUTINE density_matrix_from_kp_to_transl(kpoints, density, mat_dm_global_work, index_to_cell, &
1283 ispin, tau, e_fermi, sector)
1287 TYPE(
dbcsr_p_type),
DIMENSION(:),
INTENT(IN) :: mat_dm_global_work
1288 INTEGER,
DIMENSION(:, :),
INTENT(IN) :: index_to_cell
1289 INTEGER,
INTENT(IN) :: ispin
1290 REAL(kind=
dp),
INTENT(IN) :: tau, e_fermi
1291 INTEGER,
INTENT(IN) :: sector
1293 CHARACTER(LEN=*),
PARAMETER :: routinen =
'density_matrix_from_kp_to_transl'
1295 INTEGER :: handle, icell, ik, ik_global, xcell, &
1297 REAL(kind=
dp) :: arg, coskl, sinkl
1298 REAL(kind=
dp),
DIMENSION(:),
POINTER :: wkp
1299 REAL(kind=
dp),
DIMENSION(:, :),
POINTER :: xkp
1301 TYPE(
dbcsr_type),
POINTER :: mat_work_im, mat_work_re
1304 CALL timeset(routinen, handle)
1308 NULLIFY (mat_work_re)
1311 template=mat_dm_global_work(1)%matrix, &
1312 matrix_type=dbcsr_type_no_symmetry)
1314 NULLIFY (mat_work_im)
1317 template=mat_dm_global_work(1)%matrix, &
1318 matrix_type=dbcsr_type_no_symmetry)
1325 cpassert(
SIZE(mat_dm_global_work) ==
SIZE(index_to_cell, 2))
1327 DO icell = 1,
SIZE(mat_dm_global_work)
1329 CALL dbcsr_set(mat_dm_global_work(icell)%matrix, 0.0_dp)
1333 DO ik = 1,
SIZE(kpoints%kp_env)
1335 kp => kpoints%kp_env(ik)%kpoint_env
1336 ik_global = kp%nkpoint
1337 CALL build_kpoint_density_matrix_rpa(kpoints, ik, ispin, tau, e_fermi, sector, density)
1343 DO icell = 1,
SIZE(mat_dm_global_work)
1345 xcell = index_to_cell(1, icell)
1346 ycell = index_to_cell(2, icell)
1347 zcell = index_to_cell(3, icell)
1349 arg = real(xcell,
dp)*xkp(1, ik_global) + real(ycell,
dp)*xkp(2, ik_global) + &
1350 REAL(zcell,
dp)*xkp(3, ik_global)
1351 coskl = wkp(ik_global)*cos(
twopi*arg)
1352 sinkl = wkp(ik_global)*sin(
twopi*arg)
1354 CALL dbcsr_add(mat_dm_global_work(icell)%matrix, mat_work_re, 1.0_dp, coskl)
1356 CALL dbcsr_add(mat_dm_global_work(icell)%matrix, mat_work_im, 1.0_dp, -sinkl)
1367 CALL timestop(handle)
1369 END SUBROUTINE density_matrix_from_kp_to_transl
1379 INTEGER,
DIMENSION(3),
INTENT(IN) :: cell_grid
1380 INTEGER,
DIMENSION(:, :, :),
POINTER :: cell_to_index
1381 INTEGER,
DIMENSION(:, :),
POINTER :: index_to_cell
1382 TYPE(
cell_type),
INTENT(IN),
POINTER :: cell
1384 CHARACTER(LEN=*),
PARAMETER :: routinen =
'init_cell_index_rpa'
1386 INTEGER :: cell_counter, handle, i_cell, &
1387 index_min_dist, num_cells, xcell, &
1389 INTEGER,
DIMENSION(3) :: itm
1390 INTEGER,
DIMENSION(:, :),
POINTER :: index_to_cell_unsorted
1391 INTEGER,
DIMENSION(:, :, :),
POINTER :: cell_to_index_unsorted
1392 REAL(kind=
dp),
ALLOCATABLE,
DIMENSION(:) :: abs_cell_vectors
1393 REAL(kind=
dp),
DIMENSION(3) :: cell_vector
1394 REAL(kind=
dp),
DIMENSION(3, 3) :: hmat
1396 CALL timeset(routinen, handle)
1400 num_cells = cell_grid(1)*cell_grid(2)*cell_grid(3)
1401 itm(:) = cell_grid(:)/2
1405 cpassert(cell_grid(1) /= itm(1)*2)
1406 cpassert(cell_grid(2) /= itm(2)*2)
1407 cpassert(cell_grid(3) /= itm(3)*2)
1409 IF (
ASSOCIATED(cell_to_index))
DEALLOCATE (cell_to_index)
1410 IF (
ASSOCIATED(index_to_cell))
DEALLOCATE (index_to_cell)
1412 ALLOCATE (cell_to_index_unsorted(-itm(1):itm(1), -itm(2):itm(2), -itm(3):itm(3)))
1413 cell_to_index_unsorted(:, :, :) = 0
1415 ALLOCATE (index_to_cell_unsorted(3, num_cells))
1416 index_to_cell_unsorted(:, :) = 0
1418 ALLOCATE (cell_to_index(-itm(1):itm(1), -itm(2):itm(2), -itm(3):itm(3)))
1419 cell_to_index(:, :, :) = 0
1421 ALLOCATE (index_to_cell(3, num_cells))
1422 index_to_cell(:, :) = 0
1424 ALLOCATE (abs_cell_vectors(1:num_cells))
1428 DO xcell = -itm(1), itm(1)
1429 DO ycell = -itm(2), itm(2)
1430 DO zcell = -itm(3), itm(3)
1432 cell_counter = cell_counter + 1
1433 cell_to_index_unsorted(xcell, ycell, zcell) = cell_counter
1435 index_to_cell_unsorted(1, cell_counter) = xcell
1436 index_to_cell_unsorted(2, cell_counter) = ycell
1437 index_to_cell_unsorted(3, cell_counter) = zcell
1439 cell_vector(1:3) = matmul(hmat, real(index_to_cell_unsorted(1:3, cell_counter),
dp))
1441 abs_cell_vectors(cell_counter) = sqrt(cell_vector(1)**2 + cell_vector(2)**2 + cell_vector(3)**2)
1449 DO i_cell = 1, num_cells/2 + 1
1451 index_min_dist = minloc(abs_cell_vectors(1:num_cells/2 + 1), dim=1)
1453 xcell = index_to_cell_unsorted(1, index_min_dist)
1454 ycell = index_to_cell_unsorted(2, index_min_dist)
1455 zcell = index_to_cell_unsorted(3, index_min_dist)
1457 index_to_cell(1, i_cell) = xcell
1458 index_to_cell(2, i_cell) = ycell
1459 index_to_cell(3, i_cell) = zcell
1461 cell_to_index(xcell, ycell, zcell) = i_cell
1463 abs_cell_vectors(index_min_dist) = 10000000000.0_dp
1468 DO i_cell = num_cells/2 + 2, num_cells
1470 index_min_dist = minloc(abs_cell_vectors(1:num_cells), dim=1)
1472 xcell = index_to_cell_unsorted(1, index_min_dist)
1473 ycell = index_to_cell_unsorted(2, index_min_dist)
1474 zcell = index_to_cell_unsorted(3, index_min_dist)
1476 index_to_cell(1, i_cell) = xcell
1477 index_to_cell(2, i_cell) = ycell
1478 index_to_cell(3, i_cell) = zcell
1480 cell_to_index(xcell, ycell, zcell) = i_cell
1482 abs_cell_vectors(index_min_dist) = 10000000000.0_dp
1486 DEALLOCATE (index_to_cell_unsorted, cell_to_index_unsorted, abs_cell_vectors)
1488 CALL timestop(handle)
1503 SUBROUTINE get_diff_index_3c(i_cell_R, i_cell_S, i_cell_R_minus_S, index_to_cell_3c, &
1504 cell_to_index_3c, index_to_cell_dm, R_minus_S_needed, &
1505 do_kpoints_cubic_RPA)
1507 INTEGER,
INTENT(IN) :: i_cell_r, i_cell_s
1508 INTEGER,
INTENT(OUT) :: i_cell_r_minus_s
1509 INTEGER,
ALLOCATABLE,
DIMENSION(:, :),
INTENT(IN) :: index_to_cell_3c
1510 INTEGER,
ALLOCATABLE,
DIMENSION(:, :, :), &
1511 INTENT(IN) :: cell_to_index_3c
1512 INTEGER,
DIMENSION(:, :),
INTENT(IN),
POINTER :: index_to_cell_dm
1513 LOGICAL,
INTENT(OUT) :: r_minus_s_needed
1514 LOGICAL,
INTENT(IN) :: do_kpoints_cubic_rpa
1516 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_diff_index_3c'
1518 INTEGER :: handle, x_cell_r, x_cell_r_minus_s, x_cell_s, y_cell_r, y_cell_r_minus_s, &
1519 y_cell_s, z_cell_r, z_cell_r_minus_s, z_cell_s
1521 CALL timeset(routinen, handle)
1523 IF (do_kpoints_cubic_rpa)
THEN
1525 x_cell_r = index_to_cell_3c(1, i_cell_r)
1526 y_cell_r = index_to_cell_3c(2, i_cell_r)
1527 z_cell_r = index_to_cell_3c(3, i_cell_r)
1529 x_cell_s = index_to_cell_dm(1, i_cell_s)
1530 y_cell_s = index_to_cell_dm(2, i_cell_s)
1531 z_cell_s = index_to_cell_dm(3, i_cell_s)
1533 x_cell_r_minus_s = x_cell_r - x_cell_s
1534 y_cell_r_minus_s = y_cell_r - y_cell_s
1535 z_cell_r_minus_s = z_cell_r - z_cell_s
1537 IF (x_cell_r_minus_s >= lbound(cell_to_index_3c, 1) .AND. &
1538 x_cell_r_minus_s <= ubound(cell_to_index_3c, 1) .AND. &
1539 y_cell_r_minus_s >= lbound(cell_to_index_3c, 2) .AND. &
1540 y_cell_r_minus_s <= ubound(cell_to_index_3c, 2) .AND. &
1541 z_cell_r_minus_s >= lbound(cell_to_index_3c, 3) .AND. &
1542 z_cell_r_minus_s <= ubound(cell_to_index_3c, 3))
THEN
1544 i_cell_r_minus_s = cell_to_index_3c(x_cell_r_minus_s, y_cell_r_minus_s, z_cell_r_minus_s)
1547 IF (i_cell_r_minus_s == 0)
THEN
1549 r_minus_s_needed = .false.
1550 i_cell_r_minus_s = 0
1554 r_minus_s_needed = .true.
1560 i_cell_r_minus_s = 0
1561 r_minus_s_needed = .false.
1567 r_minus_s_needed = .true.
1568 i_cell_r_minus_s = 1
1572 CALL timestop(handle)
1574 END SUBROUTINE get_diff_index_3c
1588 SUBROUTINE get_diff_diff_index_3c(i_cell_R, i_cell_S, i_cell_T, i_cell_R_minus_S_minus_T, &
1589 index_to_cell_3c, cell_to_index_3c, index_to_cell_dm, &
1590 R_minus_S_minus_T_needed, &
1591 do_kpoints_cubic_RPA)
1593 INTEGER,
INTENT(IN) :: i_cell_r, i_cell_s, i_cell_t
1594 INTEGER,
INTENT(OUT) :: i_cell_r_minus_s_minus_t
1595 INTEGER,
DIMENSION(:, :),
INTENT(IN) :: index_to_cell_3c
1596 INTEGER,
ALLOCATABLE,
DIMENSION(:, :, :), &
1597 INTENT(IN) :: cell_to_index_3c
1598 INTEGER,
DIMENSION(:, :),
INTENT(IN) :: index_to_cell_dm
1599 LOGICAL,
INTENT(OUT) :: r_minus_s_minus_t_needed
1600 LOGICAL,
INTENT(IN) :: do_kpoints_cubic_rpa
1602 CHARACTER(LEN=*),
PARAMETER :: routinen =
'get_diff_diff_index_3c'
1604 INTEGER :: handle, x_cell_r, x_cell_r_minus_s_minus_t, x_cell_s, x_cell_t, y_cell_r, &
1605 y_cell_r_minus_s_minus_t, y_cell_s, y_cell_t, z_cell_r, z_cell_r_minus_s_minus_t, &
1608 CALL timeset(routinen, handle)
1610 IF (do_kpoints_cubic_rpa)
THEN
1612 x_cell_r = index_to_cell_3c(1, i_cell_r)
1613 y_cell_r = index_to_cell_3c(2, i_cell_r)
1614 z_cell_r = index_to_cell_3c(3, i_cell_r)
1616 x_cell_s = index_to_cell_dm(1, i_cell_s)
1617 y_cell_s = index_to_cell_dm(2, i_cell_s)
1618 z_cell_s = index_to_cell_dm(3, i_cell_s)
1620 x_cell_t = index_to_cell_dm(1, i_cell_t)
1621 y_cell_t = index_to_cell_dm(2, i_cell_t)
1622 z_cell_t = index_to_cell_dm(3, i_cell_t)
1624 x_cell_r_minus_s_minus_t = x_cell_r - x_cell_s - x_cell_t
1625 y_cell_r_minus_s_minus_t = y_cell_r - y_cell_s - y_cell_t
1626 z_cell_r_minus_s_minus_t = z_cell_r - z_cell_s - z_cell_t
1628 IF (x_cell_r_minus_s_minus_t >= lbound(cell_to_index_3c, 1) .AND. &
1629 x_cell_r_minus_s_minus_t <= ubound(cell_to_index_3c, 1) .AND. &
1630 y_cell_r_minus_s_minus_t >= lbound(cell_to_index_3c, 2) .AND. &
1631 y_cell_r_minus_s_minus_t <= ubound(cell_to_index_3c, 2) .AND. &
1632 z_cell_r_minus_s_minus_t >= lbound(cell_to_index_3c, 3) .AND. &
1633 z_cell_r_minus_s_minus_t <= ubound(cell_to_index_3c, 3))
THEN
1635 i_cell_r_minus_s_minus_t = cell_to_index_3c(x_cell_r_minus_s_minus_t, &
1636 y_cell_r_minus_s_minus_t, &
1637 z_cell_r_minus_s_minus_t)
1640 IF (i_cell_r_minus_s_minus_t == 0)
THEN
1642 r_minus_s_minus_t_needed = .false.
1646 r_minus_s_minus_t_needed = .true.
1652 i_cell_r_minus_s_minus_t = 0
1653 r_minus_s_minus_t_needed = .false.
1660 r_minus_s_minus_t_needed = .true.
1661 i_cell_r_minus_s_minus_t = 1
1665 CALL timestop(handle)
1667 END SUBROUTINE get_diff_diff_index_3c
Handles all functions related to the CELL.
subroutine, public get_cell(cell, alpha, beta, gamma, deth, orthorhombic, abc, periodic, h, h_inv, symmetry_id, tag)
Get informations about a simulation cell.
Basic linear algebra operations for complex full matrices.
subroutine, public cp_cfm_column_scale(matrix_a, scaling)
Scales columns of the full matrix by corresponding factors.
Represents a complex full matrix distributed on many processors.
subroutine, public cp_cfm_release(matrix)
Releases a full matrix.
subroutine, public cp_fm_to_cfm(msourcer, msourcei, mtarget)
Construct a complex full matrix by taking its real and imaginary parts from two separate real-value f...
subroutine, public cp_cfm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
Creates a new full matrix with the given structure.
subroutine, public cp_cfm_get_info(matrix, name, nrow_global, ncol_global, nrow_block, ncol_block, nrow_local, ncol_local, row_indices, col_indices, local_data, context, matrix_struct, para_env)
Returns information about a full matrix.
subroutine, public cp_cfm_to_fm(msource, mtargetr, mtargeti)
Copy real and imaginary parts of a complex full matrix into separate real-value full matrices.
subroutine, public dbcsr_release_p(matrix)
...
subroutine, public dbcsr_scale(matrix, alpha_scalar)
...
subroutine, public dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, keep_imaginary)
...
subroutine, public dbcsr_get_info(matrix, nblkrows_total, nblkcols_total, nfullrows_total, nfullcols_total, nblkrows_local, nblkcols_local, nfullrows_local, nfullcols_local, my_prow, my_pcol, local_rows, local_cols, proc_row_dist, proc_col_dist, row_blk_size, col_blk_size, row_blk_offset, col_blk_offset, distribution, name, matrix_type, group)
...
subroutine, public dbcsr_init_p(matrix)
...
subroutine, public dbcsr_filter(matrix, eps)
...
subroutine, public dbcsr_set(matrix, alpha)
...
subroutine, public dbcsr_clear(matrix)
...
subroutine, public dbcsr_add(matrix_a, matrix_b, alpha_scalar, beta_scalar)
...
subroutine, public dbcsr_distribution_get(dist, row_dist, col_dist, nrows, ncols, has_threads, group, mynode, numnodes, nprows, npcols, myprow, mypcol, pgrid, subgroups_defined, prow_group, pcol_group)
...
subroutine, public dbcsr_reserve_all_blocks(matrix)
Reserves all blocks.
DBCSR operations in CP2K.
subroutine, public copy_fm_to_dbcsr(fm, matrix, keep_sparsity)
Copy a BLACS matrix to a dbcsr matrix.
represent a full matrix distributed on many processors
subroutine, public cp_fm_set_all(matrix, alpha, beta)
set all elements of a matrix to the same value, and optionally the diagonal to a different one
subroutine, public cp_fm_create(matrix, matrix_struct, name, nrow, ncol, set_zero)
creates a new full matrix with the given structure
This is the start of a dbt_api, all publically needed functions are exported here....
Types and set/get functions for HFX.
Defines the basic variable types.
integer, parameter, public int_8
integer, parameter, public dp
Types and basic routines needed for a kpoint calculation.
subroutine, public get_kpoint_info(kpoint, kp_scheme, nkp_grid, kp_shift, symmetry, verbose, full_grid, use_real_wfn, eps_geo, parallel_group_size, kp_range, nkp, xkp, wkp, para_env, blacs_env_all, para_env_kp, para_env_inter_kp, blacs_env, kp_env, kp_aux_env, mpools, iogrp, nkp_groups, kp_dist, cell_to_index, index_to_cell, sab_nl, sab_nl_nosym, inversion_symmetry_only, symmetry_backend, symmetry_reduction_method, gamma_centered, lattice_fft)
Retrieve information from a kpoint environment.
Machine interface based on Fortran 2003 and POSIX.
subroutine, public m_flush(lunit)
flushes units if the &GLOBAL flag is set accordingly
real(kind=dp) function, public m_walltime()
returns time from a real-time clock, protected against rolling early/easily
Definition of mathematical constants and functions.
real(kind=dp), parameter, public twopi
Interface to the message passing library MPI.
Types needed for MP2 calculations.
basic linear algebra operations for full matrixes
Define the data structure for the particle information.
subroutine, public get_qs_env(qs_env, atomic_kind_set, qs_kind_set, cell, super_cell, cell_ref, use_ref_cell, kpoints, dft_control, mos, sab_orb, sab_all, qmmm, qmmm_periodic, mimic, sac_ae, sac_ppl, sac_lri, sap_ppnl, sab_vdw, sab_scp, sap_oce, sab_lrc, sab_se, sab_xtbe, sab_tbe, sab_core, sab_xb, sab_xtb_pp, sab_xtb_nonbond, sab_almo, sab_kp, sab_kp_nosym, sab_cneo, particle_set, energy, force, matrix_h, matrix_h_im, matrix_ks, matrix_ks_im, matrix_vxc, run_rtp, rtp, matrix_h_kp, matrix_h_im_kp, matrix_ks_kp, matrix_ks_im_kp, matrix_vxc_kp, kinetic_kp, matrix_s_kp, matrix_w_kp, matrix_s_ri_aux_kp, matrix_s, matrix_s_ri_aux, matrix_w, matrix_p_mp2, matrix_p_mp2_admm, matrix_vhxc, rho, rho_xc, pw_env, ewald_env, ewald_pw, active_space, mpools, input, para_env, blacs_env, scf_control, rel_control, kinetic, qs_charges, vppl, xcint_weights, rho_core, rho_nlcc, rho_nlcc_g, ks_env, ks_qmmm_env, wf_history, scf_env, local_particles, local_molecules, distribution_2d, dbcsr_dist, molecule_kind_set, molecule_set, subsys, cp_subsys, oce, local_rho_set, rho_atom_set, task_list, task_list_soft, rho0_atom_set, rho0_mpole, rhoz_set, rhoz_cneo_set, ecoul_1c, rho0_s_rs, rho0_s_gs, rhoz_cneo_s_rs, rhoz_cneo_s_gs, do_kpoints, has_unit_metric, requires_mo_derivs, mo_derivs, mo_loc_history, nkind, natom, nelectron_total, nelectron_spin, efield, neighbor_list_id, linres_control, xas_env, virial, cp_ddapc_env, cp_ddapc_ewald, outer_scf_history, outer_scf_ihistory, x_data, et_coupling, dftb_potential, results, se_taper, se_store_int_env, se_nddo_mpole, se_nonbond_env, admm_env, lri_env, lri_density, exstate_env, ec_env, harris_env, dispersion_env, gcp_env, vee, rho_external, external_vxc, mask, mp2_env, bs_env, kg_env, wanniercentres, atprop, ls_scf_env, do_transport, transport_env, v_hartree_rspace, s_mstruct_changed, rho_changed, potential_changed, forces_up_to_date, mscfg_env, almo_scf_env, gradient_history, variable_history, embed_pot, spin_embed_pot, polar_env, mos_last_converged, eeq, rhs, do_rixs, tb_tblite)
Get the QUICKSTEP environment.
Definition and initialisation of the mo data type.
subroutine, public get_mo_set(mo_set, maxocc, homo, lfomo, nao, nelectron, n_el_f, nmo, eigenvalues, occupation_numbers, mo_coeff, mo_coeff_b, uniform_occupation, kts, mu, flexible_electron_count)
Get the components of a MO set data structure.
Utility methods to build 3-center integral tensors of various types.
subroutine, public create_2c_tensor(t2c, dist_1, dist_2, pgrid, sizes_1, sizes_2, order, name)
...
Utility methods to build 3-center integral tensors of various types.
subroutine, public decompress_tensor(tensor, blk_indices, compressed, eps)
...
subroutine, public get_tensor_occupancy(tensor, nze, occ)
...
Utility routines for GW with imaginary time.
subroutine, public compute_weight_re_im(weight_re, weight_im, num_cells, iatom, jatom, xkp, wkp_w, cell, index_to_cell, hmat, particle_set)
...
subroutine, public get_atom_index_from_basis_function_index(qs_env, atom_from_basis_index, basis_size, basis_type, first_bf_from_atom)
...
Routines for low-scaling RPA/GW with imaginary time.
subroutine, public compute_mat_dm_global(tau_tj, num_integ_points, nmo, cfm_mo_coeff, homo, propagator, matrix_s, ispin, eigenval, e_fermi, eps_filter, memory_info, unit_nr, jquad, do_kpoints_cubic_rpa, do_kpoints_from_gamma, qs_env, num_cells_dm, index_to_cell_dm, para_env)
...
subroutine, public zero_mat_p_omega(mat_p_omega)
...
subroutine, public create_propagator_matrix_set(propagator, ntime, matrix_template, index_to_cell)
Creates the sector-, time-, and cell-resolved propagator matrix set.
integer, parameter, public propagator_sector_virtual
subroutine, public compute_periodic_dm(propagator, qs_env, ispin, num_integ_points, jquad, e_fermi, tau, sector)
...
subroutine, public init_cell_index_rpa(cell_grid, cell_to_index, index_to_cell, cell)
...
integer, parameter, public propagator_sector_occupied
subroutine, public compute_transl_dm(propagator, qs_env, ispin, num_integ_points, jquad, e_fermi, tau, eps_filter, num_cells_dm, index_to_cell_dm, sector)
...
subroutine, public compute_mat_p_omega(mat_p_omega, cfm_mo_coeff, homo, mat_p_global, matrix_s, ispin, t_3c_m, t_3c_o, t_3c_o_compressed, t_3c_o_ind, starts_array_mc, ends_array_mc, starts_array_mc_block, ends_array_mc_block, weights_cos_tf_t_to_w, tj, tau_tj, e_fermi, eps_filter, alpha, eps_filter_im_time, eigenval, nmo, num_integ_points, cut_memory, unit_nr, mp2_env, para_env, qs_env, do_kpoints_from_gamma, index_to_cell_3c, cell_to_index_3c, has_mat_p_blocks, do_ri_sos_laplace_mp2, dbcsr_time, dbcsr_nflop)
...
subroutine, public compute_gamma_propagator(propagator, jquad, cfm_mo_coeff, homo, eigenval, nmo, eps_filter, e_fermi, tau, para_env)
Builds the Gamma-point occupied and virtual propagators.
integer, parameter, public propagator_number_of_sectors
Type defining parameters related to the simulation cell.
Represent a complex full matrix.
Keeps information about a specific k-point.
Contains information about kpoints.
stores all the informations relevant to an mpi environment