Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Routines for calculating RI-MP2 gradients
10 : !> \par History
11 : !> 10.2013 created [Mauro Del Ben]
12 : ! **************************************************************************************************
13 : MODULE mp2_ri_grad_util
14 : !
15 : USE cp_blacs_env, ONLY: cp_blacs_env_create,&
16 : cp_blacs_env_release,&
17 : cp_blacs_env_type
18 : USE cp_dbcsr_redistribution, ONLY: cp_array_to_dbcsr_slices
19 : USE cp_fm_basic_linalg, ONLY: cp_fm_geadd
20 : USE cp_fm_redistribution, ONLY: cp_array_to_fm,&
21 : cp_fm_to_array
22 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
23 : cp_fm_struct_release,&
24 : cp_fm_struct_type
25 : USE cp_fm_types, ONLY: cp_fm_create,&
26 : cp_fm_release,&
27 : cp_fm_to_fm,&
28 : cp_fm_type
29 : USE group_dist_types, ONLY: create_group_dist,&
30 : get_group_dist,&
31 : group_dist_d1_type,&
32 : release_group_dist
33 : USE kinds, ONLY: dp
34 : USE libint_2c_3c, ONLY: compare_potential_types
35 : USE message_passing, ONLY: mp_para_env_type
36 : USE mp2_types, ONLY: mp2_type
37 : USE parallel_gemm_api, ONLY: parallel_gemm
38 : #include "./base/base_uses.f90"
39 :
40 : IMPLICIT NONE
41 :
42 : PRIVATE
43 :
44 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mp2_ri_grad_util'
45 :
46 : PUBLIC :: complete_gamma
47 :
48 : CONTAINS
49 :
50 : ! **************************************************************************************************
51 : !> \brief complete the calculation of the Gamma matrices
52 : !> \param mp2_env ...
53 : !> \param B_ia_Q ...
54 : !> \param dimen_RI ...
55 : !> \param homo ...
56 : !> \param virtual ...
57 : !> \param para_env ...
58 : !> \param para_env_sub ...
59 : !> \param my_group_L_size ...
60 : !> \param my_group_L_start ...
61 : !> \param my_group_L_end ...
62 : !> \param my_B_size ...
63 : !> \param my_B_virtual_start ...
64 : !> \param gd_B_virtual ...
65 : !> \param kspin ...
66 : !> \author Mauro Del Ben
67 : ! **************************************************************************************************
68 306 : SUBROUTINE complete_gamma(mp2_env, B_ia_Q, dimen_RI, homo, virtual, para_env, para_env_sub, my_group_L_size, &
69 : my_group_L_start, my_group_L_end, my_B_size, my_B_virtual_start, gd_B_virtual, kspin)
70 :
71 : TYPE(mp2_type) :: mp2_env
72 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :), &
73 : INTENT(INOUT) :: B_ia_Q
74 : INTEGER, INTENT(IN) :: dimen_RI, homo, virtual
75 : TYPE(mp_para_env_type), INTENT(IN), POINTER :: para_env, para_env_sub
76 : INTEGER, INTENT(IN) :: my_group_L_size, my_group_L_start, &
77 : my_group_L_end, my_B_size, &
78 : my_B_virtual_start
79 : TYPE(group_dist_d1_type), INTENT(IN) :: gd_B_virtual
80 : INTEGER, INTENT(IN) :: kspin
81 :
82 : CHARACTER(LEN=*), PARAMETER :: routineN = 'complete_gamma'
83 :
84 : INTEGER :: dimen_ia, handle, ispin, kkB, my_ia_end, &
85 : my_ia_size, my_ia_start, my_P_end, &
86 : my_P_size, my_P_start, nspins
87 306 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :) :: BIb_C_2D, Gamma_2D, Gamma_PQ
88 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
89 : TYPE(cp_fm_struct_type), POINTER :: fm_struct_ia, fm_struct_RI
90 : TYPE(cp_fm_type) :: fm_Gamma, fm_Gamma_PQ, fm_Gamma_PQ_2, fm_Gamma_PQ_temp, &
91 : fm_Gamma_PQ_temp_2, fm_ia_P, fm_Y, operator_half, PQ_half
92 306 : TYPE(group_dist_d1_type) :: gd_ia, gd_P
93 :
94 306 : CALL timeset(routineN, handle)
95 :
96 : ! reshape the data into a 2D array
97 : ! reorder the local data in such a way to help the next stage of matrix creation
98 : ! now the data inside the group are divided into a ia x K matrix
99 306 : dimen_ia = homo*virtual
100 306 : CALL create_group_dist(gd_ia, para_env_sub%num_pe, dimen_ia)
101 306 : CALL get_group_dist(gd_ia, para_env_sub%mepos, my_ia_start, my_ia_end, my_ia_size)
102 :
103 : CALL mat_3d_to_2d(B_ia_Q, BIb_C_2D, homo, my_B_size, virtual, my_B_virtual_start, &
104 306 : my_ia_start, my_ia_end, my_ia_size, my_group_L_size, para_env_sub, gd_B_virtual)
105 :
106 : CALL mat_3d_to_2d_gamma(mp2_env%ri_grad%Gamma_P_ia(kspin)%array, Gamma_2D, homo, my_B_size, virtual, my_B_virtual_start, &
107 306 : my_ia_start, my_ia_end, my_ia_size, my_group_L_size, para_env_sub, gd_B_virtual)
108 :
109 306 : CALL create_group_dist(gd_P, para_env_sub%num_pe, dimen_RI)
110 306 : CALL get_group_dist(gd_P, para_env_sub%mepos, my_P_start, my_P_end, my_P_size)
111 :
112 : ! create the blacs env
113 306 : NULLIFY (blacs_env)
114 306 : CALL cp_blacs_env_create(blacs_env=blacs_env, para_env=para_env)
115 :
116 306 : NULLIFY (fm_struct_ia)
117 : CALL cp_fm_struct_create(fm_struct_ia, context=blacs_env, nrow_global=dimen_ia, &
118 306 : ncol_global=dimen_RI, para_env=para_env)
119 :
120 : ! create the fm matrix Gamma
121 : CALL cp_array_to_fm(Gamma_2D, fm_struct_ia, my_ia_start, my_ia_end, my_group_L_start, my_group_L_end, &
122 306 : fm_Y)
123 : ! create the fm matrix B_ia_P
124 : CALL cp_array_to_fm(BIb_C_2D, fm_struct_ia, my_ia_start, my_ia_end, my_group_L_start, my_group_L_end, &
125 306 : fm_ia_P)
126 :
127 306 : NULLIFY (fm_struct_RI)
128 : CALL cp_fm_struct_create(fm_struct_RI, context=blacs_env, nrow_global=dimen_RI, &
129 306 : ncol_global=dimen_RI, para_env=para_env)
130 :
131 : ! since we will need (P|Q)^(-1/2) in the future, make a copy
132 : CALL cp_array_to_fm(mp2_env%ri_grad%PQ_half, fm_struct_RI, my_P_start, my_P_end, my_group_L_start, &
133 306 : my_group_L_end, PQ_half, do_release_mat=.FALSE.)
134 :
135 306 : IF (.NOT. compare_potential_types(mp2_env%ri_metric, mp2_env%potential_parameter)) THEN
136 : CALL cp_array_to_fm(mp2_env%ri_grad%operator_half, fm_struct_RI, my_P_start, my_P_end, &
137 8 : my_group_L_start, my_group_L_end, operator_half, do_release_mat=.FALSE.)
138 : END IF
139 :
140 : ! complete the gamma matrix Gamma_ia^P = sum_Q (Y_ia^Q * (Q|P)^(-1/2))
141 306 : IF (compare_potential_types(mp2_env%ri_metric, mp2_env%potential_parameter)) THEN
142 298 : CALL cp_fm_create(fm_Gamma, fm_struct_ia, name="fm_Gamma")
143 298 : CALL cp_fm_struct_release(fm_struct_ia)
144 : ! perform the matrix multiplication
145 : CALL parallel_gemm(transa="N", transb="T", m=dimen_ia, n=dimen_RI, k=dimen_RI, alpha=1.0_dp, &
146 : matrix_a=fm_Y, matrix_b=PQ_half, beta=0.0_dp, &
147 298 : matrix_c=fm_Gamma)
148 : ! release the Y matrix
149 298 : CALL cp_fm_release(fm_Y)
150 :
151 : ! complete gamma small (fm_Gamma_PQ)
152 : ! create temp matrix
153 298 : CALL cp_fm_create(fm_Gamma_PQ_temp, fm_struct_RI, name="fm_Gamma_PQ_temp")
154 : CALL parallel_gemm(transa="T", transb="N", m=dimen_RI, n=dimen_RI, k=dimen_ia, alpha=1.0_dp, &
155 : matrix_a=fm_Gamma, matrix_b=fm_ia_P, beta=0.0_dp, &
156 298 : matrix_c=fm_Gamma_PQ_temp)
157 298 : CALL cp_fm_release(fm_ia_P)
158 : ! create fm_Gamma_PQ matrix
159 298 : CALL cp_fm_create(fm_Gamma_PQ, fm_struct_RI, name="fm_Gamma_PQ")
160 298 : CALL cp_fm_struct_release(fm_struct_RI)
161 : ! perform matrix multiplication
162 : CALL parallel_gemm(transa="N", transb="T", m=dimen_RI, n=dimen_RI, k=dimen_RI, alpha=1.0_dp, &
163 : matrix_a=fm_Gamma_PQ_temp, matrix_b=PQ_half, beta=0.0_dp, &
164 298 : matrix_c=fm_Gamma_PQ)
165 298 : CALL cp_fm_release(fm_Gamma_PQ_temp)
166 298 : CALL cp_fm_release(PQ_half)
167 :
168 : ELSE
169 : ! create temp matrix
170 8 : CALL cp_fm_create(fm_Gamma_PQ_temp, fm_struct_RI, name="fm_Gamma_PQ_temp")
171 : CALL parallel_gemm(transa="T", transb="N", m=dimen_RI, n=dimen_RI, k=dimen_ia, alpha=1.0_dp, &
172 : matrix_a=fm_Y, matrix_b=fm_ia_P, beta=0.0_dp, &
173 8 : matrix_c=fm_Gamma_PQ_temp)
174 8 : CALL cp_fm_release(fm_ia_P)
175 :
176 8 : CALL cp_fm_create(fm_Gamma, fm_struct_ia, name="fm_Gamma")
177 8 : CALL cp_fm_struct_release(fm_struct_ia)
178 : ! perform the matrix multiplication
179 : CALL parallel_gemm(transa="N", transb="T", m=dimen_ia, n=dimen_RI, k=dimen_RI, alpha=1.0_dp, &
180 : matrix_a=fm_Y, matrix_b=PQ_half, beta=0.0_dp, &
181 8 : matrix_c=fm_Gamma)
182 8 : CALL cp_fm_release(fm_Y)
183 :
184 8 : CALL cp_fm_create(fm_Gamma_PQ_temp_2, fm_struct_RI, name="fm_Gamma_PQ_temp_2")
185 : CALL parallel_gemm(transa="N", transb="T", m=dimen_RI, n=dimen_RI, k=dimen_RI, alpha=1.0_dp, &
186 : matrix_a=fm_Gamma_PQ_temp, matrix_b=operator_half, beta=0.0_dp, &
187 8 : matrix_c=fm_Gamma_PQ_temp_2)
188 :
189 8 : CALL cp_fm_create(fm_Gamma_PQ_2, fm_struct_RI, name="fm_Gamma_PQ_2")
190 : CALL parallel_gemm(transa="N", transb="N", m=dimen_RI, n=dimen_RI, k=dimen_RI, alpha=1.0_dp, &
191 : matrix_a=PQ_half, matrix_b=fm_Gamma_PQ_temp_2, beta=0.0_dp, &
192 8 : matrix_c=fm_Gamma_PQ_temp)
193 8 : CALL cp_fm_to_fm(fm_Gamma_PQ_temp, fm_Gamma_PQ_2)
194 8 : CALL cp_fm_geadd(1.0_dp, "T", fm_Gamma_PQ_temp, 1.0_dp, fm_Gamma_PQ_2)
195 8 : CALL cp_fm_release(fm_Gamma_PQ_temp)
196 8 : CALL cp_fm_release(PQ_half)
197 :
198 8 : CALL cp_fm_create(fm_Gamma_PQ, fm_struct_RI)
199 8 : CALL cp_fm_struct_release(fm_struct_RI)
200 : CALL parallel_gemm(transa="N", transb="N", m=dimen_RI, n=dimen_RI, k=dimen_RI, alpha=-1.0_dp, &
201 : matrix_a=operator_half, matrix_b=fm_Gamma_PQ_temp_2, beta=0.0_dp, &
202 8 : matrix_c=fm_Gamma_PQ)
203 8 : CALL cp_fm_release(operator_half)
204 8 : CALL cp_fm_release(fm_Gamma_PQ_temp_2)
205 : END IF
206 :
207 : ! now redistribute the data, in this case we go back
208 : ! to the original way the integrals were distributed
209 306 : CALL cp_fm_to_array(Gamma_2D, my_ia_start, my_ia_end, my_group_L_start, my_group_L_end, fm_Gamma)
210 :
211 306 : CALL cp_fm_to_array(Gamma_PQ, my_P_start, my_P_end, my_group_L_start, my_group_L_end, fm_Gamma_PQ)
212 306 : IF (.NOT. ALLOCATED(mp2_env%ri_grad%Gamma_PQ)) THEN
213 228 : CALL MOVE_ALLOC(Gamma_PQ, mp2_env%ri_grad%Gamma_PQ)
214 : ELSE
215 313178 : mp2_env%ri_grad%Gamma_PQ(:, :) = mp2_env%ri_grad%Gamma_PQ + Gamma_PQ
216 78 : DEALLOCATE (Gamma_PQ)
217 : END IF
218 :
219 306 : IF (.NOT. compare_potential_types(mp2_env%ri_metric, mp2_env%potential_parameter)) THEN
220 8 : CALL cp_fm_to_array(Gamma_PQ, my_P_start, my_P_end, my_group_L_start, my_group_L_end, fm_Gamma_PQ_2)
221 8 : IF (.NOT. ALLOCATED(mp2_env%ri_grad%Gamma_PQ_2)) THEN
222 8 : CALL MOVE_ALLOC(Gamma_PQ, mp2_env%ri_grad%Gamma_PQ_2)
223 : ELSE
224 0 : mp2_env%ri_grad%Gamma_PQ_2(:, :) = mp2_env%ri_grad%Gamma_PQ_2 + Gamma_PQ
225 0 : DEALLOCATE (Gamma_PQ)
226 : END IF
227 : END IF
228 :
229 : ! allocate G_P_ia (DBCSR)
230 306 : IF (.NOT. ALLOCATED(mp2_env%ri_grad%G_P_ia)) THEN
231 228 : nspins = SIZE(mp2_env%ri_grad%mo_coeff_o)
232 14456 : ALLOCATE (mp2_env%ri_grad%G_P_ia(my_group_L_size, nspins))
233 534 : DO ispin = 1, nspins
234 13772 : DO kkB = 1, my_group_L_size
235 13544 : NULLIFY (mp2_env%ri_grad%G_P_ia(kkB, ispin)%matrix)
236 : END DO
237 : END DO
238 : END IF
239 :
240 : ! create the Gamma_ia_P in DBCSR style
241 : CALL cp_array_to_dbcsr_slices(Gamma_2D, homo, virtual, para_env_sub, my_ia_start, my_ia_end, &
242 : mp2_env%ri_grad%mo_coeff_o(1)%matrix, &
243 306 : matrix_ptrs=mp2_env%ri_grad%G_P_ia(:, kspin))
244 :
245 306 : CALL release_group_dist(gd_ia)
246 306 : CALL release_group_dist(gd_P)
247 :
248 : ! release blacs_env
249 306 : CALL cp_blacs_env_release(blacs_env)
250 :
251 306 : CALL timestop(handle)
252 :
253 612 : END SUBROUTINE complete_gamma
254 :
255 : ! **************************************************************************************************
256 : !> \brief Redistribute a 3d matrix to a 2d matrix
257 : !> \param B_ia_Q ...
258 : !> \param BIb_C_2D ...
259 : !> \param homo ...
260 : !> \param my_B_size ...
261 : !> \param virtual ...
262 : !> \param my_B_virtual_start ...
263 : !> \param my_ia_start ...
264 : !> \param my_ia_end ...
265 : !> \param my_ia_size ...
266 : !> \param my_group_L_size ...
267 : !> \param para_env_sub ...
268 : !> \param gd_B_virtual ...
269 : ! **************************************************************************************************
270 306 : SUBROUTINE mat_3d_to_2d(B_ia_Q, BIb_C_2D, homo, my_B_size, virtual, my_B_virtual_start, &
271 : my_ia_start, my_ia_end, my_ia_size, my_group_L_size, para_env_sub, gd_B_virtual)
272 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :), &
273 : INTENT(INOUT) :: B_ia_Q
274 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :), &
275 : INTENT(OUT) :: BIb_C_2D
276 : INTEGER, INTENT(IN) :: homo, my_B_size, virtual, &
277 : my_B_virtual_start, my_ia_start, &
278 : my_ia_end, my_ia_size, my_group_L_size
279 : TYPE(mp_para_env_type), INTENT(IN) :: para_env_sub
280 : TYPE(group_dist_d1_type), INTENT(IN) :: gd_B_virtual
281 :
282 : CHARACTER(LEN=*), PARAMETER :: routineN = 'mat_3d_to_2d'
283 :
284 : INTEGER :: handle, ia_global, iiB, jjB, proc_receive, proc_send, proc_shift, rec_B_size, &
285 : rec_B_virtual_end, rec_B_virtual_start
286 306 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: BIb_C_rec
287 :
288 306 : CALL timeset(routineN, handle)
289 :
290 1224 : ALLOCATE (BIb_C_2D(my_ia_size, my_group_L_size))
291 306 : BIb_C_2D = 0.0_dp
292 :
293 1408 : DO iiB = 1, homo
294 17332 : DO jjB = 1, my_B_size
295 15924 : ia_global = (iiB - 1)*virtual + my_B_virtual_start + jjB - 1
296 17026 : IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN
297 705851 : BIb_C_2D(ia_global - my_ia_start + 1, :) = B_ia_Q(iiB, jjB, 1:my_group_L_size)
298 : END IF
299 : END DO
300 : END DO
301 :
302 314 : DO proc_shift = 1, para_env_sub%num_pe - 1
303 8 : proc_send = MODULO(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
304 8 : proc_receive = MODULO(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
305 :
306 8 : CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size)
307 :
308 40 : ALLOCATE (BIb_C_rec(homo, rec_B_size, my_group_L_size))
309 8 : BIb_C_rec = 0.0_dp
310 :
311 : CALL para_env_sub%sendrecv(B_ia_Q, proc_send, &
312 8 : BIb_C_rec, proc_receive)
313 :
314 48 : DO iiB = 1, homo
315 438 : DO jjB = 1, rec_B_size
316 390 : ia_global = (iiB - 1)*virtual + rec_B_virtual_start + jjB - 1
317 430 : IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN
318 17373 : BIb_C_2D(ia_global - my_ia_start + 1, :) = BIb_C_rec(iiB, jjB, 1:my_group_L_size)
319 : END IF
320 : END DO
321 : END DO
322 :
323 322 : DEALLOCATE (BIb_C_rec)
324 : END DO
325 306 : DEALLOCATE (B_ia_Q)
326 :
327 306 : CALL timestop(handle)
328 612 : END SUBROUTINE mat_3d_to_2d
329 :
330 : ! **************************************************************************************************
331 : !> \brief Redistribute a 3d matrix to a 2d matrix, specialized for Gamma_P_ia to account for a different order of indices
332 : !> \param B_ia_Q ...
333 : !> \param BIb_C_2D ...
334 : !> \param homo ...
335 : !> \param my_B_size ...
336 : !> \param virtual ...
337 : !> \param my_B_virtual_start ...
338 : !> \param my_ia_start ...
339 : !> \param my_ia_end ...
340 : !> \param my_ia_size ...
341 : !> \param my_group_L_size ...
342 : !> \param para_env_sub ...
343 : !> \param gd_B_virtual ...
344 : ! **************************************************************************************************
345 306 : SUBROUTINE mat_3d_to_2d_gamma(B_ia_Q, BIb_C_2D, homo, my_B_size, virtual, my_B_virtual_start, &
346 : my_ia_start, my_ia_end, my_ia_size, my_group_L_size, para_env_sub, gd_B_virtual)
347 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :), &
348 : INTENT(INOUT) :: B_ia_Q
349 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :), &
350 : INTENT(OUT) :: BIb_C_2D
351 : INTEGER, INTENT(IN) :: homo, my_B_size, virtual, &
352 : my_B_virtual_start, my_ia_start, &
353 : my_ia_end, my_ia_size, my_group_L_size
354 : TYPE(mp_para_env_type), INTENT(IN) :: para_env_sub
355 : TYPE(group_dist_d1_type), INTENT(IN) :: gd_B_virtual
356 :
357 : CHARACTER(LEN=*), PARAMETER :: routineN = 'mat_3d_to_2d_gamma'
358 :
359 : INTEGER :: handle, ia_global, iiB, jjB, proc_receive, proc_send, proc_shift, rec_B_size, &
360 : rec_B_virtual_end, rec_B_virtual_start
361 306 : REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :, :) :: BIb_C_rec
362 :
363 306 : CALL timeset(routineN, handle)
364 :
365 1224 : ALLOCATE (BIb_C_2D(my_ia_size, my_group_L_size))
366 306 : BIb_C_2D = 0.0_dp
367 :
368 1408 : DO iiB = 1, homo
369 17332 : DO jjB = 1, my_B_size
370 15924 : ia_global = (iiB - 1)*virtual + my_B_virtual_start + jjB - 1
371 17026 : IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN
372 705851 : BIb_C_2D(ia_global - my_ia_start + 1, :) = B_ia_Q(jjB, iiB, 1:my_group_L_size)
373 : END IF
374 : END DO
375 : END DO
376 :
377 314 : DO proc_shift = 1, para_env_sub%num_pe - 1
378 8 : proc_send = MODULO(para_env_sub%mepos + proc_shift, para_env_sub%num_pe)
379 8 : proc_receive = MODULO(para_env_sub%mepos - proc_shift, para_env_sub%num_pe)
380 :
381 8 : CALL get_group_dist(gd_B_virtual, proc_receive, rec_B_virtual_start, rec_B_virtual_end, rec_B_size)
382 :
383 40 : ALLOCATE (BIb_C_rec(rec_B_size, homo, my_group_L_size))
384 8 : BIb_C_rec = 0.0_dp
385 :
386 : CALL para_env_sub%sendrecv(B_ia_Q, proc_send, &
387 8 : BIb_C_rec, proc_receive)
388 :
389 48 : DO iiB = 1, homo
390 438 : DO jjB = 1, rec_B_size
391 390 : ia_global = (iiB - 1)*virtual + rec_B_virtual_start + jjB - 1
392 430 : IF (ia_global >= my_ia_start .AND. ia_global <= my_ia_end) THEN
393 17373 : BIb_C_2D(ia_global - my_ia_start + 1, :) = BIb_C_rec(jjB, iiB, 1:my_group_L_size)
394 : END IF
395 : END DO
396 : END DO
397 :
398 322 : DEALLOCATE (BIb_C_rec)
399 : END DO
400 306 : DEALLOCATE (B_ia_Q)
401 :
402 306 : CALL timestop(handle)
403 612 : END SUBROUTINE mat_3d_to_2d_gamma
404 :
405 : END MODULE mp2_ri_grad_util
|