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