mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-08-29 04:12:00 +02:00
cleaning in tc_scf
This commit is contained in:
parent
d6ed501c91
commit
cc16cea1b0
@ -38,33 +38,9 @@
|
||||
, fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
||||
, n_real_tc, eigval_right_tmp )
|
||||
|
||||
!if(max_ov_tc_scf)then
|
||||
! call non_hrmt_fock_mat( mo_num, F_tmp, thresh_biorthog_diag, thresh_biorthog_nondiag &
|
||||
! , fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
||||
! , n_real_tc, eigval_right_tmp )
|
||||
!else
|
||||
! call non_hrmt_diag_split_degen_bi_orthog( mo_num, F_tmp &
|
||||
! , fock_tc_leigvec_mo, fock_tc_reigvec_mo &
|
||||
! , n_real_tc, eigval_right_tmp )
|
||||
!endif
|
||||
|
||||
deallocate(F_tmp)
|
||||
|
||||
|
||||
! if(n_real_tc .ne. mo_num)then
|
||||
! print*,'n_real_tc ne mo_num ! ',n_real_tc
|
||||
! stop
|
||||
! endif
|
||||
|
||||
eigval_fock_tc_mo = eigval_right_tmp
|
||||
! print*,'Eigenvalues of Fock_matrix_tc_mo_tot'
|
||||
! do i = 1, elec_alpha_num
|
||||
! print*, i, eigval_fock_tc_mo(i)
|
||||
! enddo
|
||||
! do i = elec_alpha_num+1, mo_num
|
||||
! print*, i, eigval_fock_tc_mo(i) - level_shift_tcscf
|
||||
! enddo
|
||||
! deallocate( eigval_right_tmp )
|
||||
|
||||
! L.T x R
|
||||
call dgemm( "T", "N", mo_num, mo_num, mo_num, 1.d0 &
|
||||
|
@ -49,6 +49,11 @@ END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_a, (mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! ALPHA part of the Fock matrix from three-electron terms
|
||||
!
|
||||
! WARNING :: non hermitian if bi-ortho MOS used
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: a, b, i, j, o
|
||||
double precision :: I_bij_aij, I_bij_ija, I_bij_jai, I_bij_aji, I_bij_iaj, I_bij_jia
|
||||
@ -145,6 +150,11 @@ END_PROVIDER
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_3e_uhf_mo_b, (mo_num, mo_num)]
|
||||
BEGIN_DOC
|
||||
! BETA part of the Fock matrix from three-electron terms
|
||||
!
|
||||
! WARNING :: non hermitian if bi-ortho MOS used
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer :: a, b, i, j, o
|
||||
|
@ -6,10 +6,11 @@
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! two_e_tc_non_hermit_integral_seq_alpha(k,i) = <k| F^tc_alpha |i>
|
||||
! two_e_tc_non_hermit_integral_seq_alpha(k,i) = <k| F^tc_alpha |i> ON THE AO BASIS
|
||||
!
|
||||
! where F^tc is the two-body part of the TC Fock matrix and k,i are AO basis functions
|
||||
! where F^tc is the TWO-BODY part of the TC Fock matrix and k,i are AO basis functions
|
||||
!
|
||||
! works in SEQUENTIAL
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
@ -17,8 +18,6 @@
|
||||
double precision :: density, density_a, density_b
|
||||
double precision :: t0, t1
|
||||
|
||||
!print*, ' providing two_e_tc_non_hermit_integral_seq ...'
|
||||
!call wall_time(t0)
|
||||
|
||||
two_e_tc_non_hermit_integral_seq_alpha = 0.d0
|
||||
two_e_tc_non_hermit_integral_seq_beta = 0.d0
|
||||
@ -32,24 +31,6 @@
|
||||
density_b = TCSCF_density_matrix_ao_beta (l,j)
|
||||
density = density_a + density_b
|
||||
|
||||
!! rho(l,j) * < k l| T | i j>
|
||||
!two_e_tc_non_hermit_integral_seq_alpha(k,i) += density * ao_two_e_tc_tot(l,j,k,i)
|
||||
!! rho(l,j) * < k l| T | i j>
|
||||
!two_e_tc_non_hermit_integral_seq_beta (k,i) += density * ao_two_e_tc_tot(l,j,k,i)
|
||||
!! rho_a(l,j) * < l k| T | i j>
|
||||
!two_e_tc_non_hermit_integral_seq_alpha(k,i) -= density_a * ao_two_e_tc_tot(k,j,l,i)
|
||||
!! rho_b(l,j) * < l k| T | i j>
|
||||
!two_e_tc_non_hermit_integral_seq_beta (k,i) -= density_b * ao_two_e_tc_tot(k,j,l,i)
|
||||
|
||||
!! rho(l,j) * < k l| T | i j>
|
||||
!two_e_tc_non_hermit_integral_alpha(k,i) += density * ao_two_e_tc_tot(l,j,k,i)
|
||||
!! rho(l,j) * < k l| T | i j>
|
||||
!two_e_tc_non_hermit_integral_beta (k,i) += density * ao_two_e_tc_tot(l,j,k,i)
|
||||
!! rho_a(l,j) * < l k| T | i j>
|
||||
!two_e_tc_non_hermit_integral_alpha(k,i) -= density_a * ao_two_e_tc_tot(k,j,l,i)
|
||||
!! rho_b(l,j) * < l k| T | i j>
|
||||
!two_e_tc_non_hermit_integral_beta (k,i) -= density_b * ao_two_e_tc_tot(k,j,l,i)
|
||||
|
||||
! rho(l,j) * < k l| T | i j>
|
||||
two_e_tc_non_hermit_integral_seq_alpha(k,i) += density * ao_two_e_tc_tot(k,i,l,j)
|
||||
! rho(l,j) * < k l| T | i j>
|
||||
@ -64,8 +45,6 @@
|
||||
enddo
|
||||
enddo
|
||||
|
||||
!call wall_time(t1)
|
||||
!print*, ' wall time for two_e_tc_non_hermit_integral_seq after = ', t1 - t0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -76,9 +55,9 @@ END_PROVIDER
|
||||
|
||||
BEGIN_DOC
|
||||
!
|
||||
! two_e_tc_non_hermit_integral_alpha(k,i) = <k| F^tc_alpha |i>
|
||||
! two_e_tc_non_hermit_integral_alpha(k,i) = <k| F^tc_alpha |i> ON THE AO BASIS
|
||||
!
|
||||
! where F^tc is the two-body part of the TC Fock matrix and k,i are AO basis functions
|
||||
! where F^tc is the TWO-BODY part of the TC Fock matrix and k,i are AO basis functions
|
||||
!
|
||||
END_DOC
|
||||
|
||||
@ -88,8 +67,6 @@ END_PROVIDER
|
||||
double precision :: t0, t1
|
||||
double precision, allocatable :: tmp_a(:,:), tmp_b(:,:)
|
||||
|
||||
!print*, ' providing two_e_tc_non_hermit_integral ...'
|
||||
!call wall_time(t0)
|
||||
|
||||
two_e_tc_non_hermit_integral_alpha = 0.d0
|
||||
two_e_tc_non_hermit_integral_beta = 0.d0
|
||||
@ -135,8 +112,6 @@ END_PROVIDER
|
||||
deallocate(tmp_a, tmp_b)
|
||||
!$OMP END PARALLEL
|
||||
|
||||
!call wall_time(t1)
|
||||
!print*, ' wall time for two_e_tc_non_hermit_integral after = ', t1 - t0
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
@ -181,14 +156,6 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_tc_mo_alpha, (mo_num, mo_num) ]
|
||||
|
||||
if(bi_ortho) then
|
||||
|
||||
!allocate(tmp(ao_num,ao_num))
|
||||
!tmp = Fock_matrix_tc_ao_alpha
|
||||
!if(three_body_h_tc) then
|
||||
! tmp += fock_3e_uhf_ao_a
|
||||
!endif
|
||||
!call ao_to_mo_bi_ortho(tmp, size(tmp, 1), Fock_matrix_tc_mo_alpha, size(Fock_matrix_tc_mo_alpha, 1))
|
||||
!deallocate(tmp)
|
||||
|
||||
call ao_to_mo_bi_ortho( Fock_matrix_tc_ao_alpha, size(Fock_matrix_tc_ao_alpha, 1) &
|
||||
, Fock_matrix_tc_mo_alpha, size(Fock_matrix_tc_mo_alpha, 1) )
|
||||
if(three_body_h_tc) then
|
||||
@ -217,14 +184,6 @@ BEGIN_PROVIDER [ double precision, Fock_matrix_tc_mo_beta, (mo_num,mo_num) ]
|
||||
|
||||
if(bi_ortho) then
|
||||
|
||||
!allocate(tmp(ao_num,ao_num))
|
||||
!tmp = Fock_matrix_tc_ao_beta
|
||||
!if(three_body_h_tc) then
|
||||
! tmp += fock_3e_uhf_ao_b
|
||||
!endif
|
||||
!call ao_to_mo_bi_ortho(tmp, size(tmp, 1), Fock_matrix_tc_mo_beta, size(Fock_matrix_tc_mo_beta, 1))
|
||||
!deallocate(tmp)
|
||||
|
||||
call ao_to_mo_bi_ortho( Fock_matrix_tc_ao_beta, size(Fock_matrix_tc_ao_beta, 1) &
|
||||
, Fock_matrix_tc_mo_beta, size(Fock_matrix_tc_mo_beta, 1) )
|
||||
if(three_body_h_tc) then
|
||||
|
@ -3,7 +3,7 @@
|
||||
&BEGIN_PROVIDER [ double precision, Fock_matrix_tc_diag_mo_tot, (mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Fock matrix on the MO basis.
|
||||
! TC-Fock matrix on the MO basis. WARNING !!! NON HERMITIAN !!!
|
||||
! For open shells, the ROHF Fock Matrix is ::
|
||||
!
|
||||
! | F-K | F + K/2 | F |
|
||||
|
@ -1,178 +1,296 @@
|
||||
BEGIN_PROVIDER [ double precision, fock_a_abb_3e_bi_orth_old, (mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! fock_a_abb_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,beta,beta contribution
|
||||
END_DOC
|
||||
fock_a_abb_3e_bi_orth_old = 0.d0
|
||||
integer :: i,a,j,k
|
||||
double precision :: direct_int, exch_23_int
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = 1, elec_beta_num
|
||||
do k = j+1, elec_beta_num
|
||||
! see contrib_3e_soo
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int) ! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)! < a k j | i j k > : E_23
|
||||
fock_a_abb_3e_bi_orth_old(a,i) += direct_int - exch_23_int
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth, (mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! Alpha part of the Fock matrix from three-electron terms
|
||||
!
|
||||
! WARNING :: non hermitian if bi-ortho MOS used
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i, a
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_a_tot_3e_bi_orth = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
fock_a_tot_3e_bi_orth(a,i) += fock_cs_3e_bi_orth (a,i)
|
||||
fock_a_tot_3e_bi_orth(a,i) += fock_a_tmp1_bi_ortho(a,i)
|
||||
fock_a_tot_3e_bi_orth(a,i) += fock_a_tmp2_bi_ortho(a,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
fock_a_abb_3e_bi_orth_old = - fock_a_abb_3e_bi_orth_old
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_a_aba_3e_bi_orth_old, (mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! fock_a_aba_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,beta contribution
|
||||
END_DOC
|
||||
fock_a_aba_3e_bi_orth_old = 0.d0
|
||||
integer :: i,a,j,k
|
||||
double precision :: direct_int, exch_13_int
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = 1, elec_alpha_num ! a
|
||||
do k = 1, elec_beta_num ! b
|
||||
! a b a a b a
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)! < a k j | j k i > : E_13
|
||||
fock_a_aba_3e_bi_orth_old(a,i) += direct_int - exch_13_int
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth, (mo_num, mo_num)]
|
||||
|
||||
BEGIN_DOC
|
||||
! Beta part of the Fock matrix from three-electron terms
|
||||
!
|
||||
! WARNING :: non hermitian if bi-ortho MOS used
|
||||
END_DOC
|
||||
implicit none
|
||||
integer :: i, a
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_b_tot_3e_bi_orth = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
fock_b_tot_3e_bi_orth(a,i) += fock_cs_3e_bi_orth (a,i)
|
||||
fock_b_tot_3e_bi_orth(a,i) += fock_b_tmp2_bi_ortho(a,i)
|
||||
fock_b_tot_3e_bi_orth(a,i) += fock_b_tmp1_bi_ortho(a,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
fock_a_aba_3e_bi_orth_old = - fock_a_aba_3e_bi_orth_old
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_a_aaa_3e_bi_orth_old, (mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! fock_a_aaa_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,alpha contribution
|
||||
END_DOC
|
||||
fock_a_aaa_3e_bi_orth_old = 0.d0
|
||||
integer :: i,a,j,k
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = 1, elec_alpha_num
|
||||
do k = j+1, elec_alpha_num
|
||||
! positive terms :: cycle contrib
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i >
|
||||
fock_a_aaa_3e_bi_orth_old(a,i) += direct_int + c_3_int + c_minus_3_int
|
||||
! negative terms :: exchange contrib
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12
|
||||
fock_a_aaa_3e_bi_orth_old(a,i) += - exch_13_int - exch_23_int - exch_12_int
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_cs_3e_bi_orth, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: contrib_sss, contrib_sos, contrib_soo, contrib
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
|
||||
double precision :: new
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_cs_3e_bi_orth = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = 1, elec_beta_num
|
||||
do k = 1, elec_beta_num
|
||||
|
||||
!!call contrib_3e_sss(a,i,j,k,contrib_sss)
|
||||
!!call contrib_3e_soo(a,i,j,k,contrib_soo)
|
||||
!!call contrib_3e_sos(a,i,j,k,contrib_sos)
|
||||
!!contrib = 0.5d0 * (contrib_sss + contrib_soo) + contrib_sos
|
||||
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i >
|
||||
|
||||
! negative terms :: exchange contrib
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12
|
||||
|
||||
new = 2.d0 * direct_int + 0.5d0 * (c_3_int + c_minus_3_int - exch_12_int) -1.5d0 * exch_13_int - exch_23_int
|
||||
|
||||
fock_cs_3e_bi_orth(a,i) += new
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
fock_a_aaa_3e_bi_orth_old = - fock_a_aaa_3e_bi_orth_old
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth_old, (mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! fock_a_tot_3e_bi_orth_old = bi-ortho 3-e Fock matrix for alpha electrons from all possible spin contributions
|
||||
END_DOC
|
||||
fock_a_tot_3e_bi_orth_old = fock_a_abb_3e_bi_orth_old + fock_a_aba_3e_bi_orth_old + fock_a_aaa_3e_bi_orth_old
|
||||
|
||||
fock_cs_3e_bi_orth = - fock_cs_3e_bi_orth
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_b_baa_3e_bi_orth_old, (mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! fock_b_baa_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for beta electrons from beta,alpha,alpha contribution
|
||||
END_DOC
|
||||
fock_b_baa_3e_bi_orth_old = 0.d0
|
||||
integer :: i,a,j,k
|
||||
double precision :: direct_int, exch_23_int
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = 1, elec_alpha_num
|
||||
do k = j+1, elec_alpha_num
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int) ! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)! < a k j | i j k > : E_23
|
||||
fock_b_baa_3e_bi_orth_old(a,i) += direct_int - exch_23_int
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_a_tmp1_bi_ortho, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: contrib_sss, contrib_sos, contrib_soo, contrib
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
|
||||
double precision :: new
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_a_tmp1_bi_ortho = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = elec_beta_num + 1, elec_alpha_num
|
||||
do k = 1, elec_beta_num
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12
|
||||
|
||||
fock_a_tmp1_bi_ortho(a,i) += 1.5d0 * (direct_int - exch_13_int) + 0.5d0 * (c_3_int + c_minus_3_int - exch_23_int - exch_12_int)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
fock_b_baa_3e_bi_orth_old = - fock_b_baa_3e_bi_orth_old
|
||||
|
||||
fock_a_tmp1_bi_ortho = - fock_a_tmp1_bi_ortho
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_b_bab_3e_bi_orth_old, (mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! fock_b_bab_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for beta electrons from beta,alpha,beta contribution
|
||||
END_DOC
|
||||
fock_b_bab_3e_bi_orth_old = 0.d0
|
||||
integer :: i,a,j,k
|
||||
double precision :: direct_int, exch_13_int
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = 1, elec_beta_num
|
||||
do k = 1, elec_alpha_num
|
||||
! b a b b a b
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int) ! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)! < a k j | j k i > : E_13
|
||||
fock_b_bab_3e_bi_orth_old(a,i) += direct_int - exch_13_int
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_a_tmp2_bi_ortho, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: contrib_sss
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_a_tmp2_bi_ortho = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
do j = 1, elec_alpha_num
|
||||
do k = elec_beta_num+1, elec_alpha_num
|
||||
call contrib_3e_sss(a, i, j, k, contrib_sss)
|
||||
|
||||
fock_a_tmp2_bi_ortho(a,i) += 0.5d0 * contrib_sss
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
fock_b_bab_3e_bi_orth_old = - fock_b_bab_3e_bi_orth_old
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_b_bbb_3e_bi_orth_old, (mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! fock_b_bbb_3e_bi_orth_old(a,i) = bi-ortho 3-e Fock matrix for alpha electrons from alpha,alpha,alpha contribution
|
||||
END_DOC
|
||||
fock_b_bbb_3e_bi_orth_old = 0.d0
|
||||
integer :: i,a,j,k
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = 1, elec_beta_num
|
||||
do k = j+1, elec_beta_num
|
||||
! positive terms :: cycle contrib
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i >
|
||||
fock_b_bbb_3e_bi_orth_old(a,i) += direct_int + c_3_int + c_minus_3_int
|
||||
! negative terms :: exchange contrib
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12
|
||||
fock_b_bbb_3e_bi_orth_old(a,i) += - exch_13_int - exch_23_int - exch_12_int
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_b_tmp1_bi_ortho, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int
|
||||
double precision :: new
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_b_tmp1_bi_ortho = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
do j = 1, elec_beta_num
|
||||
do k = elec_beta_num+1, elec_alpha_num
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
|
||||
fock_b_tmp1_bi_ortho(a,i) += 1.5d0 * direct_int - 0.5d0 * exch_23_int - exch_13_int
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
enddo
|
||||
enddo
|
||||
fock_b_bbb_3e_bi_orth_old = - fock_b_bbb_3e_bi_orth_old
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_b_tot_3e_bi_orth_old, (mo_num, mo_num)]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! fock_b_tot_3e_bi_orth_old = bi-ortho 3-e Fock matrix for alpha electrons from all possible spin contributions
|
||||
END_DOC
|
||||
fock_b_tot_3e_bi_orth_old = fock_b_bbb_3e_bi_orth_old + fock_b_bab_3e_bi_orth_old + fock_b_baa_3e_bi_orth_old
|
||||
fock_b_tmp1_bi_ortho = - fock_b_tmp1_bi_ortho
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_b_tmp2_bi_ortho, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: contrib_soo
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_b_tmp2_bi_ortho = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
do j = elec_beta_num + 1, elec_alpha_num
|
||||
do k = 1, elec_alpha_num
|
||||
call contrib_3e_soo(a, i, j, k, contrib_soo)
|
||||
|
||||
fock_b_tmp2_bi_ortho(a,i) += 0.5d0 * contrib_soo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
subroutine contrib_3e_sss(a, i, j, k, integral)
|
||||
|
||||
BEGIN_DOC
|
||||
! returns the pure same spin contribution to F(a,i) from two orbitals j,k
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: a, i, j, k
|
||||
double precision, intent(out) :: integral
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i >
|
||||
integral = direct_int + c_3_int + c_minus_3_int
|
||||
|
||||
! negative terms :: exchange contrib
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12
|
||||
integral += - exch_13_int - exch_23_int - exch_12_int
|
||||
|
||||
integral = -integral
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine contrib_3e_soo(a,i,j,k,integral)
|
||||
|
||||
BEGIN_DOC
|
||||
! returns the same spin / opposite spin / opposite spin contribution to F(a,i) from two orbitals j,k
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: a, i, j, k
|
||||
double precision, intent(out) :: integral
|
||||
double precision :: direct_int, exch_23_int
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int) ! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)! < a k j | i j k > : E_23
|
||||
integral = direct_int - exch_23_int
|
||||
|
||||
integral = -integral
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine contrib_3e_sos(a, i, j, k, integral)
|
||||
|
||||
BEGIN_DOC
|
||||
! returns the same spin / opposite spin / same spin contribution to F(a,i) from two orbitals j,k
|
||||
END_DOC
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: a, i, j, k
|
||||
double precision, intent(out) :: integral
|
||||
double precision :: direct_int, exch_13_int
|
||||
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)! < a k j | j k i > : E_13
|
||||
integral = direct_int - exch_13_int
|
||||
|
||||
integral = -integral
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
|
@ -1,286 +0,0 @@
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_a_tot_3e_bi_orth, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_a_tot_3e_bi_orth = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
fock_a_tot_3e_bi_orth(a,i) += fock_cs_3e_bi_orth (a,i)
|
||||
fock_a_tot_3e_bi_orth(a,i) += fock_a_tmp1_bi_ortho(a,i)
|
||||
fock_a_tot_3e_bi_orth(a,i) += fock_a_tmp2_bi_ortho(a,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_b_tot_3e_bi_orth, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_b_tot_3e_bi_orth = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
fock_b_tot_3e_bi_orth(a,i) += fock_cs_3e_bi_orth (a,i)
|
||||
fock_b_tot_3e_bi_orth(a,i) += fock_b_tmp2_bi_ortho(a,i)
|
||||
fock_b_tot_3e_bi_orth(a,i) += fock_b_tmp1_bi_ortho(a,i)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_cs_3e_bi_orth, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: contrib_sss, contrib_sos, contrib_soo, contrib
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
|
||||
double precision :: new
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_cs_3e_bi_orth = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = 1, elec_beta_num
|
||||
do k = 1, elec_beta_num
|
||||
|
||||
!!call contrib_3e_sss(a,i,j,k,contrib_sss)
|
||||
!!call contrib_3e_soo(a,i,j,k,contrib_soo)
|
||||
!!call contrib_3e_sos(a,i,j,k,contrib_sos)
|
||||
!!contrib = 0.5d0 * (contrib_sss + contrib_soo) + contrib_sos
|
||||
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i >
|
||||
|
||||
! negative terms :: exchange contrib
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12
|
||||
|
||||
new = 2.d0 * direct_int + 0.5d0 * (c_3_int + c_minus_3_int - exch_12_int) -1.5d0 * exch_13_int - exch_23_int
|
||||
|
||||
fock_cs_3e_bi_orth(a,i) += new
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
fock_cs_3e_bi_orth = - fock_cs_3e_bi_orth
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_a_tmp1_bi_ortho, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: contrib_sss, contrib_sos, contrib_soo, contrib
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
|
||||
double precision :: new
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_a_tmp1_bi_ortho = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
|
||||
do j = elec_beta_num + 1, elec_alpha_num
|
||||
do k = 1, elec_beta_num
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12
|
||||
|
||||
fock_a_tmp1_bi_ortho(a,i) += 1.5d0 * (direct_int - exch_13_int) + 0.5d0 * (c_3_int + c_minus_3_int - exch_23_int - exch_12_int)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
fock_a_tmp1_bi_ortho = - fock_a_tmp1_bi_ortho
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_a_tmp2_bi_ortho, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: contrib_sss
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_a_tmp2_bi_ortho = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
do j = 1, elec_alpha_num
|
||||
do k = elec_beta_num+1, elec_alpha_num
|
||||
call contrib_3e_sss(a, i, j, k, contrib_sss)
|
||||
|
||||
fock_a_tmp2_bi_ortho(a,i) += 0.5d0 * contrib_sss
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_b_tmp1_bi_ortho, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int
|
||||
double precision :: new
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_b_tmp1_bi_ortho = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
do j = 1, elec_beta_num
|
||||
do k = elec_beta_num+1, elec_alpha_num
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
|
||||
fock_b_tmp1_bi_ortho(a,i) += 1.5d0 * direct_int - 0.5d0 * exch_23_int - exch_13_int
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
fock_b_tmp1_bi_ortho = - fock_b_tmp1_bi_ortho
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
BEGIN_PROVIDER [double precision, fock_b_tmp2_bi_ortho, (mo_num, mo_num)]
|
||||
|
||||
implicit none
|
||||
integer :: i, a, j, k
|
||||
double precision :: contrib_soo
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
fock_b_tmp2_bi_ortho = 0.d0
|
||||
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
do j = elec_beta_num + 1, elec_alpha_num
|
||||
do k = 1, elec_alpha_num
|
||||
call contrib_3e_soo(a, i, j, k, contrib_soo)
|
||||
|
||||
fock_b_tmp2_bi_ortho(a,i) += 0.5d0 * contrib_soo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
! ---
|
||||
|
||||
subroutine contrib_3e_sss(a, i, j, k, integral)
|
||||
|
||||
BEGIN_DOC
|
||||
! returns the pure same spin contribution to F(a,i) from two orbitals j,k
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: a, i, j, k
|
||||
double precision, intent(out) :: integral
|
||||
double precision :: direct_int, exch_13_int, exch_23_int, exch_12_int, c_3_int, c_minus_3_int
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )!!! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, i, k, c_3_int) ! < a k j | j i k >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, j, i, c_minus_3_int)! < a k j | k j i >
|
||||
integral = direct_int + c_3_int + c_minus_3_int
|
||||
|
||||
! negative terms :: exchange contrib
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)!!! < a k j | j k i > : E_13
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)!!! < a k j | i j k > : E_23
|
||||
call give_integrals_3_body_bi_ort(a, k, j, k, i, j, exch_12_int)!!! < a k j | k i j > : E_12
|
||||
integral += - exch_13_int - exch_23_int - exch_12_int
|
||||
|
||||
integral = -integral
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine contrib_3e_soo(a,i,j,k,integral)
|
||||
|
||||
BEGIN_DOC
|
||||
! returns the same spin / opposite spin / opposite spin contribution to F(a,i) from two orbitals j,k
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: a, i, j, k
|
||||
double precision, intent(out) :: integral
|
||||
double precision :: direct_int, exch_23_int
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int) ! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, j, k, exch_23_int)! < a k j | i j k > : E_23
|
||||
integral = direct_int - exch_23_int
|
||||
|
||||
integral = -integral
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
||||
subroutine contrib_3e_sos(a, i, j, k, integral)
|
||||
|
||||
BEGIN_DOC
|
||||
! returns the same spin / opposite spin / same spin contribution to F(a,i) from two orbitals j,k
|
||||
END_DOC
|
||||
|
||||
PROVIDE mo_l_coef mo_r_coef
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: a, i, j, k
|
||||
double precision, intent(out) :: integral
|
||||
double precision :: direct_int, exch_13_int
|
||||
|
||||
call give_integrals_3_body_bi_ort(a, k, j, i, k, j, direct_int )! < a k j | i k j >
|
||||
call give_integrals_3_body_bi_ort(a, k, j, j, k, i, exch_13_int)! < a k j | j k i > : E_13
|
||||
integral = direct_int - exch_13_int
|
||||
|
||||
integral = -integral
|
||||
|
||||
end
|
||||
|
||||
! ---
|
||||
|
@ -227,3 +227,144 @@ BEGIN_PROVIDER [ double precision, fock_3_mat_b_op_sh, (mo_num, mo_num)]
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_kk_sum, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
integer :: mm, ipoint,k
|
||||
double precision :: w_kk
|
||||
fock_3_w_kk_sum = 0.d0
|
||||
do k = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
w_kk = x_W_ij_erf_rk(ipoint,mm,k,k)
|
||||
fock_3_w_kk_sum(ipoint,mm) += w_kk
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_ki_mos_k, (n_points_final_grid,3,mo_num)]
|
||||
implicit none
|
||||
integer :: mm, ipoint,k,i
|
||||
double precision :: w_ki, mo_k
|
||||
fock_3_w_ki_mos_k = 0.d0
|
||||
do i = 1, mo_num
|
||||
do k = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
w_ki = x_W_ij_erf_rk(ipoint,mm,k,i)
|
||||
mo_k = mos_in_r_array(k,ipoint)
|
||||
fock_3_w_ki_mos_k(ipoint,mm,i) += w_ki * mo_k
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_kl_w_kl, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
integer :: k,j,ipoint,mm
|
||||
double precision :: w_kj
|
||||
fock_3_w_kl_w_kl = 0.d0
|
||||
do j = 1, elec_beta_num
|
||||
do k = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
w_kj = x_W_ij_erf_rk(ipoint,mm,k,j)
|
||||
fock_3_w_kl_w_kl(ipoint,mm) += w_kj * w_kj
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_rho_beta, (n_points_final_grid)]
|
||||
implicit none
|
||||
integer :: ipoint,k
|
||||
fock_3_rho_beta = 0.d0
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do k = 1, elec_beta_num
|
||||
fock_3_rho_beta(ipoint) += mos_in_r_array(k,ipoint) * mos_in_r_array(k,ipoint)
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_kl_mo_k_mo_l, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
integer :: ipoint,k,l,mm
|
||||
double precision :: mos_k, mos_l, w_kl
|
||||
fock_3_w_kl_mo_k_mo_l = 0.d0
|
||||
do k = 1, elec_beta_num
|
||||
do l = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
mos_k = mos_in_r_array_transp(ipoint,k)
|
||||
mos_l = mos_in_r_array_transp(ipoint,l)
|
||||
w_kl = x_W_ij_erf_rk(ipoint,mm,l,k)
|
||||
fock_3_w_kl_mo_k_mo_l(ipoint,mm) += w_kl * mos_k * mos_l
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_ki_wk_a, (n_points_final_grid,3,mo_num, mo_num)]
|
||||
implicit none
|
||||
integer :: ipoint,i,a,k,mm
|
||||
double precision :: w_ki,w_ka
|
||||
fock_3_w_ki_wk_a = 0.d0
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do k = 1, elec_beta_num
|
||||
w_ki = x_W_ij_erf_rk(ipoint,mm,k,i)
|
||||
w_ka = x_W_ij_erf_rk(ipoint,mm,k,a)
|
||||
fock_3_w_ki_wk_a(ipoint,mm,a,i) += w_ki * w_ka
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_trace_w_tilde, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
integer :: ipoint,k,mm
|
||||
fock_3_trace_w_tilde = 0.d0
|
||||
do k = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
fock_3_trace_w_tilde(ipoint,mm) += fock_3_w_ki_wk_a(ipoint,mm,k,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_kl_wla_phi_k, (n_points_final_grid,3,mo_num)]
|
||||
implicit none
|
||||
integer :: ipoint,a,k,mm,l
|
||||
double precision :: w_kl,w_la, mo_k
|
||||
fock_3_w_kl_wla_phi_k = 0.d0
|
||||
do a = 1, mo_num
|
||||
do k = 1, elec_beta_num
|
||||
do l = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
w_kl = x_W_ij_erf_rk(ipoint,mm,l,k)
|
||||
w_la = x_W_ij_erf_rk(ipoint,mm,l,a)
|
||||
mo_k = mos_in_r_array_transp(ipoint,k)
|
||||
fock_3_w_kl_wla_phi_k(ipoint,mm,a) += w_kl * w_la * mo_k
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
@ -1,140 +0,0 @@
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_kk_sum, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
integer :: mm, ipoint,k
|
||||
double precision :: w_kk
|
||||
fock_3_w_kk_sum = 0.d0
|
||||
do k = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
w_kk = x_W_ij_erf_rk(ipoint,mm,k,k)
|
||||
fock_3_w_kk_sum(ipoint,mm) += w_kk
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_ki_mos_k, (n_points_final_grid,3,mo_num)]
|
||||
implicit none
|
||||
integer :: mm, ipoint,k,i
|
||||
double precision :: w_ki, mo_k
|
||||
fock_3_w_ki_mos_k = 0.d0
|
||||
do i = 1, mo_num
|
||||
do k = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
w_ki = x_W_ij_erf_rk(ipoint,mm,k,i)
|
||||
mo_k = mos_in_r_array(k,ipoint)
|
||||
fock_3_w_ki_mos_k(ipoint,mm,i) += w_ki * mo_k
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_kl_w_kl, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
integer :: k,j,ipoint,mm
|
||||
double precision :: w_kj
|
||||
fock_3_w_kl_w_kl = 0.d0
|
||||
do j = 1, elec_beta_num
|
||||
do k = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
w_kj = x_W_ij_erf_rk(ipoint,mm,k,j)
|
||||
fock_3_w_kl_w_kl(ipoint,mm) += w_kj * w_kj
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_rho_beta, (n_points_final_grid)]
|
||||
implicit none
|
||||
integer :: ipoint,k
|
||||
fock_3_rho_beta = 0.d0
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do k = 1, elec_beta_num
|
||||
fock_3_rho_beta(ipoint) += mos_in_r_array(k,ipoint) * mos_in_r_array(k,ipoint)
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_kl_mo_k_mo_l, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
integer :: ipoint,k,l,mm
|
||||
double precision :: mos_k, mos_l, w_kl
|
||||
fock_3_w_kl_mo_k_mo_l = 0.d0
|
||||
do k = 1, elec_beta_num
|
||||
do l = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
mos_k = mos_in_r_array_transp(ipoint,k)
|
||||
mos_l = mos_in_r_array_transp(ipoint,l)
|
||||
w_kl = x_W_ij_erf_rk(ipoint,mm,l,k)
|
||||
fock_3_w_kl_mo_k_mo_l(ipoint,mm) += w_kl * mos_k * mos_l
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_ki_wk_a, (n_points_final_grid,3,mo_num, mo_num)]
|
||||
implicit none
|
||||
integer :: ipoint,i,a,k,mm
|
||||
double precision :: w_ki,w_ka
|
||||
fock_3_w_ki_wk_a = 0.d0
|
||||
do i = 1, mo_num
|
||||
do a = 1, mo_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
do k = 1, elec_beta_num
|
||||
w_ki = x_W_ij_erf_rk(ipoint,mm,k,i)
|
||||
w_ka = x_W_ij_erf_rk(ipoint,mm,k,a)
|
||||
fock_3_w_ki_wk_a(ipoint,mm,a,i) += w_ki * w_ka
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_trace_w_tilde, (n_points_final_grid,3)]
|
||||
implicit none
|
||||
integer :: ipoint,k,mm
|
||||
fock_3_trace_w_tilde = 0.d0
|
||||
do k = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
fock_3_trace_w_tilde(ipoint,mm) += fock_3_w_ki_wk_a(ipoint,mm,k,k)
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, fock_3_w_kl_wla_phi_k, (n_points_final_grid,3,mo_num)]
|
||||
implicit none
|
||||
integer :: ipoint,a,k,mm,l
|
||||
double precision :: w_kl,w_la, mo_k
|
||||
fock_3_w_kl_wla_phi_k = 0.d0
|
||||
do a = 1, mo_num
|
||||
do k = 1, elec_beta_num
|
||||
do l = 1, elec_beta_num
|
||||
do mm = 1, 3
|
||||
do ipoint = 1, n_points_final_grid
|
||||
w_kl = x_W_ij_erf_rk(ipoint,mm,l,k)
|
||||
w_la = x_W_ij_erf_rk(ipoint,mm,l,a)
|
||||
mo_k = mos_in_r_array_transp(ipoint,k)
|
||||
fock_3_w_kl_wla_phi_k(ipoint,mm,a) += w_kl * w_la * mo_k
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
enddo
|
||||
END_PROVIDER
|
||||
|
@ -1,10 +1,11 @@
|
||||
program print_angles
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! program that minimizes the angle between left- and right-orbitals when degeneracies are found in the TC-Fock matrix
|
||||
END_DOC
|
||||
my_grid_becke = .True.
|
||||
my_n_pt_r_grid = 30
|
||||
my_n_pt_a_grid = 50
|
||||
! my_n_pt_r_grid = 10 ! small grid for quick debug
|
||||
! my_n_pt_a_grid = 14 ! small grid for quick debug
|
||||
touch my_n_pt_r_grid my_n_pt_a_grid
|
||||
! call sort_by_tc_fock
|
||||
call minimize_tc_orb_angles
|
||||
|
@ -1,9 +0,0 @@
|
||||
program print_angles
|
||||
implicit none
|
||||
my_grid_becke = .True.
|
||||
! my_n_pt_r_grid = 30
|
||||
! my_n_pt_a_grid = 50
|
||||
my_n_pt_r_grid = 10 ! small grid for quick debug
|
||||
my_n_pt_a_grid = 14 ! small grid for quick debug
|
||||
call print_angles_tc
|
||||
end
|
@ -4,7 +4,7 @@
|
||||
program rotate_tcscf_orbitals
|
||||
|
||||
BEGIN_DOC
|
||||
! TODO : Put the documentation of the program here
|
||||
! TODO : Rotate the bi-orthonormal orbitals in order to minimize left-right angles when degenerate
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
|
@ -1,7 +1,54 @@
|
||||
|
||||
|
||||
! ---
|
||||
|
||||
subroutine LTxSxR(n, m, L, S, R, C)
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: n, m
|
||||
double precision, intent(in) :: L(n,m), S(n,n), R(n,m)
|
||||
double precision, intent(out) :: C(m,m)
|
||||
integer :: i, j
|
||||
double precision :: accu_d, accu_nd
|
||||
double precision, allocatable :: tmp(:,:)
|
||||
|
||||
! L.T x S x R
|
||||
allocate(tmp(m,n))
|
||||
call dgemm( 'T', 'N', m, n, n, 1.d0 &
|
||||
, L, size(L, 1), S, size(S, 1) &
|
||||
, 0.d0, tmp, size(tmp, 1) )
|
||||
call dgemm( 'N', 'N', m, m, n, 1.d0 &
|
||||
, tmp, size(tmp, 1), R, size(R, 1) &
|
||||
, 0.d0, C, size(C, 1) )
|
||||
deallocate(tmp)
|
||||
|
||||
accu_d = 0.d0
|
||||
accu_nd = 0.d0
|
||||
do i = 1, m
|
||||
do j = 1, m
|
||||
if(j.eq.i) then
|
||||
accu_d += dabs(C(j,i))
|
||||
else
|
||||
accu_nd += C(j,i) * C(j,i)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
accu_nd = dsqrt(accu_nd)
|
||||
|
||||
print*, ' accu_d = ', accu_d
|
||||
print*, ' accu_nd = ', accu_nd
|
||||
|
||||
end subroutine LTxR
|
||||
|
||||
! ---
|
||||
|
||||
|
||||
! ---
|
||||
|
||||
subroutine minimize_tc_orb_angles()
|
||||
BEGIN_DOC
|
||||
! routine that minimizes the angle between left- and right-orbitals when degeneracies are found
|
||||
END_DOC
|
||||
|
||||
implicit none
|
||||
logical :: good_angles
|
||||
|
@ -2,6 +2,9 @@
|
||||
|
||||
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_beta, (ao_num, ao_num) ]
|
||||
|
||||
BEGIN_DOC
|
||||
! TC-SCF transition density matrix on the AO basis for BETA electrons
|
||||
END_DOC
|
||||
implicit none
|
||||
|
||||
if(bi_ortho) then
|
||||
@ -16,6 +19,9 @@ END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_alpha, (ao_num, ao_num) ]
|
||||
|
||||
BEGIN_DOC
|
||||
! TC-SCF transition density matrix on the AO basis for ALPHA electrons
|
||||
END_DOC
|
||||
implicit none
|
||||
|
||||
if(bi_ortho) then
|
||||
@ -31,6 +37,9 @@ END_PROVIDER
|
||||
|
||||
BEGIN_PROVIDER [ double precision, TCSCF_density_matrix_ao_tot, (ao_num, ao_num) ]
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! TC-SCF transition density matrix on the AO basis for ALPHA+BETA electrons
|
||||
END_DOC
|
||||
TCSCF_density_matrix_ao_tot = TCSCF_density_matrix_ao_beta + TCSCF_density_matrix_ao_alpha
|
||||
END_PROVIDER
|
||||
|
||||
|
@ -1,43 +0,0 @@
|
||||
|
||||
! ---
|
||||
|
||||
subroutine LTxSxR(n, m, L, S, R, C)
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: n, m
|
||||
double precision, intent(in) :: L(n,m), S(n,n), R(n,m)
|
||||
double precision, intent(out) :: C(m,m)
|
||||
integer :: i, j
|
||||
double precision :: accu_d, accu_nd
|
||||
double precision, allocatable :: tmp(:,:)
|
||||
|
||||
! L.T x S x R
|
||||
allocate(tmp(m,n))
|
||||
call dgemm( 'T', 'N', m, n, n, 1.d0 &
|
||||
, L, size(L, 1), S, size(S, 1) &
|
||||
, 0.d0, tmp, size(tmp, 1) )
|
||||
call dgemm( 'N', 'N', m, m, n, 1.d0 &
|
||||
, tmp, size(tmp, 1), R, size(R, 1) &
|
||||
, 0.d0, C, size(C, 1) )
|
||||
deallocate(tmp)
|
||||
|
||||
accu_d = 0.d0
|
||||
accu_nd = 0.d0
|
||||
do i = 1, m
|
||||
do j = 1, m
|
||||
if(j.eq.i) then
|
||||
accu_d += dabs(C(j,i))
|
||||
else
|
||||
accu_nd += C(j,i) * C(j,i)
|
||||
endif
|
||||
enddo
|
||||
enddo
|
||||
accu_nd = dsqrt(accu_nd)
|
||||
|
||||
print*, ' accu_d = ', accu_d
|
||||
print*, ' accu_nd = ', accu_nd
|
||||
|
||||
end subroutine LTxR
|
||||
|
||||
! ---
|
||||
|
@ -1,13 +0,0 @@
|
||||
QP_ROOT=/home/eginer/new_qp2/qp2
|
||||
source ${QP_ROOT}/quantum_package.rc
|
||||
echo Ne > Ne.xyz
|
||||
echo $QP_ROOT
|
||||
qp create_ezfio -b cc-pcvdz Ne.xyz -o Ne_tc_scf
|
||||
qp run scf
|
||||
qp set tc_keywords bi_ortho True
|
||||
qp set ao_two_e_erf_ints mu_erf 0.87
|
||||
qp set tc_keywords j1b_pen [1.5]
|
||||
qp set tc_keywords j1b_type 3
|
||||
qp run tc_scf | tee ${EZFIO_FILE}.tc_scf.out
|
||||
grep "TC energy =" Ne.ezfio.tc_scf.out | tail -1
|
||||
eref=-128.552134
|
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user