openMP for GW

src/GW/self_energy_correlation.f90

@@ -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
+!$OMP PARALLEL &
-      do i=nC+1,nO
+!$OMP SHARED(SigC,rho,eta,nS,nC,nO,nBas,nR,e,Omega) &
-        do q=nC+1,nBas-nR
+!$OMP PRIVATE(jb,i,q,p,eps) &
-          do p=nC+1,nBas-nR
+!$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
+!$OMP PARALLEL &
-      do a=nO+1,nBas-nR
+!$OMP SHARED(SigC,rho,eta,nS,nC,nO,nBas,nR,e,Omega) &
-        do q=nC+1,nBas-nR
+!$OMP PRIVATE(jb,a,q,p,eps) &
-          do p=nC+1,nBas-nR
+!$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
 

src/LR/linear_response.f90

@@ -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*dsqrt(Omega),AmBSq)
-    call ADAt(nS,AmB,1d0/sqrt(Omega),AmBIv)
+    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 dgemm('T','N',nS,nS,nS,1d0,Z,size(Z,1),AmBSq,size(AmBSq,1),0d0,XpY,size(XpY,1))
-    call DA(nS,1d0/sqrt(Omega),XpY)
+    call DA(nS,1d0/dsqrt(Omega),XpY)
 
-    XmY = matmul(transpose(Z),AmBIv)
+    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*sqrt(Omega),XmY)
+    call DA(nS,1d0*dsqrt(Omega),XmY)
  
   end if