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 Contains methods used in the context of density fitting
      10             : !> \par History
      11             : !>      04.2008 created [Manuel Guidon]
      12             : !>      02.2013 moved from admm_methods
      13             : !> \author Manuel Guidon
      14             : ! **************************************************************************************************
      15             : MODULE admm_utils
      16             :    USE admm_types,                      ONLY: admm_type
      17             :    USE cp_dbcsr_operations,             ONLY: copy_fm_to_dbcsr
      18             :    USE dbcsr_api,                       ONLY: dbcsr_add,&
      19             :                                               dbcsr_copy,&
      20             :                                               dbcsr_create,&
      21             :                                               dbcsr_deallocate_matrix,&
      22             :                                               dbcsr_set,&
      23             :                                               dbcsr_type,&
      24             :                                               dbcsr_type_symmetric
      25             :    USE input_constants,                 ONLY: do_admm_purify_cauchy,&
      26             :                                               do_admm_purify_cauchy_subspace,&
      27             :                                               do_admm_purify_mo_diag,&
      28             :                                               do_admm_purify_mo_no_diag,&
      29             :                                               do_admm_purify_none
      30             :    USE kinds,                           ONLY: dp
      31             :    USE parallel_gemm_api,               ONLY: parallel_gemm
      32             : #include "./base/base_uses.f90"
      33             : 
      34             :    IMPLICIT NONE
      35             :    PRIVATE
      36             : 
      37             :    PUBLIC :: admm_correct_for_eigenvalues, &
      38             :              admm_uncorrect_for_eigenvalues
      39             : 
      40             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'admm_utils'
      41             : 
      42             : !***
      43             : 
      44             : CONTAINS
      45             : 
      46             : ! **************************************************************************************************
      47             : !> \brief ...
      48             : !> \param ispin ...
      49             : !> \param admm_env ...
      50             : !> \param ks_matrix ...
      51             : ! **************************************************************************************************
      52         100 :    SUBROUTINE admm_correct_for_eigenvalues(ispin, admm_env, ks_matrix)
      53             :       INTEGER, INTENT(IN)                                :: ispin
      54             :       TYPE(admm_type), POINTER                           :: admm_env
      55             :       TYPE(dbcsr_type), POINTER                          :: ks_matrix
      56             : 
      57             :       INTEGER                                            :: nao_aux_fit, nao_orb
      58             :       TYPE(dbcsr_type), POINTER                          :: work
      59             : 
      60         100 :       nao_aux_fit = admm_env%nao_aux_fit
      61         100 :       nao_orb = admm_env%nao_orb
      62             : 
      63         100 :       IF (.NOT. admm_env%block_dm) THEN
      64         100 :          SELECT CASE (admm_env%purification_method)
      65             :          CASE (do_admm_purify_cauchy_subspace)
      66             :             !* remove what has been added and add the correction
      67             :             NULLIFY (work)
      68           0 :             ALLOCATE (work)
      69           0 :             CALL dbcsr_create(work, template=ks_matrix, name='work', matrix_type=dbcsr_type_symmetric)
      70             : 
      71           0 :             CALL dbcsr_copy(work, ks_matrix)
      72           0 :             CALL dbcsr_set(work, 0.0_dp)
      73           0 :             CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin), work, keep_sparsity=.TRUE.)
      74             : 
      75           0 :             CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)
      76             : 
      77             :             ! ** calculate A^T*H_tilde*A
      78             :             CALL parallel_gemm('N', 'N', nao_aux_fit, nao_orb, nao_aux_fit, &
      79             :                                1.0_dp, admm_env%K(ispin), admm_env%A, 0.0_dp, &
      80           0 :                                admm_env%work_aux_orb)
      81             :             CALL parallel_gemm('T', 'N', nao_orb, nao_orb, nao_aux_fit, &
      82             :                                1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
      83           0 :                                admm_env%H_corr(ispin))
      84             : 
      85           0 :             CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)
      86             : 
      87           0 :             CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
      88           0 :             CALL dbcsr_deallocate_matrix(work)
      89             : 
      90             :          CASE (do_admm_purify_mo_diag)
      91             :             !* remove what has been added and add the correction
      92             :             NULLIFY (work)
      93          10 :             ALLOCATE (work)
      94          10 :             CALL dbcsr_create(work, template=ks_matrix, name='work', matrix_type=dbcsr_type_symmetric)
      95             : 
      96          10 :             CALL dbcsr_copy(work, ks_matrix)
      97          10 :             CALL dbcsr_set(work, 0.0_dp)
      98          10 :             CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin), work, keep_sparsity=.TRUE.)
      99             : 
     100             :             ! ** calculate A^T*H_tilde*A
     101             :             CALL parallel_gemm('N', 'N', nao_aux_fit, nao_orb, nao_aux_fit, &
     102             :                                1.0_dp, admm_env%K(ispin), admm_env%A, 0.0_dp, &
     103          10 :                                admm_env%work_aux_orb)
     104             :             CALL parallel_gemm('T', 'N', nao_orb, nao_orb, nao_aux_fit, &
     105             :                                1.0_dp, admm_env%A, admm_env%work_aux_orb, 0.0_dp, &
     106          10 :                                admm_env%H_corr(ispin))
     107             : 
     108          10 :             CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)
     109             : 
     110          10 :             CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
     111         110 :             CALL dbcsr_deallocate_matrix(work)
     112             : 
     113             :          CASE (do_admm_purify_mo_no_diag, do_admm_purify_none, do_admm_purify_cauchy)
     114             :             ! do nothing
     115             :          END SELECT
     116             :       END IF
     117             : 
     118         100 :    END SUBROUTINE admm_correct_for_eigenvalues
     119             : 
     120             : ! **************************************************************************************************
     121             : !> \brief ...
     122             : !> \param ispin ...
     123             : !> \param admm_env ...
     124             : !> \param ks_matrix ...
     125             : ! **************************************************************************************************
     126          98 :    SUBROUTINE admm_uncorrect_for_eigenvalues(ispin, admm_env, ks_matrix)
     127             :       INTEGER, INTENT(IN)                                :: ispin
     128             :       TYPE(admm_type), POINTER                           :: admm_env
     129             :       TYPE(dbcsr_type), POINTER                          :: ks_matrix
     130             : 
     131             :       INTEGER                                            :: nao_aux_fit, nao_orb
     132             :       TYPE(dbcsr_type), POINTER                          :: work
     133             : 
     134          98 :       nao_aux_fit = admm_env%nao_aux_fit
     135          98 :       nao_orb = admm_env%nao_orb
     136             : 
     137          98 :       IF (.NOT. admm_env%block_dm) THEN
     138          98 :          SELECT CASE (admm_env%purification_method)
     139             :          CASE (do_admm_purify_cauchy_subspace)
     140             :             !* remove what has been added and add the correction
     141             :             NULLIFY (work)
     142           0 :             ALLOCATE (work)
     143           0 :             CALL dbcsr_create(work, template=ks_matrix, name='work', matrix_type=dbcsr_type_symmetric)
     144             : 
     145           0 :             CALL dbcsr_copy(work, ks_matrix)
     146           0 :             CALL dbcsr_set(work, 0.0_dp)
     147           0 :             CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)
     148             : 
     149           0 :             CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)
     150             : 
     151           0 :             CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)
     152             : 
     153           0 :             CALL dbcsr_set(work, 0.0_dp)
     154           0 :             CALL copy_fm_to_dbcsr(admm_env%ks_to_be_merged(ispin), work, keep_sparsity=.TRUE.)
     155             : 
     156           0 :             CALL dbcsr_add(ks_matrix, work, 1.0_dp, 1.0_dp)
     157           0 :             CALL dbcsr_deallocate_matrix(work)
     158             : 
     159             :          CASE (do_admm_purify_mo_diag)
     160             :             NULLIFY (work)
     161           8 :             ALLOCATE (work)
     162           8 :             CALL dbcsr_create(work, template=ks_matrix, name='work', matrix_type=dbcsr_type_symmetric)
     163             : 
     164           8 :             CALL dbcsr_copy(work, ks_matrix)
     165           8 :             CALL dbcsr_set(work, 0.0_dp)
     166             : 
     167           8 :             CALL copy_fm_to_dbcsr(admm_env%H_corr(ispin), work, keep_sparsity=.TRUE.)
     168             : 
     169           8 :             CALL dbcsr_add(ks_matrix, work, 1.0_dp, -1.0_dp)
     170         106 :             CALL dbcsr_deallocate_matrix(work)
     171             : 
     172             :          CASE (do_admm_purify_mo_no_diag, do_admm_purify_none, do_admm_purify_cauchy)
     173             :             ! do nothing
     174             :          END SELECT
     175             :       END IF
     176          98 :    END SUBROUTINE admm_uncorrect_for_eigenvalues
     177             : 
     178             : END MODULE admm_utils