10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-14 10:03:51 +01:00
quantum_package/plugins/FOBOCI/diag_fock_inactiv_virt.irp.f

84 lines
2.2 KiB
Fortran
Raw Normal View History

2016-02-17 17:15:54 +01:00
subroutine diag_inactive_virt_and_update_mos
implicit none
integer :: i,j,i_inact,j_inact,i_virt,j_virt
double precision :: tmp(mo_tot_num_align,mo_tot_num)
character*(64) :: label
2016-03-11 23:27:39 +01:00
print*,'Diagonalizing the occ and virt Fock operator'
2016-02-17 17:15:54 +01:00
tmp = 0.d0
do i = 1, mo_tot_num
tmp(i,i) = Fock_matrix_mo(i,i)
enddo
do i = 1, n_inact_orb
i_inact = list_inact(i)
do j = i+1, n_inact_orb
j_inact = list_inact(j)
tmp(i_inact,j_inact) = Fock_matrix_mo(i_inact,j_inact)
tmp(j_inact,i_inact) = Fock_matrix_mo(j_inact,i_inact)
enddo
enddo
do i = 1, n_virt_orb
i_virt = list_virt(i)
do j = i+1, n_virt_orb
j_virt = list_virt(j)
tmp(i_virt,j_virt) = Fock_matrix_mo(i_virt,j_virt)
tmp(j_virt,i_virt) = Fock_matrix_mo(j_virt,i_virt)
enddo
enddo
label = "Canonical"
call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1)
soft_touch mo_coef
end
2016-03-11 23:27:39 +01:00
subroutine diag_inactive_virt_new_and_update_mos
implicit none
integer :: i,j,i_inact,j_inact,i_virt,j_virt,k,k_act
double precision :: tmp(mo_tot_num_align,mo_tot_num),accu,get_mo_bielec_integral_schwartz
character*(64) :: label
tmp = 0.d0
do i = 1, mo_tot_num
tmp(i,i) = Fock_matrix_mo(i,i)
enddo
do i = 1, n_inact_orb
i_inact = list_inact(i)
do j = i+1, n_inact_orb
j_inact = list_inact(j)
accu =0.d0
do k = 1, n_act_orb
k_act = list_act(k)
accu += get_mo_bielec_integral_schwartz(i_inact,k_act,j_inact,k_act,mo_integrals_map)
accu -= get_mo_bielec_integral_schwartz(i_inact,k_act,k_act,j_inact,mo_integrals_map)
enddo
tmp(i_inact,j_inact) = Fock_matrix_mo(i_inact,j_inact) + accu
tmp(j_inact,i_inact) = Fock_matrix_mo(j_inact,i_inact) + accu
enddo
enddo
do i = 1, n_virt_orb
i_virt = list_virt(i)
do j = i+1, n_virt_orb
j_virt = list_virt(j)
accu =0.d0
do k = 1, n_act_orb
k_act = list_act(k)
accu += get_mo_bielec_integral_schwartz(i_virt,k_act,j_virt,k_act,mo_integrals_map)
enddo
tmp(i_virt,j_virt) = Fock_matrix_mo(i_virt,j_virt) - accu
tmp(j_virt,i_virt) = Fock_matrix_mo(j_virt,i_virt) - accu
enddo
enddo
label = "Canonical"
call mo_as_eigvectors_of_mo_matrix(tmp,size(tmp,1),size(tmp,2),label,1)
soft_touch mo_coef
end