Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief wrapper for the pools of matrixes
10 : !> \par History
11 : !> 05.2003 created [fawzi]
12 : !> \author fawzi
13 : ! **************************************************************************************************
14 : MODULE qs_matrix_pools
15 : USE cp_blacs_env, ONLY: cp_blacs_env_type
16 : USE cp_fm_pool_types, ONLY: cp_fm_pool_p_type,&
17 : cp_fm_pool_type,&
18 : fm_pool_create,&
19 : fm_pool_get_el_struct,&
20 : fm_pool_release,&
21 : fm_pool_retain,&
22 : fm_pools_dealloc
23 : USE cp_fm_struct, ONLY: cp_fm_struct_create,&
24 : cp_fm_struct_get,&
25 : cp_fm_struct_get_ncol_block,&
26 : cp_fm_struct_get_nrow_block,&
27 : cp_fm_struct_release,&
28 : cp_fm_struct_type
29 : USE message_passing, ONLY: mp_para_env_type
30 : USE qs_mo_types, ONLY: get_mo_set,&
31 : mo_set_type
32 : #include "./base/base_uses.f90"
33 :
34 : IMPLICIT NONE
35 : PRIVATE
36 :
37 : LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
38 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'qs_matrix_pools'
39 :
40 : PUBLIC :: qs_matrix_pools_type
41 : PUBLIC :: mpools_retain, mpools_release, mpools_get, &
42 : mpools_create, mpools_rebuild_fm_pools
43 :
44 : ! **************************************************************************************************
45 : !> \brief container for the pools of matrixes used by qs
46 : !> \param ref_count reference count (see doc/ReferenceCounting.html)
47 : !> \param ao_mo_fm_pools pools with (ao x mo) full matrixes (same order as
48 : !> c).
49 : !> \param ao_ao_fm_pools pools with (ao x ao) full matrixes (same order as
50 : !> c).
51 : !> \param mo_mo_fm_pools pools with (mo x mo) full matrixes (same
52 : !> order as c).
53 : !> \param ao_mosub_fm_pools pools with (ao x mosub) full matrixes, where mosub
54 : !> are a subset of the mos
55 : !> \param mosub_mosub_fm_pools pools with (mosub x mosub) full matrixes, where mosub
56 : !> are a subset of the mos
57 : !>
58 : !> \param maxao_maxao_fm_pools pool of matrixes big enough to accommodate any
59 : !> aoxao matrix (useful for temp matrixes)
60 : !> \param maxao_maxmo_fm_pools pool of matrixes big enough to accommodate any
61 : !> aoxmo matrix (useful for temp matrixes)
62 : !> \param maxmo_maxmo_fm_pools pool of matrixes big enough to accommodate any
63 : !> moxmo matrix (useful for temp matrixes)
64 : !> \par History
65 : !> 04.2003 created [fawzi]
66 : !> \author fawzi
67 : ! **************************************************************************************************
68 : TYPE qs_matrix_pools_type
69 : INTEGER :: ref_count
70 : TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER :: ao_mo_fm_pools, &
71 : ao_ao_fm_pools, mo_mo_fm_pools
72 : TYPE(cp_fm_pool_p_type), DIMENSION(:), POINTER :: ao_mosub_fm_pools, &
73 : mosub_mosub_fm_pools
74 : END TYPE qs_matrix_pools_type
75 :
76 : CONTAINS
77 :
78 : ! **************************************************************************************************
79 : !> \brief retains the given qs_matrix_pools_type
80 : !> \param mpools the matrix pools type to retain
81 : !> \par History
82 : !> 04.2003 created [fawzi]
83 : !> \author fawzi
84 : ! **************************************************************************************************
85 0 : SUBROUTINE mpools_retain(mpools)
86 : TYPE(qs_matrix_pools_type), POINTER :: mpools
87 :
88 0 : CPASSERT(ASSOCIATED(mpools))
89 0 : CPASSERT(mpools%ref_count > 0)
90 0 : mpools%ref_count = mpools%ref_count + 1
91 0 : END SUBROUTINE mpools_retain
92 :
93 : ! **************************************************************************************************
94 : !> \brief releases the given mpools
95 : !> \param mpools the matrix pools type to retain
96 : !> \par History
97 : !> 04.2003 created [fawzi]
98 : !> \author fawzi
99 : ! **************************************************************************************************
100 19880 : SUBROUTINE mpools_release(mpools)
101 : TYPE(qs_matrix_pools_type), POINTER :: mpools
102 :
103 19880 : IF (ASSOCIATED(mpools)) THEN
104 6460 : CPASSERT(mpools%ref_count > 0)
105 6460 : mpools%ref_count = mpools%ref_count - 1
106 6460 : IF (mpools%ref_count == 0) THEN
107 6460 : CALL fm_pools_dealloc(mpools%ao_mo_fm_pools)
108 6460 : CALL fm_pools_dealloc(mpools%ao_ao_fm_pools)
109 6460 : CALL fm_pools_dealloc(mpools%mo_mo_fm_pools)
110 6460 : IF (ASSOCIATED(mpools%ao_mosub_fm_pools)) THEN
111 0 : CALL fm_pools_dealloc(mpools%ao_mosub_fm_pools)
112 : END IF
113 6460 : IF (ASSOCIATED(mpools%mosub_mosub_fm_pools)) THEN
114 0 : CALL fm_pools_dealloc(mpools%mosub_mosub_fm_pools)
115 : END IF
116 6460 : DEALLOCATE (mpools)
117 : END IF
118 : END IF
119 19880 : NULLIFY (mpools)
120 19880 : END SUBROUTINE mpools_release
121 :
122 : ! **************************************************************************************************
123 : !> \brief returns various attributes of the mpools (notably the pools
124 : !> contained in it)
125 : !> \param mpools the matrix pools object you want info about
126 : !> \param ao_mo_fm_pools ...
127 : !> \param ao_ao_fm_pools ...
128 : !> \param mo_mo_fm_pools ...
129 : !> \param ao_mosub_fm_pools ...
130 : !> \param mosub_mosub_fm_pools ...
131 : !> \param maxao_maxmo_fm_pool ...
132 : !> \param maxao_maxao_fm_pool ...
133 : !> \param maxmo_maxmo_fm_pool ...
134 : !> \par History
135 : !> 04.2003 created [fawzi]
136 : !> \author fawzi
137 : ! **************************************************************************************************
138 93797 : SUBROUTINE mpools_get(mpools, ao_mo_fm_pools, ao_ao_fm_pools, &
139 : mo_mo_fm_pools, ao_mosub_fm_pools, mosub_mosub_fm_pools, &
140 : maxao_maxmo_fm_pool, maxao_maxao_fm_pool, maxmo_maxmo_fm_pool)
141 : TYPE(qs_matrix_pools_type), INTENT(IN) :: mpools
142 : TYPE(cp_fm_pool_p_type), DIMENSION(:), OPTIONAL, &
143 : POINTER :: ao_mo_fm_pools, ao_ao_fm_pools, &
144 : mo_mo_fm_pools, ao_mosub_fm_pools, &
145 : mosub_mosub_fm_pools
146 : TYPE(cp_fm_pool_type), OPTIONAL, POINTER :: maxao_maxmo_fm_pool, &
147 : maxao_maxao_fm_pool, &
148 : maxmo_maxmo_fm_pool
149 :
150 93797 : IF (PRESENT(ao_mo_fm_pools)) ao_mo_fm_pools => mpools%ao_mo_fm_pools
151 93797 : IF (PRESENT(maxao_maxmo_fm_pool)) THEN
152 11731 : IF (ASSOCIATED(mpools%ao_mo_fm_pools)) THEN
153 11731 : maxao_maxmo_fm_pool => mpools%ao_mo_fm_pools(1)%pool
154 : ELSE
155 0 : NULLIFY (maxao_maxmo_fm_pool) ! raise an error?
156 : END IF
157 : END IF
158 93797 : IF (PRESENT(ao_ao_fm_pools)) ao_ao_fm_pools => mpools%ao_ao_fm_pools
159 93797 : IF (PRESENT(maxao_maxao_fm_pool)) THEN
160 0 : IF (ASSOCIATED(mpools%ao_ao_fm_pools)) THEN
161 0 : maxao_maxao_fm_pool => mpools%ao_ao_fm_pools(1)%pool
162 : ELSE
163 0 : NULLIFY (maxao_maxao_fm_pool) ! raise an error?
164 : END IF
165 : END IF
166 93797 : IF (PRESENT(mo_mo_fm_pools)) mo_mo_fm_pools => mpools%mo_mo_fm_pools
167 93797 : IF (PRESENT(maxmo_maxmo_fm_pool)) THEN
168 1092 : IF (ASSOCIATED(mpools%mo_mo_fm_pools)) THEN
169 1092 : maxmo_maxmo_fm_pool => mpools%mo_mo_fm_pools(1)%pool
170 : ELSE
171 0 : NULLIFY (maxmo_maxmo_fm_pool) ! raise an error?
172 : END IF
173 : END IF
174 93797 : IF (PRESENT(ao_mosub_fm_pools)) ao_mosub_fm_pools => mpools%ao_mosub_fm_pools
175 93797 : IF (PRESENT(mosub_mosub_fm_pools)) mosub_mosub_fm_pools => mpools%mosub_mosub_fm_pools
176 93797 : END SUBROUTINE mpools_get
177 :
178 : ! **************************************************************************************************
179 : !> \brief creates a mpools
180 : !> \param mpools the mpools to create
181 : !> \par History
182 : !> 04.2003 created [fawzi]
183 : !> \author fawzi
184 : ! **************************************************************************************************
185 6460 : SUBROUTINE mpools_create(mpools)
186 : TYPE(qs_matrix_pools_type), POINTER :: mpools
187 :
188 6460 : ALLOCATE (mpools)
189 6460 : NULLIFY (mpools%ao_ao_fm_pools, mpools%ao_mo_fm_pools, &
190 6460 : mpools%mo_mo_fm_pools, mpools%ao_mosub_fm_pools, &
191 6460 : mpools%mosub_mosub_fm_pools)
192 6460 : mpools%ref_count = 1
193 6460 : END SUBROUTINE mpools_create
194 :
195 : ! **************************************************************************************************
196 : !> \brief rebuilds the pools of the (ao x mo, ao x ao , mo x mo) full matrixes
197 : !> \param mpools the environment where the pools should be rebuilt
198 : !> \param mos the molecular orbitals (qs_env%c), must contain up to
199 : !> date nmo and nao
200 : !> \param blacs_env the blacs environment of the full matrixes
201 : !> \param para_env the parallel environment of the matrixes
202 : !> \param nmosub number of the orbitals for the creation
203 : !> of the pools containing only a subset of mos (OPTIONAL)
204 : !> \par History
205 : !> 08.2002 created [fawzi]
206 : !> 04.2005 added pools for a subset of mos [MI]
207 : !> \author Fawzi Mohamed
208 : ! **************************************************************************************************
209 6464 : SUBROUTINE mpools_rebuild_fm_pools(mpools, mos, blacs_env, para_env, &
210 : nmosub)
211 : TYPE(qs_matrix_pools_type), POINTER :: mpools
212 : TYPE(mo_set_type), DIMENSION(:), INTENT(IN) :: mos
213 : TYPE(cp_blacs_env_type), POINTER :: blacs_env
214 : TYPE(mp_para_env_type), POINTER :: para_env
215 : INTEGER, DIMENSION(2), INTENT(IN), OPTIONAL :: nmosub
216 :
217 : CHARACTER(len=*), PARAMETER :: routineN = 'mpools_rebuild_fm_pools'
218 :
219 : INTEGER :: handle, ispin, max_nmo, min_nmo, nao, &
220 : ncg, ncol_block, nmo, nrg, nrow_block, &
221 : nspins
222 : LOGICAL :: prepare_subset, should_rebuild
223 : TYPE(cp_fm_pool_type), POINTER :: p_att
224 : TYPE(cp_fm_struct_type), POINTER :: fmstruct
225 :
226 6464 : CALL timeset(routineN, handle)
227 :
228 6464 : nrow_block = cp_fm_struct_get_nrow_block()
229 6464 : ncol_block = cp_fm_struct_get_ncol_block()
230 :
231 6464 : NULLIFY (fmstruct, p_att)
232 6464 : prepare_subset = .FALSE.
233 6464 : IF (PRESENT(nmosub)) THEN
234 0 : IF (nmosub(1) > 0) prepare_subset = .TRUE.
235 : END IF
236 :
237 6464 : IF (.NOT. ASSOCIATED(mpools)) THEN
238 6220 : CALL mpools_create(mpools)
239 : END IF
240 6464 : nspins = SIZE(mos)
241 :
242 6464 : IF (ASSOCIATED(mpools%ao_mo_fm_pools)) THEN
243 4 : IF (nspins /= SIZE(mpools%ao_mo_fm_pools)) THEN
244 0 : CALL fm_pools_dealloc(mpools%ao_mo_fm_pools)
245 : END IF
246 : END IF
247 6464 : IF (.NOT. ASSOCIATED(mpools%ao_mo_fm_pools)) THEN
248 27337 : ALLOCATE (mpools%ao_mo_fm_pools(nspins))
249 14417 : DO ispin = 1, nspins
250 14417 : NULLIFY (mpools%ao_mo_fm_pools(ispin)%pool)
251 : END DO
252 : END IF
253 :
254 6464 : IF (ASSOCIATED(mpools%ao_ao_fm_pools)) THEN
255 4 : IF (nspins /= SIZE(mpools%ao_ao_fm_pools)) THEN
256 0 : CALL fm_pools_dealloc(mpools%ao_ao_fm_pools)
257 : END IF
258 : END IF
259 6464 : IF (.NOT. ASSOCIATED(mpools%ao_ao_fm_pools)) THEN
260 27337 : ALLOCATE (mpools%ao_ao_fm_pools(nspins))
261 14417 : DO ispin = 1, nspins
262 14417 : NULLIFY (mpools%ao_ao_fm_pools(ispin)%pool)
263 : END DO
264 : END IF
265 :
266 6464 : IF (ASSOCIATED(mpools%mo_mo_fm_pools)) THEN
267 4 : IF (nspins /= SIZE(mpools%mo_mo_fm_pools)) THEN
268 0 : CALL fm_pools_dealloc(mpools%mo_mo_fm_pools)
269 : END IF
270 : END IF
271 6464 : IF (.NOT. ASSOCIATED(mpools%mo_mo_fm_pools)) THEN
272 27337 : ALLOCATE (mpools%mo_mo_fm_pools(nspins))
273 14417 : DO ispin = 1, nspins
274 14417 : NULLIFY (mpools%mo_mo_fm_pools(ispin)%pool)
275 : END DO
276 : END IF
277 :
278 6464 : IF (prepare_subset) THEN
279 :
280 0 : IF (ASSOCIATED(mpools%ao_mosub_fm_pools)) THEN
281 0 : IF (nspins /= SIZE(mpools%ao_mosub_fm_pools)) THEN
282 0 : CALL fm_pools_dealloc(mpools%ao_mosub_fm_pools)
283 : END IF
284 : END IF
285 0 : IF (.NOT. ASSOCIATED(mpools%ao_mosub_fm_pools)) THEN
286 0 : ALLOCATE (mpools%ao_mosub_fm_pools(nspins))
287 0 : DO ispin = 1, nspins
288 0 : NULLIFY (mpools%ao_mosub_fm_pools(ispin)%pool)
289 : END DO
290 : END IF
291 :
292 0 : IF (ASSOCIATED(mpools%mosub_mosub_fm_pools)) THEN
293 0 : IF (nspins /= SIZE(mpools%mosub_mosub_fm_pools)) THEN
294 0 : CALL fm_pools_dealloc(mpools%mosub_mosub_fm_pools)
295 : END IF
296 : END IF
297 0 : IF (.NOT. ASSOCIATED(mpools%mosub_mosub_fm_pools)) THEN
298 0 : ALLOCATE (mpools%mosub_mosub_fm_pools(nspins))
299 0 : DO ispin = 1, nspins
300 0 : NULLIFY (mpools%mosub_mosub_fm_pools(ispin)%pool)
301 : END DO
302 : END IF
303 :
304 : END IF ! prepare_subset
305 :
306 6464 : CALL get_mo_set(mos(1), nao=nao, nmo=min_nmo)
307 6464 : max_nmo = min_nmo
308 7961 : DO ispin = 2, SIZE(mos)
309 1497 : CALL get_mo_set(mos(ispin), nmo=nmo)
310 1497 : IF (max_nmo < nmo) THEN
311 0 : CPABORT("the mo with the most orbitals must be the first ")
312 : END IF
313 9458 : min_nmo = MIN(min_nmo, nmo)
314 : END DO
315 :
316 : ! aoao pools
317 14425 : should_rebuild = .FALSE.
318 14425 : DO ispin = 1, nspins
319 7961 : p_att => mpools%ao_ao_fm_pools(ispin)%pool
320 7961 : should_rebuild = (should_rebuild .OR. (.NOT. ASSOCIATED(p_att)))
321 14425 : IF (.NOT. should_rebuild) THEN
322 4 : fmstruct => fm_pool_get_el_struct(mpools%ao_ao_fm_pools(ispin)%pool)
323 : CALL cp_fm_struct_get(fmstruct, nrow_global=nrg, &
324 4 : ncol_global=ncg)
325 4 : CALL get_mo_set(mos(1), nao=nao, nmo=nmo)
326 4 : should_rebuild = nao /= nrg .OR. nao /= ncg
327 : END IF
328 : END DO
329 6464 : IF (should_rebuild) THEN
330 14417 : DO ispin = 1, nspins
331 14417 : CALL fm_pool_release(mpools%ao_ao_fm_pools(ispin)%pool)
332 : END DO
333 :
334 : CALL cp_fm_struct_create(fmstruct, nrow_global=nao, &
335 : ncol_global=nao, para_env=para_env, &
336 : context=blacs_env, &
337 : nrow_block=nrow_block, &
338 6460 : ncol_block=ncol_block)
339 6460 : CALL fm_pool_create(mpools%ao_ao_fm_pools(1)%pool, fmstruct)
340 6460 : CALL cp_fm_struct_release(fmstruct)
341 7957 : DO ispin = 2, SIZE(mos)
342 1497 : mpools%ao_ao_fm_pools(ispin)%pool => mpools%ao_ao_fm_pools(1)%pool
343 7957 : CALL fm_pool_retain(mpools%ao_ao_fm_pools(1)%pool)
344 : END DO
345 : END IF
346 :
347 : ! aomo pools
348 : should_rebuild = .FALSE.
349 14425 : DO ispin = 1, nspins
350 7961 : p_att => mpools%ao_mo_fm_pools(ispin)%pool
351 7961 : should_rebuild = (should_rebuild .OR. (.NOT. ASSOCIATED(p_att)))
352 14425 : IF (.NOT. should_rebuild) THEN
353 : fmstruct => fm_pool_get_el_struct(mpools%ao_mo_fm_pools(ispin) &
354 4 : %pool)
355 : CALL cp_fm_struct_get(fmstruct, nrow_global=nrg, &
356 4 : ncol_global=ncg)
357 4 : CALL get_mo_set(mos(1), nao=nao, nmo=nmo)
358 4 : should_rebuild = nao /= nrg .OR. nmo /= ncg
359 : END IF
360 : END DO
361 6464 : IF (should_rebuild) THEN
362 14417 : DO ispin = 1, nspins
363 14417 : CALL fm_pool_release(mpools%ao_mo_fm_pools(ispin)%pool)
364 : END DO
365 :
366 6460 : IF (max_nmo == min_nmo) THEN
367 : CALL cp_fm_struct_create(fmstruct, nrow_global=nao, &
368 : ncol_global=max_nmo, para_env=para_env, &
369 : context=blacs_env, &
370 : nrow_block=nrow_block, &
371 5635 : ncol_block=ncol_block)
372 5635 : CALL fm_pool_create(mpools%ao_mo_fm_pools(1)%pool, fmstruct)
373 5635 : CALL cp_fm_struct_release(fmstruct)
374 6307 : DO ispin = 2, SIZE(mos)
375 672 : mpools%ao_mo_fm_pools(ispin)%pool => mpools%ao_mo_fm_pools(1)%pool
376 6307 : CALL fm_pool_retain(mpools%ao_mo_fm_pools(1)%pool)
377 : END DO
378 : ELSE
379 2475 : DO ispin = 1, SIZE(mos)
380 1650 : CALL get_mo_set(mos(ispin), nmo=nmo, nao=nao)
381 : CALL cp_fm_struct_create(fmstruct, nrow_global=nao, &
382 : ncol_global=nmo, para_env=para_env, &
383 : context=blacs_env, &
384 : nrow_block=nrow_block, &
385 1650 : ncol_block=ncol_block)
386 : CALL fm_pool_create(mpools%ao_mo_fm_pools(ispin)%pool, &
387 1650 : fmstruct)
388 4125 : CALL cp_fm_struct_release(fmstruct)
389 : END DO
390 : END IF
391 : END IF
392 :
393 : ! momo pools
394 : should_rebuild = .FALSE.
395 14425 : DO ispin = 1, nspins
396 7961 : p_att => mpools%mo_mo_fm_pools(ispin)%pool
397 7961 : should_rebuild = (should_rebuild .OR. (.NOT. ASSOCIATED(p_att)))
398 14425 : IF (.NOT. should_rebuild) THEN
399 4 : fmstruct => fm_pool_get_el_struct(p_att)
400 : CALL cp_fm_struct_get(fmstruct, nrow_global=nrg, &
401 4 : ncol_global=ncg)
402 4 : CALL get_mo_set(mos(1), nao=nao, nmo=nmo)
403 4 : should_rebuild = nmo /= nrg .OR. nmo /= ncg
404 : END IF
405 : END DO
406 6464 : IF (should_rebuild) THEN
407 14417 : DO ispin = 1, nspins
408 14417 : CALL fm_pool_release(mpools%mo_mo_fm_pools(ispin)%pool)
409 : END DO
410 :
411 6460 : IF (max_nmo == min_nmo) THEN
412 : CALL cp_fm_struct_create(fmstruct, nrow_global=max_nmo, &
413 : ncol_global=max_nmo, para_env=para_env, &
414 : context=blacs_env, &
415 : nrow_block=nrow_block, &
416 5635 : ncol_block=ncol_block)
417 : CALL fm_pool_create(mpools%mo_mo_fm_pools(1)%pool, &
418 5635 : fmstruct)
419 5635 : CALL cp_fm_struct_release(fmstruct)
420 6307 : DO ispin = 2, SIZE(mos)
421 672 : mpools%mo_mo_fm_pools(ispin)%pool => mpools%mo_mo_fm_pools(1)%pool
422 6307 : CALL fm_pool_retain(mpools%mo_mo_fm_pools(1)%pool)
423 : END DO
424 : ELSE
425 2475 : DO ispin = 1, SIZE(mos)
426 1650 : NULLIFY (mpools%mo_mo_fm_pools(ispin)%pool)
427 1650 : CALL get_mo_set(mos(ispin), nmo=nmo, nao=nao)
428 : CALL cp_fm_struct_create(fmstruct, nrow_global=nmo, &
429 : ncol_global=nmo, para_env=para_env, &
430 : context=blacs_env, &
431 : nrow_block=nrow_block, &
432 1650 : ncol_block=ncol_block)
433 : CALL fm_pool_create(mpools%mo_mo_fm_pools(ispin)%pool, &
434 1650 : fmstruct)
435 4125 : CALL cp_fm_struct_release(fmstruct)
436 : END DO
437 : END IF
438 : END IF
439 :
440 6464 : IF (prepare_subset) THEN
441 : ! aomosub pools
442 : should_rebuild = .FALSE.
443 0 : DO ispin = 1, nspins
444 0 : p_att => mpools%ao_mosub_fm_pools(ispin)%pool
445 0 : should_rebuild = (should_rebuild .OR. (.NOT. ASSOCIATED(p_att)))
446 0 : IF (.NOT. should_rebuild) THEN
447 : fmstruct => fm_pool_get_el_struct(mpools%ao_mosub_fm_pools(ispin) &
448 0 : %pool)
449 : CALL cp_fm_struct_get(fmstruct, nrow_global=nrg, &
450 0 : ncol_global=ncg)
451 0 : CALL get_mo_set(mos(1), nao=nao)
452 0 : should_rebuild = nao /= nrg .OR. nmosub(ispin) /= ncg
453 : END IF
454 : END DO
455 0 : IF (should_rebuild) THEN
456 0 : DO ispin = 1, nspins
457 0 : CALL fm_pool_release(mpools%ao_mosub_fm_pools(ispin)%pool)
458 : END DO
459 :
460 0 : IF (nspins == 1 .OR. nmosub(1) == nmosub(2)) THEN
461 : CALL cp_fm_struct_create(fmstruct, nrow_global=nao, &
462 : ncol_global=nmosub(1), para_env=para_env, &
463 : context=blacs_env, &
464 : nrow_block=nrow_block, &
465 0 : ncol_block=ncol_block)
466 0 : CALL fm_pool_create(mpools%ao_mosub_fm_pools(1)%pool, fmstruct)
467 0 : CALL cp_fm_struct_release(fmstruct)
468 0 : DO ispin = 2, SIZE(mos)
469 0 : mpools%ao_mosub_fm_pools(ispin)%pool => mpools%ao_mosub_fm_pools(1)%pool
470 0 : CALL fm_pool_retain(mpools%ao_mosub_fm_pools(1)%pool)
471 : END DO
472 : ELSE
473 0 : DO ispin = 1, SIZE(mos)
474 0 : CALL get_mo_set(mos(ispin), nao=nao)
475 : CALL cp_fm_struct_create(fmstruct, nrow_global=nao, &
476 : ncol_global=nmosub(1), para_env=para_env, &
477 : context=blacs_env, &
478 : nrow_block=nrow_block, &
479 0 : ncol_block=ncol_block)
480 : CALL fm_pool_create(mpools%ao_mosub_fm_pools(ispin)%pool, &
481 0 : fmstruct)
482 0 : CALL cp_fm_struct_release(fmstruct)
483 : END DO
484 : END IF
485 : END IF ! should_rebuild
486 :
487 : ! mosubmosub pools
488 : should_rebuild = .FALSE.
489 0 : DO ispin = 1, nspins
490 0 : p_att => mpools%mosub_mosub_fm_pools(ispin)%pool
491 0 : should_rebuild = (should_rebuild .OR. (.NOT. ASSOCIATED(p_att)))
492 0 : IF (.NOT. should_rebuild) THEN
493 0 : fmstruct => fm_pool_get_el_struct(p_att)
494 : CALL cp_fm_struct_get(fmstruct, nrow_global=nrg, &
495 0 : ncol_global=ncg)
496 0 : should_rebuild = nmosub(ispin) /= nrg .OR. nmosub(ispin) /= ncg
497 : END IF
498 : END DO
499 0 : IF (should_rebuild) THEN
500 0 : DO ispin = 1, nspins
501 0 : CALL fm_pool_release(mpools%mosub_mosub_fm_pools(ispin)%pool)
502 : END DO
503 :
504 0 : IF (nspins == 1 .OR. nmosub(1) == nmosub(2)) THEN
505 : CALL cp_fm_struct_create(fmstruct, nrow_global=nmosub(1), &
506 : ncol_global=nmosub(1), para_env=para_env, &
507 : context=blacs_env, &
508 : nrow_block=nrow_block, &
509 0 : ncol_block=ncol_block)
510 : CALL fm_pool_create(mpools%mosub_mosub_fm_pools(1)%pool, &
511 0 : fmstruct)
512 0 : CALL cp_fm_struct_release(fmstruct)
513 0 : DO ispin = 2, SIZE(mos)
514 0 : mpools%mosub_mosub_fm_pools(ispin)%pool => mpools%mosub_mosub_fm_pools(1)%pool
515 0 : CALL fm_pool_retain(mpools%mosub_mosub_fm_pools(1)%pool)
516 : END DO
517 : ELSE
518 0 : DO ispin = 1, SIZE(mos)
519 0 : NULLIFY (mpools%mosub_mosub_fm_pools(ispin)%pool)
520 : CALL cp_fm_struct_create(fmstruct, nrow_global=nmosub(ispin), &
521 : ncol_global=nmosub(ispin), para_env=para_env, &
522 : context=blacs_env, &
523 : nrow_block=nrow_block, &
524 0 : ncol_block=ncol_block)
525 : CALL fm_pool_create(mpools%mosub_mosub_fm_pools(ispin)%pool, &
526 0 : fmstruct)
527 0 : CALL cp_fm_struct_release(fmstruct)
528 : END DO
529 : END IF
530 : END IF ! should_rebuild
531 : END IF ! prepare_subset
532 :
533 6464 : CALL timestop(handle)
534 6464 : END SUBROUTINE mpools_rebuild_fm_pools
535 :
536 : ! **************************************************************************************************
537 :
538 0 : END MODULE qs_matrix_pools
|
