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 Utility routines for GW with imaginary time
10 : !> \par History
11 : !> 06.2019 split from rpa_im_time.F [Frederick Stein]
12 : ! **************************************************************************************************
13 : MODULE rpa_gw_im_time_util
14 :
15 : USE atomic_kind_types, ONLY: atomic_kind_type
16 : USE basis_set_types, ONLY: gto_basis_set_p_type
17 : USE cell_types, ONLY: cell_type,&
18 : pbc
19 : USE cp_dbcsr_api, ONLY: &
20 : dbcsr_create, dbcsr_distribution_get, dbcsr_distribution_new, dbcsr_distribution_release, &
21 : dbcsr_distribution_type, dbcsr_filter, dbcsr_get_info, dbcsr_get_stored_coordinates, &
22 : dbcsr_init_p, dbcsr_iterator_blocks_left, dbcsr_iterator_next_block, &
23 : dbcsr_iterator_readonly_start, dbcsr_iterator_start, dbcsr_iterator_stop, &
24 : dbcsr_iterator_type, dbcsr_multiply, dbcsr_p_type, dbcsr_release, dbcsr_release_p, &
25 : dbcsr_type, dbcsr_type_no_symmetry
26 : USE cp_dbcsr_contrib, ONLY: dbcsr_add_on_diag,&
27 : dbcsr_get_diag,&
28 : dbcsr_reserve_all_blocks,&
29 : dbcsr_set_diag
30 : USE cp_dbcsr_operations, ONLY: copy_fm_to_dbcsr,&
31 : cp_dbcsr_m_by_n_from_row_template
32 : USE cp_fm_types, ONLY: cp_fm_create,&
33 : cp_fm_release,&
34 : cp_fm_set_element,&
35 : cp_fm_to_fm,&
36 : cp_fm_type
37 : USE dbt_api, ONLY: &
38 : dbt_contract, dbt_copy, dbt_copy_matrix_to_tensor, dbt_create, dbt_default_distvec, &
39 : dbt_destroy, dbt_get_info, dbt_pgrid_create, dbt_pgrid_destroy, dbt_pgrid_type, dbt_type
40 : USE hfx_types, ONLY: alloc_containers,&
41 : block_ind_type,&
42 : hfx_compression_type
43 : USE kinds, ONLY: dp,&
44 : int_8
45 : USE mathconstants, ONLY: twopi
46 : USE message_passing, ONLY: mp_dims_create,&
47 : mp_para_env_type,&
48 : mp_request_type
49 : USE mp2_types, ONLY: integ_mat_buffer_type
50 : USE particle_methods, ONLY: get_particle_set
51 : USE particle_types, ONLY: particle_type
52 : USE qs_environment_types, ONLY: get_qs_env,&
53 : qs_environment_type
54 : USE qs_integral_utils, ONLY: basis_set_list_setup
55 : USE qs_kind_types, ONLY: qs_kind_type
56 : USE qs_tensors, ONLY: compress_tensor,&
57 : decompress_tensor,&
58 : get_tensor_occupancy
59 : USE qs_tensors_types, ONLY: create_2c_tensor,&
60 : create_3c_tensor,&
61 : pgf_block_sizes,&
62 : split_block_sizes
63 : USE rpa_communication, ONLY: communicate_buffer
64 : #include "./base/base_uses.f90"
65 :
66 : IMPLICIT NONE
67 :
68 : PRIVATE
69 :
70 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rpa_gw_im_time_util'
71 :
72 : PUBLIC :: get_tensor_3c_overl_int_gw, compute_weight_re_im, get_atom_index_from_basis_function_index
73 :
74 : CONTAINS
75 :
76 : ! **************************************************************************************************
77 : !> \brief ...
78 : !> \param t_3c_overl_int ...
79 : !> \param t_3c_O_compressed ...
80 : !> \param t_3c_O_ind ...
81 : !> \param t_3c_overl_int_ao_mo ...
82 : !> \param t_3c_O_mo_compressed ...
83 : !> \param t_3c_O_mo_ind ...
84 : !> \param t_3c_overl_int_gw_RI ...
85 : !> \param t_3c_overl_int_gw_AO ...
86 : !> \param starts_array_mc ...
87 : !> \param ends_array_mc ...
88 : !> \param mo_coeff ...
89 : !> \param matrix_s ...
90 : !> \param gw_corr_lev_occ ...
91 : !> \param gw_corr_lev_virt ...
92 : !> \param homo ...
93 : !> \param nmo ...
94 : !> \param para_env ...
95 : !> \param do_ic_model ...
96 : !> \param t_3c_overl_nnP_ic ...
97 : !> \param t_3c_overl_nnP_ic_reflected ...
98 : !> \param qs_env ...
99 : !> \param unit_nr ...
100 : !> \param do_alpha ...
101 : ! **************************************************************************************************
102 54 : SUBROUTINE get_tensor_3c_overl_int_gw(t_3c_overl_int, t_3c_O_compressed, t_3c_O_ind, &
103 : t_3c_overl_int_ao_mo, t_3c_O_mo_compressed, t_3c_O_mo_ind, &
104 : t_3c_overl_int_gw_RI, t_3c_overl_int_gw_AO, &
105 108 : starts_array_mc, ends_array_mc, &
106 : mo_coeff, matrix_s, &
107 : gw_corr_lev_occ, gw_corr_lev_virt, homo, nmo, &
108 : para_env, &
109 : do_ic_model, &
110 : t_3c_overl_nnP_ic, t_3c_overl_nnP_ic_reflected, &
111 : qs_env, unit_nr, do_alpha)
112 :
113 : TYPE(dbt_type), DIMENSION(:, :) :: t_3c_overl_int
114 : TYPE(hfx_compression_type), DIMENSION(:, :, :) :: t_3c_O_compressed
115 : TYPE(block_ind_type), DIMENSION(:, :, :) :: t_3c_O_ind
116 : TYPE(dbt_type) :: t_3c_overl_int_ao_mo
117 : TYPE(hfx_compression_type) :: t_3c_O_mo_compressed
118 : INTEGER, ALLOCATABLE, DIMENSION(:, :) :: t_3c_O_mo_ind
119 : TYPE(dbt_type) :: t_3c_overl_int_gw_RI, &
120 : t_3c_overl_int_gw_AO
121 : INTEGER, DIMENSION(:), INTENT(IN) :: starts_array_mc, ends_array_mc
122 : TYPE(cp_fm_type), INTENT(IN) :: mo_coeff
123 : TYPE(dbcsr_p_type), DIMENSION(:), POINTER :: matrix_s
124 : INTEGER, INTENT(IN) :: gw_corr_lev_occ, gw_corr_lev_virt, homo, &
125 : nmo
126 : TYPE(mp_para_env_type), INTENT(IN) :: para_env
127 : LOGICAL, INTENT(IN) :: do_ic_model
128 : TYPE(dbt_type) :: t_3c_overl_nnP_ic, &
129 : t_3c_overl_nnP_ic_reflected
130 : TYPE(qs_environment_type), POINTER :: qs_env
131 : INTEGER, INTENT(IN) :: unit_nr
132 : LOGICAL, INTENT(IN), OPTIONAL :: do_alpha
133 :
134 : CHARACTER(LEN=*), PARAMETER :: routineN = 'get_tensor_3c_overl_int_gw'
135 :
136 : INTEGER :: cut_memory, handle, i_mem, icol_global, imo, irow_global, min_bsize, &
137 : min_bsize_mo, nkind, nmo_blk_gw, npcols, nprows, size_MO, unit_nr_prv
138 : INTEGER(int_8) :: nze
139 108 : INTEGER, ALLOCATABLE, DIMENSION(:) :: dist1, dist2, dist3, sizes_AO, &
140 54 : sizes_AO_split, sizes_MO, sizes_MO_1, &
141 108 : sizes_RI, sizes_RI_split, tmp
142 : INTEGER, DIMENSION(2) :: pdims_2d
143 : INTEGER, DIMENSION(2, 1) :: bounds
144 : INTEGER, DIMENSION(2, 3) :: ibounds
145 : INTEGER, DIMENSION(3) :: bounds_3c, pdims
146 108 : INTEGER, DIMENSION(:), POINTER :: distp_1, distp_2, sizes_MO_blocked, &
147 54 : sizes_MO_p1, sizes_MO_p2
148 : LOGICAL :: memory_info, my_do_alpha
149 : REAL(dp) :: compression_factor, memory_3c, occ
150 54 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:) :: norm
151 54 : TYPE(atomic_kind_type), DIMENSION(:), POINTER :: atomic_kind_set
152 : TYPE(cp_fm_type) :: fm_mat_mo_coeff_gw
153 : TYPE(dbcsr_distribution_type) :: dist, dist_templ
154 : TYPE(dbcsr_type) :: mat_mo_coeff_gw_reflected_norm, &
155 : mat_norm, mat_norm_diag, mat_work
156 : TYPE(dbcsr_type), POINTER :: mat_mo_coeff_gw, &
157 : mat_mo_coeff_gw_reflected
158 486 : TYPE(dbt_pgrid_type) :: pgrid_2d, pgrid_AO, pgrid_ic, pgrid_MO
159 702 : TYPE(dbt_type) :: mo_coeff_gw_t, mo_coeff_gw_t_tmp, &
160 378 : t_3c_overl_int_ao_ao, &
161 378 : t_3c_overl_int_mo_ao, &
162 378 : t_3c_overl_int_mo_mo
163 54 : TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: basis_set_ao, basis_set_ri_aux
164 54 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
165 54 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
166 :
167 54 : memory_info = qs_env%mp2_env%ri_rpa_im_time%memory_info
168 54 : IF (memory_info) THEN
169 0 : unit_nr_prv = unit_nr
170 : ELSE
171 54 : unit_nr_prv = 0
172 : END IF
173 :
174 54 : my_do_alpha = .FALSE.
175 54 : IF (PRESENT(do_alpha)) my_do_alpha = do_alpha
176 :
177 54 : CALL timeset(routineN, handle)
178 :
179 54 : CALL get_qs_env(qs_env, nkind=nkind, qs_kind_set=qs_kind_set, particle_set=particle_set, atomic_kind_set=atomic_kind_set)
180 :
181 54 : CALL cp_fm_create(fm_mat_mo_coeff_gw, mo_coeff%matrix_struct)
182 54 : CALL cp_fm_to_fm(mo_coeff, fm_mat_mo_coeff_gw)
183 :
184 : ! set MO coeffs to zero where
185 1396 : DO irow_global = 1, nmo
186 3094 : DO icol_global = 1, homo - gw_corr_lev_occ
187 3094 : CALL cp_fm_set_element(fm_mat_mo_coeff_gw, irow_global, icol_global, 0.0_dp)
188 : END DO
189 32506 : DO icol_global = homo + gw_corr_lev_virt + 1, nmo
190 32452 : CALL cp_fm_set_element(fm_mat_mo_coeff_gw, irow_global, icol_global, 0.0_dp)
191 : END DO
192 : END DO
193 :
194 54 : NULLIFY (mat_mo_coeff_gw)
195 54 : CALL dbcsr_init_p(mat_mo_coeff_gw)
196 :
197 : CALL cp_dbcsr_m_by_n_from_row_template(mat_mo_coeff_gw, template=matrix_s(1)%matrix, n=nmo, &
198 54 : sym=dbcsr_type_no_symmetry)
199 :
200 : CALL copy_fm_to_dbcsr(fm_mat_mo_coeff_gw, &
201 : mat_mo_coeff_gw, &
202 54 : keep_sparsity=.FALSE.)
203 :
204 : ! just remove the blocks which have been set to zero
205 54 : CALL dbcsr_filter(mat_mo_coeff_gw, 1.0E-20_dp)
206 :
207 54 : min_bsize = qs_env%mp2_env%ri_rpa_im_time%min_bsize
208 54 : min_bsize_mo = qs_env%mp2_env%ri_rpa_im_time%min_bsize_mo
209 :
210 108 : CALL split_block_sizes([gw_corr_lev_occ + gw_corr_lev_virt], sizes_MO, min_bsize_mo)
211 162 : ALLOCATE (sizes_MO_1(nmo))
212 1396 : sizes_MO_1(:) = 1
213 :
214 54 : nmo_blk_gw = SIZE(sizes_MO)
215 54 : CALL move_alloc(sizes_MO, tmp)
216 162 : ALLOCATE (sizes_MO(nmo_blk_gw + 2))
217 54 : sizes_MO(1) = homo - gw_corr_lev_occ
218 108 : sizes_MO(2:SIZE(tmp) + 1) = tmp(:)
219 54 : sizes_MO(SIZE(tmp) + 2) = nmo - (homo + gw_corr_lev_virt)
220 :
221 432 : ALLOCATE (basis_set_ri_aux(nkind), basis_set_ao(nkind))
222 54 : CALL basis_set_list_setup(basis_set_ri_aux, "RI_AUX", qs_kind_set)
223 54 : CALL get_particle_set(particle_set, qs_kind_set, nsgf=sizes_RI, basis=basis_set_ri_aux)
224 54 : CALL basis_set_list_setup(basis_set_ao, "ORB", qs_kind_set)
225 54 : CALL get_particle_set(particle_set, qs_kind_set, nsgf=sizes_AO, basis=basis_set_ao)
226 :
227 : CALL pgf_block_sizes(atomic_kind_set, basis_set_ao, min_bsize, sizes_AO_split)
228 : CALL pgf_block_sizes(atomic_kind_set, basis_set_ri_aux, min_bsize, sizes_RI_split)
229 :
230 54 : DEALLOCATE (basis_set_ao, basis_set_ri_aux)
231 :
232 54 : pdims = 0
233 : CALL dbt_pgrid_create(para_env, pdims, pgrid_AO, &
234 216 : tensor_dims=[SIZE(sizes_RI_split), SIZE(sizes_AO_split), SIZE(sizes_AO_split)])
235 :
236 54 : pdims_2d = 0
237 54 : CALL mp_dims_create(para_env%num_pe, pdims_2d)
238 :
239 : ! we iterate over MO blocks for saving memory during contraction, thus we should not parallelize over MO dimension
240 216 : pdims = [pdims_2d(1), pdims_2d(2), 1]
241 : CALL dbt_pgrid_create(para_env, pdims, pgrid_MO, &
242 216 : tensor_dims=[SIZE(sizes_RI_split), SIZE(sizes_AO_split), 1])
243 :
244 54 : pdims_2d = 0
245 : CALL dbt_pgrid_create(para_env, pdims_2d, pgrid_2d, &
246 162 : tensor_dims=[SIZE(sizes_AO_split), nmo])
247 :
248 : CALL create_3c_tensor(t_3c_overl_int_ao_ao, dist1, dist2, dist3, pgrid_AO, &
249 54 : sizes_RI_split, sizes_AO_split, sizes_AO_split, [1, 2], [3], name="(RI AO | AO)")
250 54 : DEALLOCATE (dist1, dist2, dist3)
251 :
252 54 : IF (.NOT. qs_env%mp2_env%ri_g0w0%do_kpoints_Sigma) THEN
253 : CALL create_3c_tensor(t_3c_overl_int_ao_mo, dist1, dist2, dist3, pgrid_AO, &
254 36 : sizes_RI_split, sizes_AO_split, sizes_MO_1, [1, 2], [3], name="(RI AO | MO)")
255 36 : DEALLOCATE (dist1, dist2, dist3)
256 : END IF
257 :
258 : CALL create_3c_tensor(t_3c_overl_int_gw_RI, dist1, dist2, dist3, pgrid_MO, &
259 54 : sizes_RI_split, sizes_AO_split, sizes_MO, [1], [2, 3], name="(RI | AO MO)")
260 54 : DEALLOCATE (dist1, dist2, dist3)
261 :
262 : CALL create_3c_tensor(t_3c_overl_int_gw_AO, dist1, dist2, dist3, pgrid_MO, &
263 54 : sizes_AO_split, sizes_RI_split, sizes_MO, [1], [2, 3], name="(AO | RI MO)")
264 54 : DEALLOCATE (dist1, dist2, dist3)
265 :
266 54 : CALL dbt_pgrid_destroy(pgrid_AO)
267 54 : CALL dbt_pgrid_destroy(pgrid_MO)
268 :
269 : CALL create_2c_tensor(mo_coeff_gw_t, dist1, dist2, pgrid_2d, sizes_AO_split, sizes_MO_1, name="(AO|MO)")
270 54 : DEALLOCATE (dist1, dist2)
271 54 : CALL dbt_pgrid_destroy(pgrid_2d)
272 :
273 54 : CALL dbt_create(mat_mo_coeff_gw, mo_coeff_gw_t_tmp, name="MO coeffs")
274 54 : CALL dbt_copy_matrix_to_tensor(mat_mo_coeff_gw, mo_coeff_gw_t_tmp)
275 :
276 54 : CALL dbt_copy(mo_coeff_gw_t_tmp, mo_coeff_gw_t)
277 :
278 54 : bounds(1, 1) = homo - gw_corr_lev_occ + 1
279 54 : bounds(2, 1) = homo + gw_corr_lev_virt
280 :
281 54 : CALL dbt_get_info(t_3c_overl_int_ao_ao, nfull_total=bounds_3c)
282 :
283 162 : ibounds(:, 1) = [1, bounds_3c(1)]
284 162 : ibounds(:, 3) = [1, bounds_3c(3)]
285 :
286 54 : cut_memory = SIZE(starts_array_mc)
287 :
288 54 : IF (.NOT. qs_env%mp2_env%ri_g0w0%do_kpoints_Sigma) THEN
289 72 : DO i_mem = 1, cut_memory
290 : CALL decompress_tensor(t_3c_overl_int(1, 1), t_3c_O_ind(1, 1, i_mem)%ind, t_3c_O_compressed(1, 1, i_mem), &
291 36 : qs_env%mp2_env%ri_rpa_im_time%eps_compress)
292 :
293 108 : ibounds(:, 2) = [starts_array_mc(i_mem), ends_array_mc(i_mem)]
294 :
295 36 : CALL dbt_copy(t_3c_overl_int(1, 1), t_3c_overl_int_ao_ao, move_data=.TRUE.)
296 :
297 : CALL dbt_contract(1.0_dp, mo_coeff_gw_t, t_3c_overl_int_ao_ao, 1.0_dp, &
298 : t_3c_overl_int_ao_mo, contract_1=[1], notcontract_1=[2], &
299 : contract_2=[3], notcontract_2=[1, 2], map_1=[3], map_2=[1, 2], &
300 72 : bounds_2=ibounds, move_data=.FALSE., unit_nr=unit_nr_prv)
301 :
302 : END DO
303 : END IF
304 :
305 54 : CALL cp_fm_release(fm_mat_mo_coeff_gw)
306 :
307 54 : IF (do_ic_model) THEN
308 2 : pdims = 0
309 : CALL dbt_pgrid_create(para_env, pdims, pgrid_ic, &
310 8 : tensor_dims=[SIZE(sizes_RI_split), nmo, nmo])
311 :
312 : CALL create_3c_tensor(t_3c_overl_int_mo_ao, dist1, dist2, dist3, pgrid_ic, &
313 2 : sizes_RI_split, sizes_MO_1, sizes_AO_split, [1, 2], [3], name="(RI MO | AO)")
314 2 : DEALLOCATE (dist1, dist2, dist3)
315 : CALL create_3c_tensor(t_3c_overl_int_mo_mo, dist1, dist2, dist3, pgrid_ic, &
316 2 : sizes_RI_split, sizes_MO_1, sizes_MO_1, [1, 2], [3], name="(RI MO | MO)")
317 2 : DEALLOCATE (dist1, dist2, dist3)
318 2 : CALL dbt_create(t_3c_overl_int_mo_mo, t_3c_overl_nnP_ic)
319 : CALL create_3c_tensor(t_3c_overl_nnP_ic_reflected, dist1, dist2, dist3, pgrid_ic, &
320 2 : sizes_RI_split, sizes_MO_1, sizes_MO_1, [1], [2, 3], name="(RI | MO MO)")
321 2 : DEALLOCATE (dist1, dist2, dist3)
322 :
323 2 : CALL dbt_pgrid_destroy(pgrid_ic)
324 :
325 2 : CALL dbt_copy(t_3c_overl_int_ao_mo, t_3c_overl_int_mo_ao, order=[1, 3, 2])
326 : CALL dbt_contract(1.0_dp, mo_coeff_gw_t, t_3c_overl_int_mo_ao, 0.0_dp, &
327 : t_3c_overl_int_mo_mo, contract_1=[1], notcontract_1=[2], &
328 : contract_2=[3], notcontract_2=[1, 2], map_1=[3], map_2=[1, 2], &
329 2 : bounds_2=bounds, move_data=.FALSE., unit_nr=unit_nr_prv)
330 2 : CALL dbt_copy(t_3c_overl_int_mo_mo, t_3c_overl_nnP_ic)
331 :
332 2 : NULLIFY (mat_mo_coeff_gw_reflected)
333 2 : CALL dbcsr_init_p(mat_mo_coeff_gw_reflected)
334 :
335 : CALL cp_dbcsr_m_by_n_from_row_template(mat_mo_coeff_gw_reflected, template=matrix_s(1)%matrix, n=nmo, &
336 2 : sym=dbcsr_type_no_symmetry)
337 :
338 2 : CALL reflect_mat_row(mat_mo_coeff_gw_reflected, mat_mo_coeff_gw, para_env, qs_env, unit_nr, do_alpha=my_do_alpha)
339 :
340 : ! normalize reflected MOs (they are not properly normalized since high angular momentum basis functions
341 : ! of the image molecule are not exactly reflected at the image plane (sign problem in p_z function)
342 2 : CALL dbcsr_create(matrix=mat_work, template=mat_mo_coeff_gw_reflected, matrix_type=dbcsr_type_no_symmetry)
343 :
344 2 : CALL dbcsr_get_info(mat_work, distribution=dist_templ, nblkcols_total=size_MO, col_blk_size=sizes_MO_blocked)
345 :
346 2 : CALL dbcsr_distribution_get(dist_templ, nprows=nprows, npcols=npcols)
347 :
348 8 : ALLOCATE (distp_1(size_MO), distp_2(size_MO))
349 2 : CALL dbt_default_distvec(size_MO, nprows, sizes_MO_blocked, distp_1)
350 2 : CALL dbt_default_distvec(size_MO, npcols, sizes_MO_blocked, distp_2)
351 2 : CALL dbcsr_distribution_new(dist, template=dist_templ, row_dist=distp_1, col_dist=distp_2, reuse_arrays=.TRUE.)
352 :
353 4 : ALLOCATE (sizes_MO_p1(size_MO))
354 4 : ALLOCATE (sizes_MO_p2(size_MO))
355 14 : sizes_MO_p1(:) = sizes_MO_blocked
356 14 : sizes_MO_p2(:) = sizes_MO_blocked
357 : CALL dbcsr_create(mat_norm, "mo norm", dist, dbcsr_type_no_symmetry, sizes_MO_p1, sizes_MO_p2, &
358 2 : reuse_arrays=.TRUE.)
359 2 : CALL dbcsr_distribution_release(dist)
360 :
361 2 : CALL dbcsr_multiply("N", "N", 1.0_dp, matrix_s(1)%matrix, mat_mo_coeff_gw_reflected, 0.0_dp, mat_work)
362 2 : CALL dbcsr_multiply("T", "N", 1.0_dp, mat_mo_coeff_gw_reflected, mat_work, 0.0_dp, mat_norm)
363 :
364 2 : CALL dbcsr_release(mat_work)
365 :
366 6 : ALLOCATE (norm(nmo))
367 146 : norm = 0.0_dp
368 :
369 2 : CALL dbcsr_get_diag(mat_norm, norm)
370 2 : CALL para_env%sum(norm)
371 :
372 14 : DO imo = bounds(1, 1), bounds(2, 1)
373 14 : norm(imo) = 1.0_dp/SQRT(norm(imo))
374 : END DO
375 :
376 2 : CALL dbcsr_create(mat_norm_diag, template=mat_norm)
377 2 : CALL dbcsr_release(mat_norm)
378 :
379 2 : CALL dbcsr_add_on_diag(mat_norm_diag, 1.0_dp)
380 :
381 2 : CALL dbcsr_set_diag(mat_norm_diag, norm)
382 :
383 2 : CALL dbcsr_create(mat_mo_coeff_gw_reflected_norm, template=mat_mo_coeff_gw_reflected)
384 2 : CALL dbcsr_multiply("N", "N", 1.0_dp, mat_mo_coeff_gw_reflected, mat_norm_diag, 0.0_dp, mat_mo_coeff_gw_reflected_norm)
385 2 : CALL dbcsr_release(mat_norm_diag)
386 :
387 2 : CALL dbcsr_filter(mat_mo_coeff_gw_reflected_norm, 1.0E-20_dp)
388 :
389 2 : CALL dbt_copy_matrix_to_tensor(mat_mo_coeff_gw_reflected_norm, mo_coeff_gw_t_tmp)
390 2 : CALL dbcsr_release(mat_mo_coeff_gw_reflected_norm)
391 2 : CALL dbt_copy(mo_coeff_gw_t_tmp, mo_coeff_gw_t)
392 :
393 : CALL dbt_contract(1.0_dp, mo_coeff_gw_t, t_3c_overl_int_ao_ao, 0.0_dp, &
394 : t_3c_overl_int_ao_mo, contract_1=[1], notcontract_1=[2], &
395 : contract_2=[3], notcontract_2=[1, 2], map_1=[3], map_2=[1, 2], &
396 2 : bounds_2=bounds, move_data=.FALSE., unit_nr=unit_nr_prv)
397 :
398 2 : CALL dbt_copy(t_3c_overl_int_ao_mo, t_3c_overl_int_mo_ao, order=[1, 3, 2])
399 : CALL dbt_contract(1.0_dp, mo_coeff_gw_t, t_3c_overl_int_mo_ao, 0.0_dp, &
400 : t_3c_overl_int_mo_mo, contract_1=[1], notcontract_1=[2], &
401 : contract_2=[3], notcontract_2=[1, 2], map_1=[3], map_2=[1, 2], &
402 2 : bounds_2=bounds, move_data=.FALSE., unit_nr=unit_nr_prv)
403 2 : CALL dbt_copy(t_3c_overl_int_mo_mo, t_3c_overl_nnP_ic_reflected)
404 2 : CALL dbt_destroy(t_3c_overl_int_mo_ao)
405 2 : CALL dbt_destroy(t_3c_overl_int_mo_mo)
406 :
407 4 : CALL dbcsr_release_p(mat_mo_coeff_gw_reflected)
408 :
409 : END IF
410 :
411 54 : IF (.NOT. qs_env%mp2_env%ri_g0w0%do_kpoints_Sigma) THEN
412 36 : CALL alloc_containers(t_3c_O_mo_compressed, 1)
413 36 : CALL get_tensor_occupancy(t_3c_overl_int_ao_mo, nze, occ)
414 36 : memory_3c = 0.0_dp
415 :
416 : CALL compress_tensor(t_3c_overl_int_ao_mo, t_3c_O_mo_ind, t_3c_O_mo_compressed, &
417 36 : qs_env%mp2_env%ri_rpa_im_time%eps_compress, memory_3c)
418 :
419 36 : CALL para_env%sum(memory_3c)
420 36 : compression_factor = REAL(nze, dp)*1.0E-06*8.0_dp/memory_3c
421 :
422 36 : IF (unit_nr > 0) THEN
423 : WRITE (UNIT=unit_nr, FMT="((T3,A,T66,F11.2,A4))") &
424 18 : "MEMORY_INFO| Memory of MO-contracted tensor (compressed):", memory_3c, ' MiB'
425 :
426 : WRITE (UNIT=unit_nr, FMT="((T3,A,T60,F21.2))") &
427 18 : "MEMORY_INFO| Compression factor: ", compression_factor
428 : END IF
429 : END IF
430 :
431 54 : CALL dbcsr_release_p(mat_mo_coeff_gw)
432 :
433 54 : CALL dbt_destroy(t_3c_overl_int_ao_ao)
434 54 : CALL dbt_destroy(mo_coeff_gw_t)
435 54 : CALL dbt_destroy(mo_coeff_gw_t_tmp)
436 :
437 54 : CALL timestop(handle)
438 :
439 432 : END SUBROUTINE
440 :
441 : ! **************************************************************************************************
442 : !> \brief reflect from V = (A,B|B,A) to V_reflected = (B,A|A,B) where A belongs to the block of the molecule
443 : !> and B to the off diagonal block between molecule and image of the molecule
444 : !> \param mat_reflected ...
445 : !> \param mat_orig ...
446 : !> \param para_env ...
447 : !> \param qs_env ...
448 : !> \param unit_nr ...
449 : !> \param do_alpha ...
450 : ! **************************************************************************************************
451 2 : SUBROUTINE reflect_mat_row(mat_reflected, mat_orig, para_env, qs_env, unit_nr, do_alpha)
452 : TYPE(dbcsr_type), INTENT(INOUT) :: mat_reflected
453 : TYPE(dbcsr_type), INTENT(IN) :: mat_orig
454 : TYPE(mp_para_env_type), INTENT(IN) :: para_env
455 : TYPE(qs_environment_type), POINTER :: qs_env
456 : INTEGER, INTENT(IN) :: unit_nr
457 : LOGICAL, INTENT(IN) :: do_alpha
458 :
459 : CHARACTER(LEN=*), PARAMETER :: routineN = 'reflect_mat_row'
460 :
461 : INTEGER :: block, block_size, col, col_rec, col_size, handle, i_atom, i_block, imepos, &
462 : j_atom, natom, nblkcols_total, nblkrows_total, offset, row, row_rec, row_reflected, &
463 : row_size
464 2 : INTEGER, ALLOCATABLE, DIMENSION(:) :: block_counter, entry_counter, image_atom, &
465 2 : num_blocks_rec, num_blocks_send, num_entries_rec, num_entries_send, sizes_rec, sizes_send
466 2 : INTEGER, DIMENSION(:), POINTER :: col_blk_sizes, row_blk_sizes
467 : LOGICAL :: found_image_atom
468 : REAL(KIND=dp) :: avg_z_dist, delta, eps_dist2, &
469 : min_z_dist, ra(3), rb(3), sum_z, &
470 : z_reflection
471 2 : REAL(KIND=dp), DIMENSION(:, :), POINTER :: data_block
472 : TYPE(cell_type), POINTER :: cell
473 : TYPE(dbcsr_iterator_type) :: iter
474 : TYPE(integ_mat_buffer_type), ALLOCATABLE, &
475 2 : DIMENSION(:) :: buffer_rec, buffer_send
476 2 : TYPE(mp_request_type), DIMENSION(:, :), POINTER :: req_array
477 2 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
478 :
479 2 : CALL timeset(routineN, handle)
480 :
481 2 : CALL dbcsr_reserve_all_blocks(mat_reflected)
482 :
483 : CALL get_qs_env(qs_env, cell=cell, &
484 2 : particle_set=particle_set)
485 :
486 : ! first check, whether we have an image molecule
487 : CALL dbcsr_get_info(mat_orig, &
488 : nblkrows_total=nblkrows_total, &
489 : nblkcols_total=nblkcols_total, &
490 : row_blk_size=row_blk_sizes, &
491 2 : col_blk_size=col_blk_sizes)
492 :
493 2 : natom = SIZE(particle_set)
494 2 : CPASSERT(natom == nblkrows_total)
495 :
496 2 : eps_dist2 = qs_env%mp2_env%ri_g0w0%eps_dist
497 2 : eps_dist2 = eps_dist2*eps_dist2
498 :
499 2 : sum_z = 0.0_dp
500 :
501 18 : DO i_atom = 1, natom
502 :
503 16 : ra(:) = pbc(particle_set(i_atom)%r, cell)
504 :
505 18 : sum_z = sum_z + ra(3)
506 :
507 : END DO
508 :
509 2 : z_reflection = sum_z/REAL(natom, KIND=dp)
510 :
511 2 : sum_z = 0.0_dp
512 :
513 18 : DO i_atom = 1, natom
514 :
515 16 : ra(:) = pbc(particle_set(i_atom)%r, cell)
516 :
517 18 : sum_z = sum_z + ABS(ra(3) - z_reflection)
518 :
519 : END DO
520 :
521 2 : avg_z_dist = sum_z/REAL(natom, KIND=dp)
522 :
523 2 : min_z_dist = avg_z_dist
524 :
525 18 : DO i_atom = 1, natom
526 :
527 16 : ra(:) = pbc(particle_set(i_atom)%r, cell)
528 :
529 18 : IF (ABS(ra(3) - z_reflection) < min_z_dist) THEN
530 2 : min_z_dist = ABS(ra(3) - z_reflection)
531 : END IF
532 :
533 : END DO
534 :
535 2 : IF (unit_nr > 0 .AND. do_alpha) THEN
536 1 : WRITE (unit_nr, '(T3,A,T70,F9.2,A2)') 'IC_MODEL| Average distance of the molecule to the image plane:', &
537 2 : avg_z_dist*0.529_dp, ' A'
538 1 : WRITE (unit_nr, '(T3,A,T70,F9.2,A2)') 'IC_MODEL| Minimum distance of the molecule to the image plane:', &
539 2 : min_z_dist*0.529_dp, ' A'
540 : END IF
541 :
542 6 : ALLOCATE (image_atom(nblkrows_total))
543 18 : image_atom = 0
544 :
545 18 : DO i_atom = 1, natom
546 :
547 16 : found_image_atom = .FALSE.
548 :
549 16 : ra(:) = pbc(particle_set(i_atom)%r, cell)
550 :
551 144 : DO j_atom = 1, natom
552 :
553 128 : rb(:) = pbc(particle_set(j_atom)%r, cell)
554 :
555 128 : delta = (ra(1) - rb(1))**2 + (ra(2) - rb(2))**2 + (ra(3) + rb(3) - 2.0_dp*z_reflection)**2
556 :
557 : ! SQRT(delta) < eps_dist
558 144 : IF (delta < eps_dist2) THEN
559 : ! this CPASSERT ensures that there is at most one image atom for each atom
560 16 : CPASSERT(.NOT. found_image_atom)
561 16 : image_atom(i_atom) = j_atom
562 16 : found_image_atom = .TRUE.
563 : ! check whether we have the same basis at the image atom
564 : ! if this is wrong, check whether you have the same basis sets for the molecule and the image
565 16 : CPASSERT(row_blk_sizes(i_atom) == row_blk_sizes(j_atom))
566 : END IF
567 :
568 : END DO
569 :
570 : ! this CPASSERT ensures that there is at least one image atom for each atom
571 18 : CPASSERT(found_image_atom)
572 :
573 : END DO
574 :
575 10 : ALLOCATE (buffer_rec(0:para_env%num_pe - 1))
576 8 : ALLOCATE (buffer_send(0:para_env%num_pe - 1))
577 :
578 6 : ALLOCATE (num_entries_rec(0:para_env%num_pe - 1))
579 4 : ALLOCATE (num_blocks_rec(0:para_env%num_pe - 1))
580 4 : ALLOCATE (num_entries_send(0:para_env%num_pe - 1))
581 4 : ALLOCATE (num_blocks_send(0:para_env%num_pe - 1))
582 6 : num_entries_rec = 0
583 6 : num_blocks_rec = 0
584 6 : num_entries_send = 0
585 6 : num_blocks_send = 0
586 :
587 2 : CALL dbcsr_iterator_readonly_start(iter, mat_orig)
588 10 : DO WHILE (dbcsr_iterator_blocks_left(iter))
589 :
590 8 : CALL dbcsr_iterator_next_block(iter, row, col, row_size=row_size, col_size=col_size)
591 :
592 8 : row_reflected = image_atom(row)
593 :
594 8 : CALL dbcsr_get_stored_coordinates(mat_reflected, row_reflected, col, imepos)
595 :
596 8 : num_entries_send(imepos) = num_entries_send(imepos) + row_size*col_size
597 8 : num_blocks_send(imepos) = num_blocks_send(imepos) + 1
598 :
599 : END DO
600 :
601 2 : CALL dbcsr_iterator_stop(iter)
602 :
603 2 : IF (para_env%num_pe > 1) THEN
604 :
605 6 : ALLOCATE (sizes_rec(0:2*para_env%num_pe - 1))
606 4 : ALLOCATE (sizes_send(0:2*para_env%num_pe - 1))
607 :
608 6 : DO imepos = 0, para_env%num_pe - 1
609 :
610 4 : sizes_send(2*imepos) = num_entries_send(imepos)
611 6 : sizes_send(2*imepos + 1) = num_blocks_send(imepos)
612 :
613 : END DO
614 :
615 2 : CALL para_env%alltoall(sizes_send, sizes_rec, 2)
616 :
617 6 : DO imepos = 0, para_env%num_pe - 1
618 4 : num_entries_rec(imepos) = sizes_rec(2*imepos)
619 6 : num_blocks_rec(imepos) = sizes_rec(2*imepos + 1)
620 : END DO
621 :
622 2 : DEALLOCATE (sizes_rec, sizes_send)
623 :
624 : ELSE
625 :
626 0 : num_entries_rec(0) = num_entries_send(0)
627 0 : num_blocks_rec(0) = num_blocks_send(0)
628 :
629 : END IF
630 :
631 : ! allocate data message and corresponding indices
632 6 : DO imepos = 0, para_env%num_pe - 1
633 :
634 10 : ALLOCATE (buffer_rec(imepos)%msg(num_entries_rec(imepos)))
635 2308 : buffer_rec(imepos)%msg = 0.0_dp
636 :
637 10 : ALLOCATE (buffer_send(imepos)%msg(num_entries_send(imepos)))
638 2308 : buffer_send(imepos)%msg = 0.0_dp
639 :
640 10 : ALLOCATE (buffer_rec(imepos)%indx(num_blocks_rec(imepos), 3))
641 40 : buffer_rec(imepos)%indx = 0
642 :
643 10 : ALLOCATE (buffer_send(imepos)%indx(num_blocks_send(imepos), 3))
644 42 : buffer_send(imepos)%indx = 0
645 :
646 : END DO
647 :
648 4 : ALLOCATE (block_counter(0:para_env%num_pe - 1))
649 6 : block_counter(:) = 0
650 :
651 4 : ALLOCATE (entry_counter(0:para_env%num_pe - 1))
652 6 : entry_counter(:) = 0
653 :
654 2 : CALL dbcsr_iterator_readonly_start(iter, mat_orig)
655 10 : DO WHILE (dbcsr_iterator_blocks_left(iter))
656 :
657 : CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
658 8 : row_size=row_size, col_size=col_size)
659 :
660 8 : row_reflected = image_atom(row)
661 :
662 8 : CALL dbcsr_get_stored_coordinates(mat_reflected, row_reflected, col, imepos)
663 :
664 8 : block_size = row_size*col_size
665 :
666 8 : offset = entry_counter(imepos)
667 :
668 : buffer_send(imepos)%msg(offset + 1:offset + block_size) = &
669 2320 : RESHAPE(data_block(1:row_size, 1:col_size), (/block_size/))
670 :
671 8 : block = block_counter(imepos) + 1
672 :
673 8 : buffer_send(imepos)%indx(block, 1) = row_reflected
674 8 : buffer_send(imepos)%indx(block, 2) = col
675 8 : buffer_send(imepos)%indx(block, 3) = offset
676 :
677 8 : entry_counter(imepos) = entry_counter(imepos) + block_size
678 :
679 8 : block_counter(imepos) = block_counter(imepos) + 1
680 :
681 : END DO
682 :
683 2 : CALL dbcsr_iterator_stop(iter)
684 :
685 30 : ALLOCATE (req_array(1:para_env%num_pe, 4))
686 :
687 2 : CALL communicate_buffer(para_env, num_entries_rec, num_entries_send, buffer_rec, buffer_send, req_array)
688 :
689 2 : DEALLOCATE (req_array)
690 :
691 : ! fill the reflected matrix
692 6 : DO imepos = 0, para_env%num_pe - 1
693 :
694 14 : DO i_block = 1, num_blocks_rec(imepos)
695 :
696 8 : row_rec = buffer_rec(imepos)%indx(i_block, 1)
697 8 : col_rec = buffer_rec(imepos)%indx(i_block, 2)
698 :
699 8 : CALL dbcsr_iterator_start(iter, mat_reflected)
700 104 : DO WHILE (dbcsr_iterator_blocks_left(iter))
701 :
702 : CALL dbcsr_iterator_next_block(iter, row, col, data_block, &
703 96 : row_size=row_size, col_size=col_size)
704 :
705 104 : IF (row_rec == row .AND. col_rec == col) THEN
706 :
707 8 : offset = buffer_rec(imepos)%indx(i_block, 3)
708 :
709 : data_block(:, :) = RESHAPE(buffer_rec(imepos)%msg(offset + 1:offset + row_size*col_size), &
710 24 : (/row_size, col_size/))
711 :
712 : END IF
713 :
714 : END DO
715 :
716 20 : CALL dbcsr_iterator_stop(iter)
717 :
718 : END DO
719 :
720 : END DO
721 :
722 6 : DO imepos = 0, para_env%num_pe - 1
723 4 : DEALLOCATE (buffer_rec(imepos)%msg)
724 4 : DEALLOCATE (buffer_rec(imepos)%indx)
725 4 : DEALLOCATE (buffer_send(imepos)%msg)
726 6 : DEALLOCATE (buffer_send(imepos)%indx)
727 : END DO
728 :
729 10 : DEALLOCATE (buffer_rec, buffer_send)
730 2 : DEALLOCATE (block_counter, entry_counter)
731 2 : DEALLOCATE (num_entries_rec)
732 2 : DEALLOCATE (num_blocks_rec)
733 2 : DEALLOCATE (num_entries_send)
734 2 : DEALLOCATE (num_blocks_send)
735 :
736 2 : CALL timestop(handle)
737 :
738 10 : END SUBROUTINE
739 :
740 : ! **************************************************************************************************
741 : !> \brief ...
742 : !> \param qs_env ...
743 : !> \param atom_from_basis_index ...
744 : !> \param basis_size ...
745 : !> \param basis_type ...
746 : !> \param first_bf_from_atom ...
747 : ! **************************************************************************************************
748 7570 : SUBROUTINE get_atom_index_from_basis_function_index(qs_env, atom_from_basis_index, basis_size, &
749 : basis_type, first_bf_from_atom)
750 : TYPE(qs_environment_type), POINTER :: qs_env
751 : INTEGER, ALLOCATABLE, DIMENSION(:) :: atom_from_basis_index
752 : INTEGER :: basis_size
753 : CHARACTER(LEN=*) :: basis_type
754 : INTEGER, ALLOCATABLE, DIMENSION(:), OPTIONAL :: first_bf_from_atom
755 :
756 : INTEGER :: iatom, LLL, natom, nkind
757 : INTEGER, DIMENSION(:), POINTER :: row_blk_end, row_blk_start
758 7570 : TYPE(gto_basis_set_p_type), DIMENSION(:), POINTER :: basis_set
759 7570 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
760 7570 : TYPE(qs_kind_type), DIMENSION(:), POINTER :: qs_kind_set
761 :
762 7570 : NULLIFY (qs_kind_set, particle_set)
763 : CALL get_qs_env(qs_env, qs_kind_set=qs_kind_set, natom=natom, nkind=nkind, &
764 7570 : particle_set=particle_set)
765 :
766 22710 : ALLOCATE (row_blk_start(natom))
767 22710 : ALLOCATE (row_blk_end(natom))
768 36538 : ALLOCATE (basis_set(nkind))
769 7570 : CALL basis_set_list_setup(basis_set, basis_type, qs_kind_set)
770 : CALL get_particle_set(particle_set, qs_kind_set, first_sgf=row_blk_start, last_sgf=row_blk_end, &
771 7570 : basis=basis_set)
772 227796 : DO LLL = 1, basis_size
773 859840 : DO iatom = 1, natom
774 852270 : IF (LLL >= row_blk_start(iatom) .AND. LLL <= row_blk_end(iatom)) THEN
775 220226 : atom_from_basis_index(LLL) = iatom
776 : END IF
777 : END DO
778 : END DO
779 :
780 7570 : IF (PRESENT(first_bf_from_atom)) first_bf_from_atom(1:natom) = row_blk_start(:)
781 :
782 7570 : DEALLOCATE (basis_set)
783 7570 : DEALLOCATE (row_blk_start)
784 7570 : DEALLOCATE (row_blk_end)
785 :
786 7570 : END SUBROUTINE get_atom_index_from_basis_function_index
787 :
788 : ! **************************************************************************************************
789 : !> \brief ...
790 : !> \param weight_re ...
791 : !> \param weight_im ...
792 : !> \param num_cells ...
793 : !> \param iatom ...
794 : !> \param jatom ...
795 : !> \param xkp ...
796 : !> \param wkp_W ...
797 : !> \param cell ...
798 : !> \param index_to_cell ...
799 : !> \param hmat ...
800 : !> \param particle_set ...
801 : ! **************************************************************************************************
802 289008 : SUBROUTINE compute_weight_re_im(weight_re, weight_im, &
803 : num_cells, iatom, jatom, xkp, wkp_W, &
804 : cell, index_to_cell, hmat, particle_set)
805 :
806 : REAL(KIND=dp) :: weight_re, weight_im
807 : INTEGER :: num_cells, iatom, jatom
808 : REAL(KIND=dp), DIMENSION(3) :: xkp
809 : REAL(KIND=dp) :: wkp_W
810 : TYPE(cell_type), POINTER :: cell
811 : INTEGER, DIMENSION(:, :), POINTER :: index_to_cell
812 : REAL(KIND=dp), DIMENSION(3, 3) :: hmat
813 : TYPE(particle_type), DIMENSION(:), POINTER :: particle_set
814 :
815 : CHARACTER(LEN=*), PARAMETER :: routineN = 'compute_weight_re_im'
816 :
817 : INTEGER :: handle, icell, n_equidistant_cells, &
818 : xcell, ycell, zcell
819 : REAL(KIND=dp) :: abs_rab_cell, abs_rab_cell_min, arg
820 : REAL(KIND=dp), DIMENSION(3) :: cell_vector, rab_cell_i
821 :
822 289008 : CALL timeset(routineN, handle)
823 :
824 289008 : weight_re = 0.0_dp
825 289008 : weight_im = 0.0_dp
826 :
827 289008 : abs_rab_cell_min = 1.0E10_dp
828 :
829 289008 : n_equidistant_cells = 0
830 :
831 2819336 : DO icell = 1, num_cells
832 :
833 2530328 : xcell = index_to_cell(1, icell)
834 2530328 : ycell = index_to_cell(2, icell)
835 2530328 : zcell = index_to_cell(3, icell)
836 :
837 40485248 : cell_vector(1:3) = MATMUL(hmat, REAL((/xcell, ycell, zcell/), dp))
838 :
839 : rab_cell_i(1:3) = pbc(particle_set(iatom)%r(1:3), cell) - &
840 10121312 : (pbc(particle_set(jatom)%r(1:3), cell) + cell_vector(1:3))
841 :
842 2530328 : abs_rab_cell = SQRT(rab_cell_i(1)**2 + rab_cell_i(2)**2 + rab_cell_i(3)**2)
843 :
844 2819336 : IF (abs_rab_cell < abs_rab_cell_min) THEN
845 450338 : abs_rab_cell_min = abs_rab_cell
846 : END IF
847 :
848 : END DO
849 :
850 2819336 : DO icell = 1, num_cells
851 :
852 2530328 : xcell = index_to_cell(1, icell)
853 2530328 : ycell = index_to_cell(2, icell)
854 2530328 : zcell = index_to_cell(3, icell)
855 :
856 40485248 : cell_vector(1:3) = MATMUL(hmat, REAL((/xcell, ycell, zcell/), dp))
857 :
858 : rab_cell_i(1:3) = pbc(particle_set(iatom)%r(1:3), cell) - &
859 10121312 : (pbc(particle_set(jatom)%r(1:3), cell) + cell_vector(1:3))
860 :
861 2530328 : abs_rab_cell = SQRT(rab_cell_i(1)**2 + rab_cell_i(2)**2 + rab_cell_i(3)**2)
862 :
863 2819336 : IF (abs_rab_cell < abs_rab_cell_min + 0.1_dp) THEN
864 :
865 289008 : arg = REAL(xcell, dp)*xkp(1) + REAL(ycell, dp)*xkp(2) + REAL(zcell, dp)*xkp(3)
866 :
867 289008 : weight_re = weight_re + wkp_W*COS(twopi*arg)
868 289008 : weight_im = weight_im + wkp_W*SIN(twopi*arg)
869 :
870 289008 : n_equidistant_cells = n_equidistant_cells + 1
871 :
872 : END IF
873 :
874 : END DO
875 :
876 289008 : weight_re = weight_re/REAL(n_equidistant_cells, KIND=dp)
877 289008 : weight_im = weight_im/REAL(n_equidistant_cells, KIND=dp)
878 :
879 289008 : CALL timestop(handle)
880 :
881 289008 : END SUBROUTINE compute_weight_re_im
882 :
883 : END MODULE rpa_gw_im_time_util
|
