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