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 20364 : SUBROUTINE mpools_release(mpools)
99 : TYPE(qs_matrix_pools_type), POINTER :: mpools
100 :
101 20364 : IF (ASSOCIATED(mpools)) THEN
102 6600 : CPASSERT(mpools%ref_count > 0)
103 6600 : mpools%ref_count = mpools%ref_count - 1
104 6600 : IF (mpools%ref_count == 0) THEN
105 6600 : CALL fm_pools_dealloc(mpools%ao_mo_fm_pools)
106 6600 : CALL fm_pools_dealloc(mpools%ao_ao_fm_pools)
107 6600 : CALL fm_pools_dealloc(mpools%mo_mo_fm_pools)
108 6600 : IF (ASSOCIATED(mpools%ao_mosub_fm_pools)) THEN
109 0 : CALL fm_pools_dealloc(mpools%ao_mosub_fm_pools)
110 : END IF
111 6600 : IF (ASSOCIATED(mpools%mosub_mosub_fm_pools)) THEN
112 0 : CALL fm_pools_dealloc(mpools%mosub_mosub_fm_pools)
113 : END IF
114 6600 : DEALLOCATE (mpools)
115 : END IF
116 : END IF
117 20364 : NULLIFY (mpools)
118 20364 : 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 97921 : 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 97921 : IF (PRESENT(ao_mo_fm_pools)) ao_mo_fm_pools => mpools%ao_mo_fm_pools
149 97921 : IF (PRESENT(maxao_maxmo_fm_pool)) THEN
150 12357 : IF (ASSOCIATED(mpools%ao_mo_fm_pools)) THEN
151 12357 : 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 97921 : IF (PRESENT(ao_ao_fm_pools)) ao_ao_fm_pools => mpools%ao_ao_fm_pools
157 97921 : 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 97921 : IF (PRESENT(mo_mo_fm_pools)) mo_mo_fm_pools => mpools%mo_mo_fm_pools
165 97921 : 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 97921 : IF (PRESENT(ao_mosub_fm_pools)) ao_mosub_fm_pools => mpools%ao_mosub_fm_pools
173 97921 : IF (PRESENT(mosub_mosub_fm_pools)) mosub_mosub_fm_pools => mpools%mosub_mosub_fm_pools
174 97921 : 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 6600 : SUBROUTINE mpools_create(mpools)
184 : TYPE(qs_matrix_pools_type), POINTER :: mpools
185 :
186 6600 : 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 6600 : mpools%ref_count = 1
191 6600 : 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 6604 : 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 6604 : CALL timeset(routineN, handle)
224 :
225 6604 : NULLIFY (fmstruct, p_att)
226 6604 : prepare_subset = .FALSE.
227 6604 : IF (PRESENT(nmosub)) THEN
228 0 : IF (nmosub(1) > 0) prepare_subset = .TRUE.
229 : END IF
230 :
231 6604 : IF (.NOT. ASSOCIATED(mpools)) THEN
232 6348 : CALL mpools_create(mpools)
233 : END IF
234 6604 : nspins = SIZE(mos)
235 :
236 6604 : 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 6604 : IF (.NOT. ASSOCIATED(mpools%ao_mo_fm_pools)) THEN
242 27909 : ALLOCATE (mpools%ao_mo_fm_pools(nspins))
243 14709 : DO ispin = 1, nspins
244 14709 : NULLIFY (mpools%ao_mo_fm_pools(ispin)%pool)
245 : END DO
246 : END IF
247 :
248 6604 : 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 6604 : IF (.NOT. ASSOCIATED(mpools%ao_ao_fm_pools)) THEN
254 27909 : ALLOCATE (mpools%ao_ao_fm_pools(nspins))
255 14709 : DO ispin = 1, nspins
256 14709 : NULLIFY (mpools%ao_ao_fm_pools(ispin)%pool)
257 : END DO
258 : END IF
259 :
260 6604 : 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 6604 : IF (.NOT. ASSOCIATED(mpools%mo_mo_fm_pools)) THEN
266 27909 : ALLOCATE (mpools%mo_mo_fm_pools(nspins))
267 14709 : DO ispin = 1, nspins
268 14709 : NULLIFY (mpools%mo_mo_fm_pools(ispin)%pool)
269 : END DO
270 : END IF
271 :
272 6604 : 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 6604 : CALL get_mo_set(mos(1), nao=nao, nmo=min_nmo)
301 6604 : max_nmo = min_nmo
302 8113 : DO ispin = 2, SIZE(mos)
303 1509 : CALL get_mo_set(mos(ispin), nmo=nmo)
304 1509 : IF (max_nmo < nmo) THEN
305 0 : CPABORT("the mo with the most orbitals must be the first ")
306 : END IF
307 9622 : min_nmo = MIN(min_nmo, nmo)
308 : END DO
309 :
310 : ! aoao pools
311 6604 : should_rebuild = .FALSE.
312 14717 : DO ispin = 1, nspins
313 8113 : p_att => mpools%ao_ao_fm_pools(ispin)%pool
314 8113 : should_rebuild = (should_rebuild .OR. (.NOT. ASSOCIATED(p_att)))
315 14717 : 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 6604 : IF (should_rebuild) THEN
323 14709 : DO ispin = 1, nspins
324 14709 : 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 6600 : context=blacs_env)
330 6600 : CALL fm_pool_create(mpools%ao_ao_fm_pools(1)%pool, fmstruct)
331 6600 : CALL cp_fm_struct_release(fmstruct)
332 8109 : DO ispin = 2, SIZE(mos)
333 1509 : mpools%ao_ao_fm_pools(ispin)%pool => mpools%ao_ao_fm_pools(1)%pool
334 8109 : 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 14717 : DO ispin = 1, nspins
341 8113 : p_att => mpools%ao_mo_fm_pools(ispin)%pool
342 8113 : should_rebuild = (should_rebuild .OR. (.NOT. ASSOCIATED(p_att)))
343 14717 : 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 6604 : IF (should_rebuild) THEN
352 14709 : DO ispin = 1, nspins
353 14709 : CALL fm_pool_release(mpools%ao_mo_fm_pools(ispin)%pool)
354 : END DO
355 :
356 6600 : 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 5765 : context=blacs_env)
360 5765 : CALL fm_pool_create(mpools%ao_mo_fm_pools(1)%pool, fmstruct)
361 5765 : CALL cp_fm_struct_release(fmstruct)
362 6439 : DO ispin = 2, SIZE(mos)
363 674 : mpools%ao_mo_fm_pools(ispin)%pool => mpools%ao_mo_fm_pools(1)%pool
364 6439 : CALL fm_pool_retain(mpools%ao_mo_fm_pools(1)%pool)
365 : END DO
366 : ELSE
367 2505 : DO ispin = 1, SIZE(mos)
368 1670 : 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 1670 : context=blacs_env)
372 : CALL fm_pool_create(mpools%ao_mo_fm_pools(ispin)%pool, &
373 1670 : fmstruct)
374 4175 : CALL cp_fm_struct_release(fmstruct)
375 : END DO
376 : END IF
377 : END IF
378 :
379 : ! momo pools
380 : should_rebuild = .FALSE.
381 14717 : DO ispin = 1, nspins
382 8113 : p_att => mpools%mo_mo_fm_pools(ispin)%pool
383 8113 : should_rebuild = (should_rebuild .OR. (.NOT. ASSOCIATED(p_att)))
384 14717 : 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 6604 : IF (should_rebuild) THEN
393 14709 : DO ispin = 1, nspins
394 14709 : CALL fm_pool_release(mpools%mo_mo_fm_pools(ispin)%pool)
395 : END DO
396 :
397 6600 : 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 5765 : context=blacs_env)
401 : CALL fm_pool_create(mpools%mo_mo_fm_pools(1)%pool, &
402 5765 : fmstruct)
403 5765 : CALL cp_fm_struct_release(fmstruct)
404 6439 : DO ispin = 2, SIZE(mos)
405 674 : mpools%mo_mo_fm_pools(ispin)%pool => mpools%mo_mo_fm_pools(1)%pool
406 6439 : CALL fm_pool_retain(mpools%mo_mo_fm_pools(1)%pool)
407 : END DO
408 : ELSE
409 2505 : DO ispin = 1, SIZE(mos)
410 1670 : NULLIFY (mpools%mo_mo_fm_pools(ispin)%pool)
411 1670 : 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 1670 : context=blacs_env)
415 : CALL fm_pool_create(mpools%mo_mo_fm_pools(ispin)%pool, &
416 1670 : fmstruct)
417 4175 : CALL cp_fm_struct_release(fmstruct)
418 : END DO
419 : END IF
420 : END IF
421 :
422 6604 : 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 6604 : CALL timestop(handle)
508 6604 : END SUBROUTINE mpools_rebuild_fm_pools
509 :
510 : ! **************************************************************************************************
511 :
512 0 : END MODULE qs_matrix_pools
|
