qp_plugins_scemama/devel/cc/r2_cc.irp.f

BEGIN_PROVIDER [ double precision, r2_cc, (spin_occ_num,spin_occ_num,spin_vir_num,spin_vir_num) ]
  implicit none
  BEGIN_DOC
  ! t2 residues in non-canonical CCSD
  END_DOC
  integer                        :: i,j,m,n
  integer                        :: a,b,e,f
  double precision               :: x
  double precision, allocatable  :: tmp_oo(:,:), tmp_oo2(:,:)

  allocate ( tmp_oo(spin_occ_num,spin_occ_num) )
  
  r2_cc(:,:,:,:) = OOVV(:,:,:,:)
  
  do e=1,spin_vir_num
    do b=1,spin_vir_num
      do a=1,spin_vir_num
        if (a == b) cycle
        tmp_oo(:,:) = c_spin_fock_matrix_mo_vv(b,e) * t2_cc(:,:,a,e)
        do m=1,spin_occ_num
          x = 0.5d0 * t1_cc(m,b) * c_spin_fock_matrix_mo_ov(m,e)
          if (x == 0.d0) cycle
          tmp_oo(:,:) =  tmp_oo(:,:) - t2_cc(:,:,a,e)*x
        enddo
        r2_cc(:,:,a,b) = r2_cc(:,:,a,b) + tmp_oo(:,:)
        r2_cc(:,:,b,a) = r2_cc(:,:,b,a) - tmp_oo(:,:)
      end do
      
      
      do m=1,spin_occ_num
        do j=1,spin_occ_num
          x = c_spin_fock_matrix_mo_oo(m,j)
          r2_cc(:,j,b,e) = r2_cc(:,j,b,e) - t2_cc(:,m,b,e)*x
        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)
            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 i=1,spin_occ_num
          do n=1,spin_occ_num
            do m=1,spin_occ_num
              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)
            end do
          end do
        end do
      end do
    end do
  end do
  
  
  do f=1,spin_vir_num
    do e=1,spin_vir_num
      do b=1,spin_vir_num
        do a=1,spin_vir_num
          x = 0.5d0*cWvvvv(a,b,e,f)
          if (x /= 0.d0) then
            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*tau_cc(i,j,e,f)
              end do
            end do
          endif
        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 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,a,e)*cWovvo(m,b,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 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) - t2_cc(j,m,a,e)*cWovvo(m,b,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 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
  
  
  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,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
      end do
    end do
  end do
  
  ! Final expression of the t2 residue
  
  r2_cc(:,:,:,:) = delta_oovv(:,:,:,:)*t2_cc(:,:,:,:) - r2_cc(:,:,:,:)
  
END_PROVIDER