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 Routines to calculate MP2 energy with laplace approach
      10             : !> \par History
      11             : !>      11.2012 created [Mauro Del Ben]
      12             : ! **************************************************************************************************
      13             : MODULE mp2_laplace
      14             : !
      15             :    USE cp_fm_types,                     ONLY: cp_fm_get_info,&
      16             :                                               cp_fm_type
      17             :    USE kinds,                           ONLY: dp
      18             : #include "./base/base_uses.f90"
      19             : 
      20             :    IMPLICIT NONE
      21             : 
      22             :    PRIVATE
      23             : 
      24             :    CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mp2_laplace'
      25             : 
      26             :    PUBLIC :: calc_fm_mat_S_laplace, SOS_MP2_postprocessing
      27             : 
      28             : CONTAINS
      29             : 
      30             : ! **************************************************************************************************
      31             : !> \brief ...
      32             : !> \param fm_mat_S ...
      33             : !> \param homo ...
      34             : !> \param virtual ...
      35             : !> \param Eigenval ...
      36             : !> \param dajquad ...
      37             : ! **************************************************************************************************
      38         196 :    SUBROUTINE calc_fm_mat_S_laplace(fm_mat_S, homo, virtual, Eigenval, dajquad)
      39             :       TYPE(cp_fm_type), INTENT(IN)                       :: fm_mat_S
      40             :       INTEGER, INTENT(IN)                                :: homo, virtual
      41             :       REAL(KIND=dp), DIMENSION(:), INTENT(IN)            :: Eigenval
      42             :       REAL(KIND=dp), INTENT(IN)                          :: dajquad
      43             : 
      44             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'calc_fm_mat_S_laplace'
      45             : 
      46             :       INTEGER                                            :: avirt, handle, i_global, iiB, iocc, &
      47             :                                                             ncol_local
      48         196 :       INTEGER, DIMENSION(:), POINTER                     :: col_indices
      49             :       REAL(KIND=dp)                                      :: laplace_transf
      50             : 
      51         196 :       CALL timeset(routineN, handle)
      52             : 
      53             :       ! get info of fm_mat_S
      54             :       CALL cp_fm_get_info(matrix=fm_mat_S, &
      55             :                           ncol_local=ncol_local, &
      56         196 :                           col_indices=col_indices)
      57             : 
      58       15776 :       DO iiB = 1, ncol_local
      59       15580 :          i_global = col_indices(iiB)
      60             : 
      61       15580 :          iocc = MAX(1, i_global - 1)/virtual + 1
      62       15580 :          avirt = i_global - (iocc - 1)*virtual
      63             : 
      64       15580 :          laplace_transf = EXP(0.5_dp*(Eigenval(iocc) - Eigenval(avirt + homo))*dajquad)
      65             : 
      66      936782 :          fm_mat_S%local_data(:, iiB) = fm_mat_S%local_data(:, iiB)*laplace_transf
      67             : 
      68             :       END DO
      69             : 
      70         196 :       CALL timestop(handle)
      71             : 
      72         196 :    END SUBROUTINE calc_fm_mat_S_laplace
      73             : 
      74             : ! **************************************************************************************************
      75             : !> \brief ...
      76             : !> \param fm_mat_Q ...
      77             : !> \param Erpa ...
      78             : !> \param tau_wjquad ...
      79             : ! **************************************************************************************************
      80         206 :    SUBROUTINE SOS_MP2_postprocessing(fm_mat_Q, Erpa, tau_wjquad)
      81             :       TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: fm_mat_Q
      82             :       REAL(KIND=dp), INTENT(INOUT)                       :: Erpa
      83             :       REAL(KIND=dp), INTENT(IN)                          :: tau_wjquad
      84             : 
      85             :       CHARACTER(LEN=*), PARAMETER :: routineN = 'SOS_MP2_postprocessing'
      86             : 
      87             :       INTEGER                                            :: handle, jjB, ncol_local
      88             :       REAL(KIND=dp)                                      :: trace_XX
      89             : 
      90         206 :       CALL timeset(routineN, handle)
      91             : 
      92             :       ! get info of fm_mat_Q
      93             :       CALL cp_fm_get_info(matrix=fm_mat_Q(1), &
      94         206 :                           ncol_local=ncol_local)
      95             : 
      96             :       ! calculate the trace of the product Q*Q
      97         206 :       trace_XX = 0.0_dp
      98       18024 :       DO jjB = 1, ncol_local
      99             :          trace_XX = trace_XX + DOT_PRODUCT(fm_mat_Q(1)%local_data(:, jjB), &
     100      886339 :                                            fm_mat_Q(SIZE(fm_mat_Q))%local_data(:, jjB))
     101             :       END DO
     102             : 
     103         206 :       Erpa = Erpa - trace_XX*tau_wjquad
     104             : 
     105         206 :       CALL timestop(handle)
     106             : 
     107         206 :    END SUBROUTINE SOS_MP2_postprocessing
     108             : 
     109             : END MODULE mp2_laplace