mirror of
https://github.com/pfloos/quack
synced 2024-12-22 20:35:36 +01:00
openMP for GW
This commit is contained in:
parent
01b0a4d823
commit
3a80069009
@ -78,29 +78,43 @@ subroutine self_energy_correlation(COHSEX,eta,nBas,nC,nO,nV,nR,nS,e,Omega,rho,Ec
|
||||
|
||||
! Occupied part of the correlation self-energy
|
||||
|
||||
do jb=1,nS
|
||||
do i=nC+1,nO
|
||||
do q=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(SigC,rho,eta,nS,nC,nO,nBas,nR,e,Omega) &
|
||||
!$OMP PRIVATE(jb,i,q,p,eps) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
!$OMP DO
|
||||
do q=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
do jb=1,nS
|
||||
do i=nC+1,nO
|
||||
eps = e(p) - e(i) + Omega(jb)
|
||||
SigC(p,q) = SigC(p,q) + 2d0*rho(p,i,jb)*rho(q,i,jb)*eps/(eps**2 + eta**2)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! Virtual part of the correlation self-energy
|
||||
|
||||
do jb=1,nS
|
||||
do a=nO+1,nBas-nR
|
||||
do q=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
|
||||
!$OMP PARALLEL &
|
||||
!$OMP SHARED(SigC,rho,eta,nS,nC,nO,nBas,nR,e,Omega) &
|
||||
!$OMP PRIVATE(jb,a,q,p,eps) &
|
||||
!$OMP DEFAULT(NONE)
|
||||
!$OMP DO
|
||||
do q=nC+1,nBas-nR
|
||||
do p=nC+1,nBas-nR
|
||||
do jb=1,nS
|
||||
do a=nO+1,nBas-nR
|
||||
eps = e(p) - e(a) - Omega(jb)
|
||||
SigC(p,q) = SigC(p,q) + 2d0*rho(p,a,jb)*rho(q,a,jb)*eps/(eps**2 + eta**2)
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
end do
|
||||
!$OMP END DO
|
||||
!$OMP END PARALLEL
|
||||
|
||||
! Galitskii-Migdal correlation energy
|
||||
|
||||
|
@ -21,7 +21,9 @@ subroutine linear_response(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,E
|
||||
double precision,intent(in) :: e(nBas)
|
||||
double precision,intent(in) :: ERI(nBas,nBas,nBas,nBas)
|
||||
|
||||
! Local variables
|
||||
! Local variables
|
||||
|
||||
integer :: i,j,k
|
||||
|
||||
double precision :: trace_matrix
|
||||
double precision,allocatable :: A(:,:)
|
||||
@ -31,6 +33,7 @@ subroutine linear_response(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,E
|
||||
double precision,allocatable :: AmBSq(:,:)
|
||||
double precision,allocatable :: AmBIv(:,:)
|
||||
double precision,allocatable :: Z(:,:)
|
||||
double precision,allocatable :: tmp(:,:)
|
||||
|
||||
! Output variables
|
||||
|
||||
@ -41,7 +44,7 @@ subroutine linear_response(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,E
|
||||
|
||||
! Memory allocation
|
||||
|
||||
allocate(A(nS,nS),B(nS,nS),ApB(nS,nS),AmB(nS,nS),AmBSq(nS,nS),AmBIv(nS,nS),Z(nS,nS))
|
||||
allocate(A(nS,nS),B(nS,nS),ApB(nS,nS),AmB(nS,nS),AmBSq(nS,nS),AmBIv(nS,nS),Z(nS,nS),tmp(nS,nS))
|
||||
|
||||
! Build A and B matrices
|
||||
|
||||
@ -77,10 +80,11 @@ subroutine linear_response(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,E
|
||||
! if(Omega(ia) < 0d0) Omega(ia) = 0d0
|
||||
! end do
|
||||
|
||||
call ADAt(nS,AmB,1d0*sqrt(Omega),AmBSq)
|
||||
call ADAt(nS,AmB,1d0/sqrt(Omega),AmBIv)
|
||||
call ADAt(nS,AmB,1d0*dsqrt(Omega),AmBSq)
|
||||
call ADAt(nS,AmB,1d0/dsqrt(Omega),AmBIv)
|
||||
|
||||
Z = matmul(AmBSq,matmul(ApB,AmBSq))
|
||||
call dgemm('N','N',nS,nS,nS,1d0,ApB,size(ApB,1),AmBSq,size(AmBSq,1),0d0,tmp,size(tmp,1))
|
||||
call dgemm('N','N',nS,nS,nS,1d0,AmBSq,size(AmBSq,1),tmp,size(tmp,1),0d0,Z,size(Z,1))
|
||||
|
||||
call diagonalize_matrix(nS,Z,Omega)
|
||||
|
||||
@ -91,13 +95,13 @@ subroutine linear_response(ispin,dRPA,TDA,eta,nBas,nC,nO,nV,nR,nS,lambda,e,ERI,E
|
||||
! if(Omega(ia) < 0d0) Omega(ia) = 0d0
|
||||
! end do
|
||||
|
||||
Omega = sqrt(Omega)
|
||||
Omega = dsqrt(Omega)
|
||||
|
||||
XpY = matmul(transpose(Z),AmBSq)
|
||||
call DA(nS,1d0/sqrt(Omega),XpY)
|
||||
call dgemm('T','N',nS,nS,nS,1d0,Z,size(Z,1),AmBSq,size(AmBSq,1),0d0,XpY,size(XpY,1))
|
||||
call DA(nS,1d0/dsqrt(Omega),XpY)
|
||||
|
||||
XmY = matmul(transpose(Z),AmBIv)
|
||||
call DA(nS,1d0*sqrt(Omega),XmY)
|
||||
call dgemm('T','N',nS,nS,nS,1d0,Z,size(Z,1),AmBIv,size(AmBIv,1),0d0,XmY,size(XmY,1))
|
||||
call DA(nS,1d0*dsqrt(Omega),XmY)
|
||||
|
||||
end if
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user