qp_plugins_scemama/devel/cc/curly_Fock.irp.f

BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_oo, (spin_occ_num,spin_occ_num) ]
  implicit none
  BEGIN_DOC
  ! Curly F in Occupied-Occupied block
  END_DOC
  integer                        :: i,j,m,n
  integer                        :: a,b,e,f
  
  do i=1,spin_occ_num
    do m=1,spin_occ_num
      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
    end do
  end do
  
      
  do e=1,spin_vir_num
    do i=1,spin_occ_num
      do n=1,spin_occ_num
        do m=1,spin_occ_num
          c_spin_fock_matrix_mo_oo(m,i) = c_spin_fock_matrix_mo_oo(m,i) +&
              OOOV(m,n,i,e) * t1_cc(n,e)
        end do
      end do
    end do
  end do
      
  call dgemm('N','T', &
    spin_occ_num, spin_occ_num, spin_vir_num, &
    0.5d0, spin_fock_matrix_mo_ov, spin_occ_num, &
    t1_cc, spin_occ_num, &
    1.d0, c_spin_fock_matrix_mo_oo, spin_occ_num)

      
  call dgemm('N','T',                                                &
      spin_occ_num, spin_occ_num, spin_vir_num*spin_occ_num*spin_vir_num,&
      0.5d0, OOVV, spin_occ_num,                                     &
      taus, spin_occ_num,                                            &
      1.d0, c_spin_fock_matrix_mo_oo, spin_occ_num)

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
  BEGIN_DOC
  ! Curly F in Occupied-Virtual block
  END_DOC
  
  integer                        :: i,j,m,n
  integer                        :: a,b,e,f

  c_spin_fock_matrix_mo_ov(:,:) = spin_fock_matrix_mo_ov(:,:)
  
  do m=1,spin_occ_num
    do e=1,spin_vir_num
      
      do n=1,spin_occ_num
        do f=1,spin_vir_num
          c_spin_fock_matrix_mo_ov(m,e) = c_spin_fock_matrix_mo_ov(m,e) + t1_cc(n,f)*OOVV(m,n,e,f)
        end do
      end do
      
    end do
  end do
  
END_PROVIDER


BEGIN_PROVIDER [ double precision, c_spin_fock_matrix_mo_vv, (spin_vir_num,spin_vir_num) ]
  implicit none
  BEGIN_DOC
  ! Curly F in Occupied-Virtual block
  END_DOC
  
  integer                        :: i,j,m,n
  integer                        :: a,b,e,f
  
  do a=1,spin_vir_num
    do e=1,spin_vir_num
      
      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
      
    end do
  end do
  
  call dgemm('T','N',                                                &
      spin_vir_num, spin_vir_num, spin_occ_num,                      &
      -0.5d0, t1_cc, size(t1_cc,1),                                  &
      spin_fock_matrix_mo_ov, size(spin_fock_matrix_mo_ov,1),        &
      1.d0, c_spin_fock_matrix_mo_vv, size(c_spin_fock_matrix_mo_vv,1))

  do e=1,spin_vir_num
    do a=1,spin_vir_num
      do f=1,spin_vir_num
        do m=1,spin_occ_num
          c_spin_fock_matrix_mo_vv(a,e) = c_spin_fock_matrix_mo_vv(a,e) + &
            t1_cc(m,f)*OVVV(m,a,f,e)
        end do
      end do
    end do
  end do


  call dgemm('T','N',                                                &
      spin_vir_num, spin_vir_num, spin_occ_num*spin_occ_num*spin_vir_num,&
      -0.5d0, taus, spin_occ_num*spin_occ_num*spin_vir_num,          &
      OOVV, spin_occ_num*spin_occ_num*spin_vir_num,                  &
      1.d0, c_spin_fock_matrix_mo_vv, spin_vir_num)
  
END_PROVIDER