LCOV - code coverage report
Current view: top level - src - qs_matrix_pools.F (source / functions) Coverage Total Hit
Test: CP2K Regtests (git:42dac4a) Lines: 62.2 % 209 130
Test Date: 2025-07-25 12:55:17 Functions: 66.7 % 6 4

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

Generated by: LCOV version 2.0-1