ebugging GF2 ppBSE spin adaptation

src/GF/RGF2_ppBSE_static_kernel_B.f90

@@ -68,6 +68,7 @@ subroutine RGF2_ppBSE_static_kernel_B(ispin,eta,nBas,nC,nO,nV,nR,nOO,nVV,lambda,
             end do
 
             KB_sta(ab,ij) = 2d0*lambda*KB_sta(ab,ij)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(i,j)))
+
           end do
         end do
 

src/GF/RGF2_ppBSE_static_kernel_C.f90

@@ -37,40 +37,84 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
 ! Initialization
 
   KC_sta(:,:) = 0d0
-  eta2 = eta * eta
+! eta2 = eta * eta
 
-  allocate(Om_tmp(nBas,nBas))
+! allocate(Om_tmp(nBas,nBas))
-  Om_tmp(:,:) = 0d0
+! Om_tmp(:,:) = 0d0
 
-  ! Compute the energy differences and denominator once and store them in a temporary array
+! ! Compute the energy differences and denominator once and store them in a temporary array
-  !$OMP PARALLEL DEFAULT(NONE) PRIVATE(m,e,dem) SHARED(nC,nO,nBas,nR, eta2, eGF, Om_tmp)
+! !$OMP PARALLEL DEFAULT(NONE) PRIVATE(m,e,dem) SHARED(nC,nO,nBas,nR, eta2, eGF, Om_tmp)
-  !$OMP DO
+! !$OMP DO
-  do m=nC+1,nO
+! do m=nC+1,nO
-     do e=nO+1,nBas-nR
+!    do e=nO+1,nBas-nR
-        dem = eGF(m) - eGF(e)
+!       dem = eGF(m) - eGF(e)
-        Om_tmp(m,e) = dem / (dem*dem + eta2)
+!       Om_tmp(m,e) = dem / (dem*dem + eta2)
-     enddo
+!    enddo
-  enddo
+! enddo
-  !$OMP END DO
+! !$OMP END DO
-  !$OMP END PARALLEL
+! !$OMP END PARALLEL
   
 ! Second-order correlation kernel for the block C of the singlet manifold
 
 !  --- --- ---
 !    OpenMP implementation
+!  --- --- ---
+
+! if(ispin == 1) then
+
+!   a0 = nBas - nR - nO
+!   !$OMP PARALLEL DEFAULT(NONE)                              &
+!   !$OMP          PRIVATE(a, b, aa, ab, c, d, cd, m, e, num) &
+!   !$OMP          SHARED(nO, nBas, nR, nC, a0, ERI, Om_tmp, KC_sta, lambda)
+!   !$OMP DO
+!   do a=nO+1,nBas-nR
+!     aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
+!     do b=a,nBas-nR
+!       ab = aa + b
+
+!       cd = 0
+!       do c=nO+1,nBas-nR
+!         do d=c,nBas-nR
+!           cd = cd + 1
+! 
+!           do m=nC+1,nO
+!             do e=nO+1,nBas-nR
+!    
+!               num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) -     ERI(a,m,c,e)*ERI(b,e,m,d) & 
+!                   -     ERI(a,m,e,c)*ERI(b,e,d,m) -     ERI(a,m,e,c)*ERI(b,e,m,d)
+
+!               KC_sta(ab,cd) = KC_sta(ab,cd) + num * Om_tmp(m,e)
+!           
+!               num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) -     ERI(b,m,c,e)*ERI(a,e,m,d) & 
+!                   -     ERI(b,m,e,c)*ERI(a,e,d,m) -     ERI(b,m,e,c)*ERI(a,e,m,d)
+
+!               KC_sta(ab,cd) = KC_sta(ab,cd) + num * Om_tmp(m,e)
+!           
+!             end do
+!           end do
+
+!           KC_sta(ab,cd) = 2d0*lambda*KC_sta(ab,cd)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
+!           
+!          end do
+!        end do
+
+!     end do
+!   end do
+!   !$OMP END DO
+!   !$OMP END PARALLEL
+
+! end if
+
+!  --- --- ---
+!  Naive implementation
 !  --- --- ---
 
   if(ispin == 1) then
  
-    a0 = nBas - nR - nO
+    ab = 0
-    !$OMP PARALLEL DEFAULT(NONE)                              &
-    !$OMP          PRIVATE(a, b, aa, ab, c, d, cd, m, e, num) &
-    !$OMP          SHARED(nO, nBas, nR, nC, a0, ERI, Om_tmp, KC_sta, lambda)
-    !$OMP DO
     do a=nO+1,nBas-nR
-      aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO
       do b=a,nBas-nR
-        ab = aa + b
+        ab = ab + 1
  
         cd = 0
         do c=nO+1,nBas-nR
@@ -80,15 +124,17 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
             do m=nC+1,nO
               do e=nO+1,nBas-nR
    
+                dem = eGF(m) - eGF(e)
                 num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) -     ERI(a,m,c,e)*ERI(b,e,m,d) & 
                     -     ERI(a,m,e,c)*ERI(b,e,d,m) -     ERI(a,m,e,c)*ERI(b,e,m,d)
  
-                KC_sta(ab,cd) = KC_sta(ab,cd) + num * Om_tmp(m,e)
+                KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
           
+                dem = eGF(m) - eGF(e)
                 num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) -     ERI(b,m,c,e)*ERI(a,e,m,d) & 
                     -     ERI(b,m,e,c)*ERI(a,e,d,m) -     ERI(b,m,e,c)*ERI(a,e,m,d)
  
-                KC_sta(ab,cd) = KC_sta(ab,cd) + num * Om_tmp(m,e)
+                KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
           
               end do
            end do
@@ -100,71 +146,68 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
  
       end do
     end do
-    !$OMP END DO
-    !$OMP END PARALLEL
  
   end if
 
-!  --- --- ---
-!  Naive implementation
-!  --- --- ---
-!   if(ispin == 1) then
-   
-!     ab = 0
-!     do a=nO+1,nBas-nR
-!       do b=a,nBas-nR
-!         ab = ab + 1
-   
-!         cd = 0
-!         do c=nO+1,nBas-nR
-!           do d=c,nBas-nR
-!             cd = cd + 1
-   
-!             do m=nC+1,nO
-!               do e=nO+1,nBas-nR
-     
-!                 dem = eGF(m) - eGF(e)
-!                 num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) -     ERI(a,m,c,e)*ERI(b,e,m,d) & 
-!                     -     ERI(a,m,e,c)*ERI(b,e,d,m) -     ERI(a,m,e,c)*ERI(b,e,m,d)
-   
-!                 KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
-            
-!                 dem = eGF(m) - eGF(e)
-!                 num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) -     ERI(b,m,c,e)*ERI(a,e,m,d) & 
-!                     -     ERI(b,m,e,c)*ERI(a,e,d,m) -     ERI(b,m,e,c)*ERI(a,e,m,d)
-   
-!                 KC_sta(ab,cd) = KC_sta(ab,cd) + num*dem/(dem**2 + eta**2)
-            
-!               end do
-!            end do
-   
-!            KC_sta(ab,cd) = 2d0*lambda*KC_sta(ab,cd)/sqrt((1d0 + Kronecker_delta(a,b))*(1d0 + Kronecker_delta(c,d)))
-            
-!           end do
-!         end do
-   
-!       end do
-!     end do
-   
-!   end if
-
 ! Second-order correlation kernel for the block C of the triplet manifold
 
 !  --- --- ---
 !  OpenMP implementation
+!  --- --- ---
+  
+! if(ispin == 2) then
+
+!   a0 = nBas - nR - nO - 1
+!   !$OMP PARALLEL DEFAULT(NONE)                              &
+!   !$OMP          PRIVATE(a, b, aa, ab, c, d, cd, m, e, num) &
+!   !$OMP          SHARED(nO, nBas, nR, nC, a0, ERI, Om_tmp, KC_sta)
+!   !$OMP DO
+!   do a = nO+1, nBas-nR
+!     aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO - 1
+!     do b = a+1, nBas-nR
+!       ab = aa + b
+
+!       cd = 0
+!       do c=nO+1,nBas-nR
+!         do d=c+1,nBas-nR
+!           cd = cd + 1
+! 
+!           do m=nC+1,nO
+!             do e=nO+1,nBas-nR
+!    
+!               num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) -     ERI(a,m,c,e)*ERI(b,e,m,d) &
+!                   -     ERI(a,m,e,c)*ERI(b,e,d,m) +     ERI(a,m,e,c)*ERI(b,e,m,d)
+
+!               KC_sta(ab,cd) = KC_sta(ab,cd) + 2d0 * num * Om_tmp(m,e)
+!           
+!               num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) -     ERI(b,m,c,e)*ERI(a,e,m,d) &
+!                   -     ERI(b,m,e,c)*ERI(a,e,d,m) +     ERI(b,m,e,c)*ERI(a,e,m,d)
+
+!               KC_sta(ab,cd) = KC_sta(ab,cd) - 2d0 * num * Om_tmp(m,e)
+!           
+!             end do
+!           end do
+
+!         end do
+!       end do
+
+!     end do
+!   end do
+!   !$OMP END DO
+!   !$OMP END PARALLEL
+
+! end if
+
+!  --- --- ---
+!  Naive implementation
 !  --- --- ---
 
  if(ispin == 2) then
 
-    a0 = nBas - nR - nO - 1
+   ab = 0
-    !$OMP PARALLEL DEFAULT(NONE)                              &
-    !$OMP          PRIVATE(a, b, aa, ab, c, d, cd, m, e, num) &
-    !$OMP          SHARED(nO, nBas, nR, nC, a0, ERI, Om_tmp, KC_sta)
-    !$OMP DO
    do a=nO+1,nBas-nR
-      aa = a0 * (a - nO - 1) - (a - nO - 1) * (a - nO) / 2 - nO - 1
      do b=a+1,nBas-nR
-        ab = aa + b
+       ab = ab + 1
 
        cd = 0
        do c=nO+1,nBas-nR
@@ -174,15 +217,17 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
            do m=nC+1,nO
              do e=nO+1,nBas-nR
   
+               dem = eGF(m) - eGF(e)
                num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) -     ERI(a,m,c,e)*ERI(b,e,m,d) &
                    -     ERI(a,m,e,c)*ERI(b,e,d,m) +     ERI(a,m,e,c)*ERI(b,e,m,d)
 
-                KC_sta(ab,cd) = KC_sta(ab,cd) + 2d0 * num * Om_tmp(m,e)
+               KC_sta(ab,cd) = KC_sta(ab,cd) + 2d0*num*dem/(dem**2 + eta**2)
          
+               dem = eGF(m) - eGF(e)
                num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) -     ERI(b,m,c,e)*ERI(a,e,m,d) &
                    -     ERI(b,m,e,c)*ERI(a,e,d,m) +     ERI(b,m,e,c)*ERI(a,e,m,d)
 
-                KC_sta(ab,cd) = KC_sta(ab,cd) - 2d0 * num * Om_tmp(m,e)
+               KC_sta(ab,cd) = KC_sta(ab,cd) - 2d0*num*dem/(dem**2 + eta**2)
          
              end do
            end do
@@ -192,8 +237,6 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
 
      end do
    end do
-    !$OMP END DO
-    !$OMP END PARALLEL
   
   end if
 
@@ -237,48 +280,8 @@ subroutine RGF2_ppBSE_static_kernel_C(ispin,eta,nBas,nC,nO,nV,nR,nVV,lambda,ERI,
   
 ! Second-order correlation kernel for the block C of the spinorbital manifold
 
-!  --- --- ---
-!  Naive implementation
-!  --- --- ---
-!   if(ispin == 2) then
-   
-!     ab = 0
-!     do a=nO+1,nBas-nR
-!       do b=a+1,nBas-nR
-!         ab = ab + 1
-   
-!         cd = 0
-!         do c=nO+1,nBas-nR
-!           do d=c+1,nBas-nR
-!             cd = cd + 1
-   
-!             do m=nC+1,nO
-!               do e=nO+1,nBas-nR
-     
-!                 dem = eGF(m) - eGF(e)
-!                 num = 2d0*ERI(a,m,c,e)*ERI(b,e,d,m) -     ERI(a,m,c,e)*ERI(b,e,m,d) &
-!                     -     ERI(a,m,e,c)*ERI(b,e,d,m) +     ERI(a,m,e,c)*ERI(b,e,m,d)
-   
-!                 KC_sta(ab,cd) = KC_sta(ab,cd) + 2d0*num*dem/(dem**2 + eta**2)
-            
-!                 dem = eGF(m) - eGF(e)
-!                 num = 2d0*ERI(b,m,c,e)*ERI(a,e,d,m) -     ERI(b,m,c,e)*ERI(a,e,m,d) &
-!                     -     ERI(b,m,e,c)*ERI(a,e,d,m) +     ERI(b,m,e,c)*ERI(a,e,m,d)
-   
-!                 KC_sta(ab,cd) = KC_sta(ab,cd) - 2d0*num*dem/(dem**2 + eta**2)
-            
-!               end do
-!             end do
-   
-!           end do
-!         end do
-   
-!       end do
-!     end do
-   
-  !   end if
   
 
-  deallocate(Om_tmp)
+! deallocate(Om_tmp)
 
 end subroutine 

src/GF/RGF2_ppBSE_static_kernel_D.f90

@@ -52,13 +52,13 @@ subroutine RGF2_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,lambda,ERI,
             do m=nC+1,nO
               do e=nO+1,nBas-nR
      
-                dem = - eGF(e) + eGF(m)
+                dem = eGF(m) - eGF(e) 
                 num = 2d0*ERI(i,e,k,m)*ERI(j,m,l,e) -     ERI(i,e,k,m)*ERI(j,m,e,l) & 
                     -     ERI(i,e,m,k)*ERI(j,m,l,e) -     ERI(i,e,m,k)*ERI(j,m,e,l)
 
                 KD_sta(ij,kl) = KD_sta(ij,kl) + num*dem/(dem**2 + eta**2)
             
-                dem = - eGF(e) + eGF(m)
+                dem = eGF(m) - eGF(e) 
                 num = 2d0*ERI(j,e,k,m)*ERI(i,m,l,e) -     ERI(j,e,k,m)*ERI(i,m,e,l) & 
                     -     ERI(j,e,m,k)*ERI(i,m,l,e) -     ERI(j,e,m,k)*ERI(i,m,e,l)
 
@@ -68,6 +68,7 @@ subroutine RGF2_ppBSE_static_kernel_D(ispin,eta,nBas,nC,nO,nV,nR,nOO,lambda,ERI,
             end do
 
             KD_sta(ij,kl) = 2d0*lambda*KD_sta(ij,kl)/sqrt((1d0 + Kronecker_delta(i,j))*(1d0 + Kronecker_delta(k,l)))
+
           end do
         end do