Using dgemm in r2_cc

devel/cc/amplitudes.irp.f

@@ -92,3 +92,21 @@ BEGIN_PROVIDER [ double precision, t2_cc, (spin_occ_num,spin_occ_num,spin_vir_nu
  endif
 
 END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, t2_cc2, (spin_occ_num,spin_vir_num,spin_occ_num,spin_vir_num) ]
+  implicit none
+  BEGIN_DOC
+  ! Amplitudes with swapped indices
+  END_DOC
+  integer                        :: i,j,a,b
+  do b=1,spin_vir_num
+    do a=1,spin_vir_num
+      do j=1,spin_occ_num
+        do i=1,spin_occ_num
+          t2_cc2(i,a,j,b) = t2_cc(i,j,a,b)
+        enddo
+      enddo
+    enddo
+  enddo
+END_PROVIDER
+

devel/cc/curly_Fock.irp.f

@@ -3,14 +3,17 @@ BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_oo, (spin_occ_num,spin_
   BEGIN_DOC
   ! Curly F in Occupied-Occupied block
   END_DOC
-  double precision,external      :: Kronecker_Delta
   integer                        :: i,j,m,n
   integer                        :: a,b,e,f
   
   do m=1,spin_occ_num
     do i=1,spin_occ_num
       
-      c_spin_fock_matrix_mo_oo(m,i) = (1d0 - Kronecker_delta(m,i))*spin_fock_matrix_mo_oo(m,i)
+      if (m /= i) then
+        c_spin_fock_matrix_mo_oo(m,i) = spin_fock_matrix_mo_oo(m,i)
+      else
+        c_spin_fock_matrix_mo_oo(m,i) = 0.d0
+      endif
       
       do e=1,spin_vir_num
         c_spin_fock_matrix_mo_oo(m,i) = c_spin_fock_matrix_mo_oo(m,i) + 0.5d0*t1_cc(i,e)*spin_fock_matrix_mo_ov(m,e)
@@ -35,6 +38,19 @@ BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_oo, (spin_occ_num,spin_
   
 END_PROVIDER
 
+BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_oo_transp, (spin_occ_num,spin_occ_num) ]
+  implicit none
+  BEGIN_DOC
+! Transpose of c_spin_fock_matrix_mo_oo
+  END_DOC
+  integer :: i,j
+  do i=1,spin_occ_num
+    do j=1,spin_occ_num
+      c_spin_fock_matrix_mo_oo_transp(j,i) = c_spin_fock_matrix_mo_oo(i,j)
+    enddo
+  enddo
+END_PROVIDER
+
 
 BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_ov, (spin_occ_num,spin_vir_num) ]
   implicit none
@@ -68,14 +84,17 @@ BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_vv, (spin_vir_num,spin_
   ! Curly F in Occupied-Virtual block
   END_DOC
   
-  double precision,external      :: Kronecker_Delta
   integer                        :: i,j,m,n
   integer                        :: a,b,e,f
 
   do a=1,spin_vir_num
     do e=1,spin_vir_num
       
-      c_spin_fock_matrix_mo_vv(a,e) = (1d0 - Kronecker_delta(a,e))*spin_fock_matrix_mo_vv(a,e)
+      if (a /= e) then
+        c_spin_fock_matrix_mo_vv(a,e) = spin_fock_matrix_mo_vv(a,e)
+      else
+        c_spin_fock_matrix_mo_vv(a,e) = 0.d0
+      endif
       
       do m=1,spin_occ_num
         c_spin_fock_matrix_mo_vv(a,e) = c_spin_fock_matrix_mo_vv(a,e) - 0.5d0*t1_cc(m,a)*spin_fock_matrix_mo_ov(m,e)

devel/cc/curly_W.irp.f

@@ -41,7 +41,7 @@ BEGIN_PROVIDER [ double precision, cWoooo, (spin_occ_num,spin_occ_num,spin_occ_n
 END_PROVIDER
 
 
-BEGIN_PROVIDER [ double precision, cWovvo, (spin_occ_num,spin_vir_num,spin_vir_num,spin_occ_num) ]
+BEGIN_PROVIDER [ double precision, cWovvo_prime, (spin_occ_num,spin_vir_num,spin_vir_num,spin_occ_num) ]
  implicit none
  BEGIN_DOC
  ! Curly W in occ-vir-vir-occ block
@@ -50,14 +50,15 @@ BEGIN_PROVIDER [ double precision, cWovvo, (spin_occ_num,spin_vir_num,spin_vir_n
   integer                        :: a,b,e,f
   double precision               :: x
 
-  cWovvo(:,:,:,:) = OVVO(:,:,:,:)
+
+  cWovvo_prime(:,:,:,:) = OVVO_prime(:,:,:,:)
 
   do f=1,spin_vir_num
     do j=1,spin_occ_num
-      do e=1,spin_vir_num
       do b=1,spin_vir_num
+        do e=1,spin_vir_num
           do m=1,spin_occ_num
-            cWovvo(m,b,e,j) = cWovvo(m,b,e,j) + t1_cc(j,f)*OVVV(m,b,e,f)
+            cWovvo_prime(m,e,b,j) = cWovvo_prime(m,e,b,j) + t1_cc(j,f)*OVVV(m,b,e,f)
           end do
         end do
       end do
@@ -69,7 +70,7 @@ BEGIN_PROVIDER [ double precision, cWovvo, (spin_occ_num,spin_vir_num,spin_vir_n
       do b=1,spin_vir_num
         do n=1,spin_occ_num
           do m=1,spin_occ_num
-            cWovvo(m,b,e,j) = cWovvo(m,b,e,j) - t1_cc(n,b)*OOVO(m,n,e,j)
+            cWovvo_prime(m,e,b,j) = cWovvo_prime(m,e,b,j) - t1_cc(n,b)*OOVO(m,n,e,j)
           end do
         end do
       end do
@@ -83,7 +84,7 @@ BEGIN_PROVIDER [ double precision, cWovvo, (spin_occ_num,spin_vir_num,spin_vir_n
           x = 0.5d0*t2_cc(j,n,f,b)  + t1_cc(j,f)*t1_cc(n,b)
           do e=1,spin_vir_num
             do m=1,spin_occ_num
-              cWovvo(m,b,e,j) = cWovvo(m,b,e,j) - x *OOVV(m,n,e,f)
+              cWovvo_prime(m,e,b,j) = cWovvo_prime(m,e,b,j) - x *OOVV(m,n,e,f)
             end do
           end do
         end do

devel/cc/integral_batches.irp.f

@@ -93,6 +93,22 @@ BEGIN_PROVIDER [ double precision, OVVO, (spin_occ_num,spin_vir_num,spin_vir_num
       1:spin_occ_num)
 END_PROVIDER
 
+BEGIN_PROVIDER [ double precision, OVVO_prime, (spin_occ_num,spin_vir_num,spin_vir_num,spin_occ_num) ]
+  implicit none
+  BEGIN_DOC
+  END_DOC
+  integer                        :: m,b,e,j
+  do j=1,spin_occ_num
+    do b=1,spin_vir_num
+      do e=1,spin_vir_num
+        do m=1,spin_occ_num
+          OVVO_prime(m,e,b,j) = OVVO(m,b,e,j)
+        enddo
+      enddo
+    enddo
+  enddo
+  FREE OVVO
+END_PROVIDER
 
 BEGIN_PROVIDER [ double precision, VOVO, (spin_vir_num,spin_occ_num,spin_vir_num,spin_occ_num) ]
   implicit none

devel/cc/r2_cc.irp.f

@@ -6,299 +6,187 @@ BEGIN_PROVIDER [ double precision, r2_cc, (spin_occ_num,spin_occ_num,spin_vir_nu
   integer                        :: i,j,m,n
   integer                        :: a,b,e,f
   double precision               :: x
+  double precision, allocatable  :: mat_A(:,:), mat_B(:,:), mat_C(:,:)
 
   r2_cc(:,:,:,:) = OOVV(:,:,:,:)
 
-  do e=1,spin_vir_num
+  allocate ( mat_A(spin_vir_num,spin_vir_num), mat_C(spin_vir_num,spin_vir_num), & 
-    do b=1,spin_vir_num
+             mat_B(spin_vir_num,spin_occ_num) )
-      do a=1,spin_vir_num
+
   do j=1,spin_occ_num
     do i=1,spin_occ_num
-            r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t2_cc(i,j,a,e)*c_spin_fock_matrix_mo_vv(b,e)
+      mat_A(:,:) = t2_cc(i,j,:,:)
-          end do
+      call dgemm('N', 'T',                                           &
-        end do
+          spin_vir_num, spin_vir_num, spin_vir_num,                  &
-      end do
+          1.d0, mat_A, size(mat_A,1),                                &
-    end do
+          c_spin_fock_matrix_mo_vv, size(c_spin_fock_matrix_mo_vv,1),&
-  end do
+          0.d0, mat_C, size(mat_C,1) )
 
+      call dgemm('N', 'T',                                           &
+          spin_vir_num, spin_occ_num, spin_vir_num,                  &
+          -0.5d0, mat_A, size(mat_A,1),                              &
+          c_spin_fock_matrix_mo_ov, size(c_spin_fock_matrix_mo_ov,1),&
+          0.d0, mat_B, size(mat_B,1) )
+      
+      call dgemm('N', 'N',                                           &
+          spin_vir_num, spin_vir_num, spin_occ_num,                  &
+          1.d0, mat_B, size(mat_B,1),                                &
+          t1_cc, size(t1_cc,1),                                      &
+          1.d0, mat_C, size(mat_C,1) )
 
-  do e=1,spin_vir_num
       do b=1,spin_vir_num
         do a=1,spin_vir_num
+          r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + mat_C(a,b) - mat_C(b,a)
+        enddo
+      enddo
+
+    enddo
+  enddo
+
+
+  deallocate(mat_A,mat_B,mat_C)
+
+  allocate ( mat_A(spin_occ_num,spin_occ_num), mat_C(spin_occ_num,spin_occ_num), & 
+             mat_B(spin_occ_num,spin_vir_num) )
+
+  do b=1,spin_vir_num
+    do a=1,spin_vir_num
+
+      call dgemm('N', 'N',                                           &
+          spin_occ_num, spin_occ_num, spin_occ_num,                  &
+          1.d0, t2_cc(1,1,a,b), size(t2_cc,1),                       &
+          c_spin_fock_matrix_mo_oo, size(c_spin_fock_matrix_mo_oo,1),&
+          0.d0, mat_C, size(mat_C,1) )
+
+
+      call dgemm('N', 'N',                                           &
+          spin_occ_num, spin_vir_num, spin_occ_num,                  &
+          0.5d0, t2_cc(1,1,a,b), size(t2_cc,1),                      &
+          c_spin_fock_matrix_mo_ov, size(c_spin_fock_matrix_mo_ov,1),&
+          0.d0, mat_B, size(mat_B,1) )
+      
+      call dgemm('N', 'T',                                           &
+          spin_occ_num, spin_occ_num, spin_vir_num,                  &
+          1.d0, mat_B, size(mat_B,1),                                &
+          t1_cc, size(t1_cc,1),                                      &
+          1.d0, mat_C, size(mat_C,1) )
+
       do j=1,spin_occ_num
         do i=1,spin_occ_num
-            r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t2_cc(i,j,b,e)*c_spin_fock_matrix_mo_vv(a,e)
+          r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + mat_C(j,i) - mat_C(i,j)
-          end do
+        enddo
-        end do
+      enddo
-      end do
+
     end do
   end do
 
+  deallocate(mat_A,mat_B,mat_C)
 
- do b=1,spin_vir_num
+  call dgemm('T', 'N',                                               &
-   do e=1,spin_vir_num
+      spin_occ_num*spin_occ_num, spin_vir_num*spin_vir_num, spin_occ_num*spin_occ_num,&
-     do a=1,spin_vir_num
+      0.5d0, cWoooo, spin_occ_num*spin_occ_num,                      &
-       do j=1,spin_occ_num
+      tau_cc, spin_occ_num*spin_occ_num,                             &
-         do i=1,spin_occ_num
+      1.d0, r2_cc, spin_occ_num*spin_occ_num)
-           x = 0.5d0*t2_cc(i,j,a,e)
+
-           if (x /= 0.d0) then
+  call dgemm('N', 'T',                                               &
-              do m=1,spin_occ_num
+      spin_occ_num*spin_occ_num, spin_vir_num*spin_vir_num, spin_vir_num*spin_vir_num,&
-                r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - x*t1_cc(m,b)*c_spin_fock_matrix_mo_ov(m,e)
+      0.5d0, tau_cc, spin_occ_num*spin_occ_num,                      &
-              end do
+      cWvvvv, spin_vir_num*spin_vir_num,                             &
-            endif
+      1.d0, r2_cc, spin_occ_num*spin_occ_num)
-          end do
-        end do
-      end do
-    end do
-  end do
 
 
-  do e=1,spin_vir_num
+  double precision, allocatable :: tmp(:,:,:,:), tmp2(:,:,:,:)
-    do b=1,spin_vir_num
+  allocate(tmp(spin_occ_num,spin_vir_num,spin_vir_num,spin_occ_num), &
-      do a=1,spin_vir_num
+           tmp2(spin_occ_num,spin_vir_num,spin_occ_num,spin_vir_num) )
-        do j=1,spin_occ_num
-          do i=1,spin_occ_num
-            x = 0.5d0*t2_cc(i,j,b,e)
-            if (x /= 0.d0) then
-              do m=1,spin_occ_num
-                r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + x*t1_cc(m,a)*c_spin_fock_matrix_mo_ov(m,e)
-              end do
-            endif
-          end do
-        end do
-      end do
-    end do
-  end do
 
   
-  do b=1,spin_vir_num
+  call dgemm('N', 'N',                                               &
-    do a=1,spin_vir_num
+      spin_occ_num*spin_vir_num, spin_occ_num*spin_vir_num, spin_occ_num*spin_vir_num,&
-      do j=1,spin_occ_num
+      1.0d0, t2_cc2, spin_occ_num*spin_vir_num,                      &
-        do m=1,spin_occ_num
+      cWovvo_prime, spin_occ_num*spin_vir_num,                       &
-          x = c_spin_fock_matrix_mo_oo(m,j)
+      0.d0, tmp, spin_occ_num*spin_vir_num)
-          do i=1,spin_occ_num
-            r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t2_cc(i,m,a,b)*x
-          end do
-        end do
-      end do
-    end do
-  end do
-
-  do b=1,spin_vir_num
-    do a=1,spin_vir_num
-      do j=1,spin_occ_num
-        do i=1,spin_occ_num
-          do m=1,spin_occ_num
-            r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t2_cc(j,m,a,b)*c_spin_fock_matrix_mo_oo(m,i)
-          end do
-        end do
-      end do
-    end do
-  end do
 
 
-  do b=1,spin_vir_num
-    do a=1,spin_vir_num
   do e=1,spin_vir_num
     do m=1,spin_occ_num
-          x = 0.5d0*c_spin_fock_matrix_mo_ov(m,e)
-          if (x == 0.d0) cycle
-          do j=1,spin_occ_num
-            do i=1,spin_occ_num
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - x*t2_cc(i,m,a,b)*t1_cc(j,e)
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-
-
-  do b=1,spin_vir_num
       do a=1,spin_vir_num
-      do e=1,spin_vir_num
-        do m=1,spin_occ_num
-          x = 0.5d0*c_spin_fock_matrix_mo_ov(m,e)
-          do j=1,spin_occ_num
         do i=1,spin_occ_num
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + x*t2_cc(j,m,a,b)*t1_cc(i,e)
+          tmp2(i,a,m,e) = -t1_cc(i,e)*t1_cc(m,a)
-            end do
+        enddo
-          end do
+      enddo
-        end do
+    enddo
-      end do
+  enddo
-    end do
+
-  end do
+  call dgemm('N', 'N',                                               &
+      spin_occ_num*spin_vir_num, spin_occ_num*spin_vir_num, spin_occ_num*spin_vir_num,&
+      1.0d0, tmp2, spin_occ_num*spin_vir_num,                        &
+      OVVO_prime, spin_occ_num*spin_vir_num,                         &
+      1.d0, tmp, spin_occ_num*spin_vir_num)
   
 
   do b=1,spin_vir_num
     do a=1,spin_vir_num
       do j=1,spin_occ_num
         do i=1,spin_occ_num
-          do n=1,spin_occ_num
+          r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + tmp(i,a,b,j)
-            do m=1,spin_occ_num
+          r2_cc(j,i,a,b) = r2_cc(j,i,a,b) - tmp(i,a,b,j)
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + 0.5d0*tau_cc(m,n,a,b)*cWoooo(m,n,i,j)
+          r2_cc(i,j,b,a) = r2_cc(i,j,b,a) - tmp(i,a,b,j)
-            end do
+          r2_cc(j,i,b,a) = r2_cc(j,i,b,a) + tmp(i,a,b,j)
-          end do
+        enddo
-        end do
+      enddo
-      end do
+    enddo
-    end do
+  enddo
-  end do
 
 
-  do f=1,spin_vir_num
+
-    do e=1,spin_vir_num
+  deallocate(tmp,tmp2)
-      do b=1,spin_vir_num
+
-        do a=1,spin_vir_num
+  allocate( mat_A(spin_vir_num,spin_occ_num), mat_C(spin_occ_num,spin_occ_num) )
-          x = 0.5d0*cWvvvv(a,b,e,f) 
+!  
-          if (x /= 0.d0) then
+!  do b=1,spin_vir_num
-            do j=1,spin_occ_num
+!    do a=1,spin_vir_num
-              do i=1,spin_occ_num
+!
-                r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + x*tau_cc(i,j,e,f)
+!      do j=1,spin_occ_num
-              end do
+!        do e=1,spin_vir_num
-            end do
+!          mat_A(e,j) = VVVO(a,b,e,j)
-          endif
+!        enddo
-        end do
+!      enddo
-      end do
+!
-    end do
+!      call dgemm('N', 'N',                                           &
-  end do
+!          spin_occ_num, spin_occ_num, spin_vir_num,                  &
+!          1.0d0, t1_cc, spin_occ_num,                                &
+!          mat_A, size(mat_A,1),                                      &
+!          0.d0, mat_C, spin_occ_num)
+!
+!      do j=1,spin_occ_num
+!        do i=1,spin_occ_num
+!          r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + mat_C(i,j) - mat_C(j,i)
+!        enddo
+!      endd
+!
+!    enddo
+!  enddo
 
 
   do b=1,spin_vir_num
     do a=1,spin_vir_num
+
       do j=1,spin_occ_num
         do e=1,spin_vir_num
-          do m=1,spin_occ_num
+          mat_A(e,j) = VVVO(a,b,e,j)
-            do i=1,spin_occ_num
+        enddo
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t2_cc(i,m,a,e)*cWovvo(m,b,e,j) 
+      enddo
-            end do
+      call dgemm('N', 'N',                                           &
-          end do
+          spin_occ_num, spin_occ_num, spin_vir_num,                  &
-        end do
+          1.0d0, t1_cc, spin_occ_num,                                &
-      end do
+          mat_A, size(mat_A,1),                                      &
-    end do
+          0.d0, mat_C, spin_occ_num)
-  end do
-
-  do b=1,spin_vir_num
-    do a=1,spin_vir_num
-      do j=1,spin_occ_num
-        do e=1,spin_vir_num
-          do m=1,spin_occ_num
-            x = t1_cc(m,a)*OVVO(m,b,e,j)
-            do i=1,spin_occ_num
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t1_cc(i,e)*x
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-
-  do b=1,spin_vir_num
-    do e=1,spin_vir_num
-      do a=1,spin_vir_num
       do j=1,spin_occ_num
         do i=1,spin_occ_num
-            do m=1,spin_occ_num
+          r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + mat_C(i,j) - mat_C(j,i)
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t2_cc(j,m,a,e)*cWovvo(m,b,e,i) 
+        enddo
-            end do
+      enddo
-          end do
-        end do
-      end do
-    end do
-  end do
 
-  do b=1,spin_vir_num
-    do a=1,spin_vir_num
-      do e=1,spin_vir_num
-        do j=1,spin_occ_num
-          do i=1,spin_occ_num
-            do m=1,spin_occ_num
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t1_cc(j,e)*t1_cc(m,a)*OVVO(m,b,e,i)
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-
- do e=1,spin_vir_num
-   do b=1,spin_vir_num
-     do a=1,spin_vir_num
-       do j=1,spin_occ_num
-         do m=1,spin_occ_num
-           do i=1,spin_occ_num
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t2_cc(i,m,b,e)*cWovvo(m,a,e,j) 
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-
-  do b=1,spin_vir_num
-    do a=1,spin_vir_num
-      do j=1,spin_occ_num
-        do e=1,spin_vir_num
-          do i=1,spin_occ_num
-            do m=1,spin_occ_num
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t1_cc(i,e)*t1_cc(m,b)*OVVO(m,a,e,j) 
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-
-  do e=1,spin_vir_num
-    do b=1,spin_vir_num
-      do a=1,spin_vir_num
-        do j=1,spin_occ_num
-          do i=1,spin_occ_num
-            do m=1,spin_occ_num
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t2_cc(j,m,b,e)*cWovvo(m,a,e,i) 
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-
-  do b=1,spin_vir_num
-    do e=1,spin_vir_num
-      do a=1,spin_vir_num
-        do j=1,spin_occ_num
-          do i=1,spin_occ_num
-            do m=1,spin_occ_num
-              r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t1_cc(j,e)*t1_cc(m,b)*OVVO(m,a,e,i)
-            end do
-          end do
-        end do
-      end do
-    end do
-  end do
-
-
-  do b=1,spin_vir_num
-    do a=1,spin_vir_num
-      do j=1,spin_occ_num
-        do e=1,spin_vir_num
-          do i=1,spin_occ_num
-            r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t1_cc(i,e)*VVVO(a,b,e,j) 
-          end do
-        end do
-      end do
-    end do
-  end do
-
-
-  do b=1,spin_vir_num
-    do a=1,spin_vir_num
-      do e=1,spin_vir_num
-        do i=1,spin_occ_num
-          do j=1,spin_occ_num
-            r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t1_cc(j,e)*VVVO(a,b,e,i)
-          end do
-        end do
-      end do
     end do
   end do
 
@@ -309,17 +197,6 @@ BEGIN_PROVIDER [ double precision, r2_cc, (spin_occ_num,spin_occ_num,spin_vir_nu
         do i=1,spin_occ_num
           do m=1,spin_occ_num
             r2_cc(i,j,a,b) = r2_cc(i,j,a,b) - t1_cc(m,a)*OVOO(m,b,i,j) 
-          end do
-        end do
-      end do
-    end do
-  end do
-
-  do b=1,spin_vir_num
-    do a=1,spin_vir_num
-      do j=1,spin_occ_num
-        do i=1,spin_occ_num
-          do m=1,spin_occ_num
             r2_cc(i,j,a,b) = r2_cc(i,j,a,b) + t1_cc(m,b)*OVOO(m,a,i,j) 
           end do
         end do
@@ -327,8 +204,10 @@ BEGIN_PROVIDER [ double precision, r2_cc, (spin_occ_num,spin_occ_num,spin_vir_nu
      end do
    end do
 
+
 ! Final expression of the t2 residue
 
   r2_cc(:,:,:,:) = delta_oovv(:,:,:,:)*t2_cc(:,:,:,:) - r2_cc(:,:,:,:)
 
 END_PROVIDER
+