qp_plugins_scemama/devel/cc/curly_W.irp.f

BEGIN_PROVIDER [ double precision, cWoooo, (spin_occ_num,spin_occ_num,spin_occ_num,spin_occ_num) ]
 implicit none
 BEGIN_DOC
 ! Curly W in occ-occ-occ-occ block
 END_DOC
  integer                        :: i,j,m,n
  integer                        :: a,b,e,f

  cWoooo(:,:,:,:) = OOOO(:,:,:,:)

  do e=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
            cWoooo(m,n,i,j) = cWoooo(m,n,i,j) +                      &
                t1_cc(j,e)*OOOV(m,n,i,e) -                           &
                t1_cc(i,e)*OOOV(m,n,j,e)
          end do
        end do
      end do
    end do
  end do

  double precision :: x
  do f=1,spin_vir_num
    do e=1,spin_vir_num
      do j=1,spin_occ_num
        do i=1,spin_occ_num
          x = 0.25d0*tau_cc(i,j,e,f)
          do n=1,spin_occ_num
            do m=1,spin_occ_num
              cWoooo(m,n,i,j) = cWoooo(m,n,i,j) + x*OOVV(m,n,e,f)
            end do
          end do
        end do
      end do
    end do
  end do

END_PROVIDER


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
 END_DOC
  integer                        :: i,j,m,n
  integer                        :: a,b,e,f
  double precision               :: x


  cWovvo_prime(:,:,:,:) = OVVO_prime(:,:,:,:)

  do f=1,spin_vir_num
    do j=1,spin_occ_num
      do b=1,spin_vir_num
        do e=1,spin_vir_num
          do m=1,spin_occ_num
            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
    end do
  end do

  do j=1,spin_occ_num
    do e=1,spin_vir_num
      do b=1,spin_vir_num
        do n=1,spin_occ_num
          do m=1,spin_occ_num
            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
    end do
  end do

  do j=1,spin_occ_num
    do f=1,spin_vir_num
      do b=1,spin_vir_num
        do n=1,spin_occ_num
          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_prime(m,e,b,j) = cWovvo_prime(m,e,b,j) - x *OOVV(m,n,e,f)
            end do
          end do
        end do
      end do
    end do
  end do
  
END_PROVIDER

  
BEGIN_PROVIDER [ double precision, cWvvvv, (spin_vir_num,spin_vir_num,spin_vir_num,spin_vir_num) ]
 implicit none
 BEGIN_DOC
 ! Curly W in vir-vir-vir-vir block
 END_DOC
  integer                        :: i,j,m,n
  integer                        :: a,b,e,f
  double precision               :: x

  cWvvvv(:,:,:,:) = VVVV(:,:,:,:)

  do f=1,spin_vir_num
    do e=1,spin_vir_num
      do b=1,spin_vir_num
        do a=1,spin_vir_num
          do m=1,spin_occ_num
            cWvvvv(a,b,e,f) = cWvvvv(a,b,e,f) - t1_cc(m,b)*VOVV(a,m,e,f) + t1_cc(m,a)*VOVV(b,m,e,f)
          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.d0
          do n=1,spin_occ_num
            do m=1,spin_occ_num
              x = x + tau_cc(m,n,a,b)*OOVV(m,n,e,f)
            end do
          end do
          cWvvvv(a,b,e,f) = cWvvvv(a,b,e,f) + 0.25d0*x
        end do
      end do
    end do
  end do

END_PROVIDER