mp2_laplace.F

Go to the documentation of this file.

!--------------------------------------------------------------------------------------------------!
!   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 Routines to calculate MP2 energy with laplace approach
!> \par History
!>      11.2012 created [Mauro Del Ben]
! **************************************************************************************************
MODULE mp2_laplace
!
   USE cp_fm_types,                     ONLY: cp_fm_get_info,&
                                              cp_fm_type
   USE kinds,                           ONLY: dp
#include "./base/base_uses.f90"
 
   IMPLICIT NONE
 
   PRIVATE
 
   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'mp2_laplace'
 
   PUBLIC :: calc_fm_mat_s_laplace, sos_mp2_postprocessing
 
CONTAINS
 
! **************************************************************************************************
!> \brief ...
!> \param fm_mat_S ...
!> \param homo ...
!> \param virtual ...
!> \param Eigenval ...
!> \param dajquad ...
! **************************************************************************************************
   SUBROUTINE calc_fm_mat_s_laplace(fm_mat_S, homo, virtual, Eigenval, dajquad)
      TYPE(cp_fm_type), INTENT(IN)                       :: fm_mat_s
      INTEGER, INTENT(IN)                                :: homo, virtual
      REAL(kind=dp), DIMENSION(:), INTENT(IN)            :: eigenval
      REAL(kind=dp), INTENT(IN)                          :: dajquad
 
      CHARACTER(LEN=*), PARAMETER :: routinen = 'calc_fm_mat_S_laplace'
 
      INTEGER                                            :: avirt, handle, i_global, iib, iocc, &
                                                            ncol_local
      INTEGER, DIMENSION(:), POINTER                     :: col_indices
      REAL(kind=dp)                                      :: laplace_transf
 
      CALL timeset(routinen, handle)
 
      ! get info of fm_mat_S
      CALL cp_fm_get_info(matrix=fm_mat_s, &
                          ncol_local=ncol_local, &
                          col_indices=col_indices)
 
      DO iib = 1, ncol_local
         i_global = col_indices(iib)
 
         iocc = max(1, i_global - 1)/virtual + 1
         avirt = i_global - (iocc - 1)*virtual
 
         laplace_transf = exp(0.5_dp*(eigenval(iocc) - eigenval(avirt + homo))*dajquad)
 
         fm_mat_s%local_data(:, iib) = fm_mat_s%local_data(:, iib)*laplace_transf
 
      END DO
 
      CALL timestop(handle)
 
   END SUBROUTINE calc_fm_mat_s_laplace
 
! **************************************************************************************************
!> \brief ...
!> \param fm_mat_Q ...
!> \param Erpa ...
!> \param tau_wjquad ...
! **************************************************************************************************
   SUBROUTINE sos_mp2_postprocessing(fm_mat_Q, Erpa, tau_wjquad)
      TYPE(cp_fm_type), DIMENSION(:), INTENT(IN)         :: fm_mat_q
      REAL(kind=dp), INTENT(INOUT)                       :: erpa
      REAL(kind=dp), INTENT(IN)                          :: tau_wjquad
 
      CHARACTER(LEN=*), PARAMETER :: routinen = 'SOS_MP2_postprocessing'
 
      INTEGER                                            :: handle, jjb, ncol_local
      REAL(kind=dp)                                      :: trace_xx
 
      CALL timeset(routinen, handle)
 
      ! get info of fm_mat_Q
      CALL cp_fm_get_info(matrix=fm_mat_q(1), &
                          ncol_local=ncol_local)
 
      ! calculate the trace of the product Q*Q
      trace_xx = 0.0_dp
      DO jjb = 1, ncol_local
         trace_xx = trace_xx + dot_product(fm_mat_q(1)%local_data(:, jjb), &
                                           fm_mat_q(SIZE(fm_mat_q))%local_data(:, jjb))
      END DO
 
      erpa = erpa - trace_xx*tau_wjquad
 
      CALL timestop(handle)
 
   END SUBROUTINE sos_mp2_postprocessing
 
END MODULE mp2_laplace