mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-10-09 01:17:19 +02:00
Mono -> Single
This commit is contained in:
parent
37fe028626
commit
60255980e9
14
REPLACE
14
REPLACE
@ -183,3 +183,17 @@ qp_name save_one_body_dm -r save_one_e_dm
|
||||
qp_name ezfio_set_aux_quantities_data_one_e_alpha_dm_mo -r ezfio_set_aux_quantities_data_one_e_dm_alpha_mo
|
||||
qp_name ezfio_set_aux_quantities_data_one_e_beta_dm_mo -r ezfio_set_aux_quantities_data_one_e_dm_beta_mo
|
||||
qp_name two_electron_energy -r two_e_energy
|
||||
qp_name do_mono_excitation -r do_single_excitation
|
||||
qp_name get_mono_excitation -r get_single_excitation
|
||||
qp_name get_mono_excitation_from_fock -r get_single_excitation_from_fock
|
||||
qp_name is_connected_to_by_mono -r is_connected_to_by_single
|
||||
qp_name connected_to_ref_by_mono -r connected_to_ref_by_single
|
||||
qp_name mono_excitation_wee -r single_excitation_wee
|
||||
qp_name get_mono_excitation_spin
|
||||
qp_name get_mono_excitation_spin -r get_single_excitation_spin
|
||||
qp_name get_excitation_degree_vector_mono -r get_excitation_degree_vector_single
|
||||
qp_name get_excitation_degree_vector_mono_or_exchange -r get_excitation_degree_vector_single_or_exchange_or_exchange
|
||||
qp_name get_excitation_degree_vector_single_or_exchange_or_exchange -r get_excitation_degree_vector_single_or_exchange
|
||||
qp_name get_excitation_degree_vector_mono_or_exchange_verbose -r get_excitation_degree_vector_single_or_exchange_verbose
|
||||
qp_name i_h_j_mono_spin -r i_h_j_single_spin
|
||||
qp_name i_Wee_j_mono -r i_Wee_j_single
|
||||
|
@ -483,7 +483,7 @@ compute_singles=.True.
|
||||
ASSERT (lrow <= N_det_alpha_unique)
|
||||
|
||||
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
|
||||
call i_H_j_mono_spin( tmp_det, tmp_det2, $N_int, 1, hij)
|
||||
call i_h_j_single_spin( tmp_det, tmp_det2, $N_int, 1, hij)
|
||||
|
||||
!DIR$ LOOP COUNT AVG(4)
|
||||
do l=1,N_st
|
||||
@ -568,7 +568,7 @@ compute_singles=.True.
|
||||
ASSERT (lcol <= N_det_beta_unique)
|
||||
|
||||
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol)
|
||||
call i_H_j_mono_spin( tmp_det, tmp_det2, $N_int, 2, hij)
|
||||
call i_h_j_single_spin( tmp_det, tmp_det2, $N_int, 2, hij)
|
||||
l_a = psi_bilinear_matrix_transp_order(l_b)
|
||||
ASSERT (l_a <= N_det)
|
||||
!DIR$ LOOP COUNT AVG(4)
|
||||
|
@ -304,7 +304,7 @@ subroutine H_S2_u_0_two_e_nstates_openmp_work_$N_int(v_t,s_t,u_t,N_st,sze,istart
|
||||
ASSERT (lrow <= N_det_alpha_unique)
|
||||
|
||||
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow)
|
||||
call i_Wee_j_mono( tmp_det, tmp_det2, $N_int, 1, hij)
|
||||
call i_Wee_j_single( tmp_det, tmp_det2, $N_int, 1, hij)
|
||||
|
||||
do l=1,N_st
|
||||
v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,l_a)
|
||||
@ -384,7 +384,7 @@ subroutine H_S2_u_0_two_e_nstates_openmp_work_$N_int(v_t,s_t,u_t,N_st,sze,istart
|
||||
ASSERT (lcol <= N_det_beta_unique)
|
||||
|
||||
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol)
|
||||
call i_Wee_j_mono( tmp_det, tmp_det2, $N_int, 2, hij)
|
||||
call i_Wee_j_single( tmp_det, tmp_det2, $N_int, 2, hij)
|
||||
l_a = psi_bilinear_matrix_transp_order(l_b)
|
||||
ASSERT (l_a <= N_det)
|
||||
do l=1,N_st
|
||||
|
@ -185,7 +185,7 @@ end
|
||||
|
||||
|
||||
|
||||
logical function is_connected_to_by_mono(key,keys,Nint,Ndet)
|
||||
logical function is_connected_to_by_single(key,keys,Nint,Ndet)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -202,7 +202,7 @@ logical function is_connected_to_by_mono(key,keys,Nint,Ndet)
|
||||
ASSERT (Nint > 0)
|
||||
ASSERT (Nint == N_int)
|
||||
|
||||
is_connected_to_by_mono = .false.
|
||||
is_connected_to_by_single = .false.
|
||||
|
||||
do i=1,Ndet
|
||||
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
|
||||
@ -214,7 +214,7 @@ logical function is_connected_to_by_mono(key,keys,Nint,Ndet)
|
||||
if (degree_x2 > 2) then
|
||||
cycle
|
||||
else
|
||||
is_connected_to_by_mono = .true.
|
||||
is_connected_to_by_single = .true.
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
@ -333,7 +333,7 @@ end
|
||||
|
||||
|
||||
|
||||
integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet)
|
||||
integer function connected_to_ref_by_single(key,keys,Nint,N_past_in,Ndet)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -368,7 +368,7 @@ integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet)
|
||||
ASSERT (Nint > 0)
|
||||
ASSERT (Nint == N_int)
|
||||
|
||||
connected_to_ref_by_mono = 0
|
||||
connected_to_ref_by_single = 0
|
||||
N_past = max(1,N_past_in)
|
||||
if (Nint == 1) then
|
||||
|
||||
@ -380,7 +380,7 @@ integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet)
|
||||
else if (degree_x2 == 4)then
|
||||
cycle
|
||||
else if(degree_x2 == 2)then
|
||||
connected_to_ref_by_mono = i
|
||||
connected_to_ref_by_single = i
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
@ -400,7 +400,7 @@ integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet)
|
||||
else if (degree_x2 == 4)then
|
||||
cycle
|
||||
else if(degree_x2 == 2)then
|
||||
connected_to_ref_by_mono = i
|
||||
connected_to_ref_by_single = i
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
@ -421,7 +421,7 @@ integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet)
|
||||
else if (degree_x2 == 4)then
|
||||
cycle
|
||||
else if(degree_x2 == 2)then
|
||||
connected_to_ref_by_mono = i
|
||||
connected_to_ref_by_single = i
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
@ -442,7 +442,7 @@ integer function connected_to_ref_by_mono(key,keys,Nint,N_past_in,Ndet)
|
||||
else if (degree_x2 == 4)then
|
||||
cycle
|
||||
else if(degree_x2 == 2)then
|
||||
connected_to_ref_by_mono = i
|
||||
connected_to_ref_by_single = i
|
||||
return
|
||||
endif
|
||||
enddo
|
||||
|
@ -1,4 +1,4 @@
|
||||
subroutine do_mono_excitation(key_in,i_hole,i_particle,ispin,i_ok)
|
||||
subroutine do_single_excitation(key_in,i_hole,i_particle,ispin,i_ok)
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
! Apply the single excitation operator : a^{dager}_(i_particle) a_(i_hole) of spin = ispin
|
||||
|
@ -150,7 +150,7 @@ END_PROVIDER
|
||||
call get_excitation_degree_spin(tmp_det(1,1),tmp_det2,degree,N_int)
|
||||
if (degree == 1) then
|
||||
exc = 0
|
||||
call get_mono_excitation_spin(tmp_det(1,1),tmp_det2,exc,phase,N_int)
|
||||
call get_single_excitation_spin(tmp_det(1,1),tmp_det2,exc,phase,N_int)
|
||||
call decode_exc_spin(exc,h1,p1,h2,p2)
|
||||
do m=1,N_states
|
||||
ckl = psi_bilinear_matrix_values(k_a,m)*psi_bilinear_matrix_values(l,m) * phase
|
||||
@ -206,7 +206,7 @@ END_PROVIDER
|
||||
call get_excitation_degree_spin(tmp_det(1,2),tmp_det2,degree,N_int)
|
||||
if (degree == 1) then
|
||||
exc = 0
|
||||
call get_mono_excitation_spin(tmp_det(1,2),tmp_det2,exc,phase,N_int)
|
||||
call get_single_excitation_spin(tmp_det(1,2),tmp_det2,exc,phase,N_int)
|
||||
call decode_exc_spin(exc,h1,p1,h2,p2)
|
||||
do m=1,N_states
|
||||
ckl = psi_bilinear_matrix_transp_values(k_b,m)*psi_bilinear_matrix_transp_values(l,m) * phase
|
||||
|
@ -29,7 +29,7 @@ subroutine example_determinants
|
||||
print*,'h1 --> p1 of spin s1'
|
||||
print*,'i_ok == +1 : excitation is possible '
|
||||
print*,'i_ok == -1 : excitation is NOT possible '
|
||||
call do_mono_excitation(det_i,h1,p1,s1,i_ok)
|
||||
call do_single_excitation(det_i,h1,p1,s1,i_ok)
|
||||
print*,'h1,p1,s1,i_ok'
|
||||
print*, h1,p1,s1,i_ok
|
||||
if(i_ok == -1)then
|
||||
@ -54,7 +54,7 @@ subroutine example_determinants
|
||||
h1 = elec_alpha_num
|
||||
p1 = elec_alpha_num + 1
|
||||
s1 = 2
|
||||
call do_mono_excitation(det_i,h1,p1,s1,i_ok)
|
||||
call do_single_excitation(det_i,h1,p1,s1,i_ok)
|
||||
print*,'h1,p1,s1,i_ok'
|
||||
print*, h1,p1,s1,i_ok
|
||||
call i_H_j(det_i,det_i,N_int,h0i)
|
||||
|
@ -236,7 +236,7 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
||||
call bitstring_to_list_ab(particle_tmp,occ_particle_tmp,N_elec_in_key_part_2,N_int)
|
||||
call bitstring_to_list_ab(hole_tmp,occ_hole_tmp,N_elec_in_key_hole_2,N_int)
|
||||
|
||||
! hole = a^(+)_j_a(ispin) a_i_a(ispin)|key_in> : mono exc :: orb(i_a,ispin) --> orb(j_a,ispin)
|
||||
! hole = a^(+)_j_a(ispin) a_i_a(ispin)|key_in> : single exc :: orb(i_a,ispin) --> orb(j_a,ispin)
|
||||
hole_save = hole
|
||||
|
||||
! Build array of the non-zero integrals of second excitation
|
||||
@ -297,7 +297,7 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
||||
enddo
|
||||
endif
|
||||
|
||||
! does all the mono excitations of the same spin
|
||||
! does all the single excitations of the same spin
|
||||
i=0
|
||||
do kk = 1,N_elec_in_key_hole_2(ispin)
|
||||
i_b = occ_hole_tmp(kk,ispin)
|
||||
|
@ -1,5 +1,5 @@
|
||||
use bitmasks
|
||||
subroutine mono_excitation_wee(det_1,det_2,h,p,spin,phase,hij)
|
||||
subroutine single_excitation_wee(det_1,det_2,h,p,spin,phase,hij)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer,intent(in) :: h,p,spin
|
||||
@ -79,7 +79,7 @@ BEGIN_PROVIDER [double precision, fock_wee_closed_shell, (mo_num, mo_num) ]
|
||||
enddo
|
||||
double precision :: array_coulomb(mo_num),array_exchange(mo_num)
|
||||
call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int)
|
||||
! docc ---> virt mono excitations
|
||||
! docc ---> virt single excitations
|
||||
do i0 = 1, n_occ_ab(1)
|
||||
i=occ(i0,1)
|
||||
do j0 = 1, n_occ_ab_virt(1)
|
||||
@ -97,7 +97,7 @@ BEGIN_PROVIDER [double precision, fock_wee_closed_shell, (mo_num, mo_num) ]
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! virt ---> virt mono excitations
|
||||
! virt ---> virt single excitations
|
||||
do i0 = 1, n_occ_ab_virt(1)
|
||||
i=occ_virt(i0,1)
|
||||
do j0 = 1, n_occ_ab_virt(1)
|
||||
@ -114,7 +114,7 @@ BEGIN_PROVIDER [double precision, fock_wee_closed_shell, (mo_num, mo_num) ]
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! docc ---> docc mono excitations
|
||||
! docc ---> docc single excitations
|
||||
do i0 = 1, n_occ_ab(1)
|
||||
i=occ(i0,1)
|
||||
do j0 = 1, n_occ_ab(1)
|
@ -39,7 +39,7 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu
|
||||
double precision, allocatable :: array_coulomb(:),array_exchange(:)
|
||||
allocate (array_coulomb(mo_num),array_exchange(mo_num))
|
||||
call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int)
|
||||
! docc ---> virt mono excitations
|
||||
! docc ---> virt single excitations
|
||||
do i0 = 1, n_occ_ab(1)
|
||||
i=occ(i0,1)
|
||||
do j0 = 1, n_occ_ab_virt(1)
|
||||
@ -57,7 +57,7 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! virt ---> virt mono excitations
|
||||
! virt ---> virt single excitations
|
||||
do i0 = 1, n_occ_ab_virt(1)
|
||||
i=occ_virt(i0,1)
|
||||
do j0 = 1, n_occ_ab_virt(1)
|
||||
@ -74,7 +74,7 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu
|
||||
enddo
|
||||
enddo
|
||||
|
||||
! docc ---> docc mono excitations
|
||||
! docc ---> docc single excitations
|
||||
do i0 = 1, n_occ_ab(1)
|
||||
i=occ(i0,1)
|
||||
do j0 = 1, n_occ_ab(1)
|
||||
@ -94,7 +94,7 @@ BEGIN_PROVIDER [double precision, fock_operator_closed_shell_ref_bitmask, (mo_nu
|
||||
|
||||
END_PROVIDER
|
||||
|
||||
subroutine get_mono_excitation_from_fock(det_1,det_2,h,p,spin,phase,hij)
|
||||
subroutine get_single_excitation_from_fock(det_1,det_2,h,p,spin,phase,hij)
|
||||
use bitmasks
|
||||
implicit none
|
||||
integer,intent(in) :: h,p,spin
|
||||
|
@ -93,7 +93,7 @@ subroutine get_excitation(det1,det2,exc,degree,phase,Nint)
|
||||
return
|
||||
|
||||
case (1)
|
||||
call get_mono_excitation(det1,det2,exc,phase,Nint)
|
||||
call get_single_excitation(det1,det2,exc,phase,Nint)
|
||||
return
|
||||
|
||||
case(0)
|
||||
@ -336,7 +336,7 @@ end
|
||||
|
||||
|
||||
|
||||
subroutine get_mono_excitation(det1,det2,exc,phase,Nint)
|
||||
subroutine get_single_excitation(det1,det2,exc,phase,Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -499,7 +499,7 @@ subroutine i_H_j_s2(key_i,key_j,Nint,hij,s2)
|
||||
select case (degree)
|
||||
case (2)
|
||||
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||
! Mono alpha, mono beta
|
||||
! Single alpha, single beta
|
||||
if (exc(0,1,1) == 1) then
|
||||
if ( (exc(1,1,1) == exc(1,2,2)).and.(exc(1,1,2) == exc(1,2,1)) ) then
|
||||
s2 = -phase
|
||||
@ -541,21 +541,21 @@ subroutine i_H_j_s2(key_i,key_j,Nint,hij,s2)
|
||||
exc(1,2,2) ,mo_integrals_map) )
|
||||
endif
|
||||
case (1)
|
||||
call get_mono_excitation(key_i,key_j,exc,phase,Nint)
|
||||
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||
! Mono alpha
|
||||
! Single alpha
|
||||
if (exc(0,1,1) == 1) then
|
||||
m = exc(1,1,1)
|
||||
p = exc(1,2,1)
|
||||
spin = 1
|
||||
! Mono beta
|
||||
! Single beta
|
||||
else
|
||||
m = exc(1,1,2)
|
||||
p = exc(1,2,2)
|
||||
spin = 2
|
||||
endif
|
||||
call get_mono_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij)
|
||||
call get_single_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij)
|
||||
|
||||
case (0)
|
||||
double precision, external :: diag_S_mat_elem
|
||||
@ -602,7 +602,7 @@ subroutine i_H_j(key_i,key_j,Nint,hij)
|
||||
case (2)
|
||||
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha, mono beta
|
||||
! Single alpha, single beta
|
||||
if(exc(1,1,1) == exc(1,2,2) )then
|
||||
hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1))
|
||||
else if (exc(1,2,1) ==exc(1,1,2))then
|
||||
@ -640,21 +640,21 @@ subroutine i_H_j(key_i,key_j,Nint,hij)
|
||||
exc(1,2,2) ,mo_integrals_map) )
|
||||
endif
|
||||
case (1)
|
||||
call get_mono_excitation(key_i,key_j,exc,phase,Nint)
|
||||
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha
|
||||
! Single alpha
|
||||
m = exc(1,1,1)
|
||||
p = exc(1,2,1)
|
||||
spin = 1
|
||||
else
|
||||
! Mono beta
|
||||
! Single beta
|
||||
m = exc(1,1,2)
|
||||
p = exc(1,2,2)
|
||||
spin = 2
|
||||
endif
|
||||
call get_mono_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij)
|
||||
call get_single_excitation_from_fock(key_i,key_j,p,m,spin,phase,hij)
|
||||
|
||||
case (0)
|
||||
hij = diag_H_mat_elem(key_i,Nint)
|
||||
@ -703,7 +703,7 @@ subroutine i_H_j_verbose(key_i,key_j,Nint,hij,hmono,hdouble,phase)
|
||||
case (2)
|
||||
call get_double_excitation(key_i,key_j,exc,phase,Nint)
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha, mono beta
|
||||
! Single alpha, single beta
|
||||
hij = phase*get_two_e_integral( &
|
||||
exc(1,1,1), &
|
||||
exc(1,1,2), &
|
||||
@ -736,12 +736,12 @@ subroutine i_H_j_verbose(key_i,key_j,Nint,hij,hmono,hdouble,phase)
|
||||
exc(1,2,2) ,mo_integrals_map) )
|
||||
endif
|
||||
case (1)
|
||||
call get_mono_excitation(key_i,key_j,exc,phase,Nint)
|
||||
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||
has_mipi = .False.
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha
|
||||
! Single alpha
|
||||
m = exc(1,1,1)
|
||||
p = exc(1,2,1)
|
||||
do k = 1, elec_alpha_num
|
||||
@ -768,7 +768,7 @@ subroutine i_H_j_verbose(key_i,key_j,Nint,hij,hmono,hdouble,phase)
|
||||
enddo
|
||||
|
||||
else
|
||||
! Mono beta
|
||||
! Single beta
|
||||
m = exc(1,1,2)
|
||||
p = exc(1,2,2)
|
||||
do k = 1, elec_beta_num
|
||||
@ -1060,7 +1060,7 @@ end
|
||||
|
||||
|
||||
|
||||
subroutine get_excitation_degree_vector_mono(key1,key2,degree,Nint,sze,idx)
|
||||
subroutine get_excitation_degree_vector_single(key1,key2,degree,Nint,sze,idx)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -1154,7 +1154,7 @@ subroutine get_excitation_degree_vector_mono(key1,key2,degree,Nint,sze,idx)
|
||||
end
|
||||
|
||||
|
||||
subroutine get_excitation_degree_vector_mono_or_exchange(key1,key2,degree,Nint,sze,idx)
|
||||
subroutine get_excitation_degree_vector_single_or_exchange(key1,key2,degree,Nint,sze,idx)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -1202,7 +1202,7 @@ subroutine get_excitation_degree_vector_mono_or_exchange(key1,key2,degree,Nint,s
|
||||
enddo
|
||||
else
|
||||
|
||||
print*, 'get_excitation_degree_vector_mono_or_exchange not yet implemented for N_int > 1 ...'
|
||||
print*, 'get_excitation_degree_vector_single_or_exchange not yet implemented for N_int > 1 ...'
|
||||
stop
|
||||
|
||||
endif
|
||||
@ -1322,7 +1322,7 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint,
|
||||
end
|
||||
|
||||
|
||||
subroutine get_excitation_degree_vector_mono_or_exchange_verbose(key1,key2,degree,Nint,sze,idx)
|
||||
subroutine get_excitation_degree_vector_single_or_exchange_verbose(key1,key2,degree,Nint,sze,idx)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -1635,7 +1635,7 @@ double precision function diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Ni
|
||||
endif
|
||||
|
||||
else if (degree == 1) then
|
||||
call get_mono_excitation(det_ref,det_pert,exc,phase,Nint)
|
||||
call get_single_excitation(det_ref,det_pert,exc,phase,Nint)
|
||||
call decode_exc(exc,1,h1,p1,h2,p2,s1,s2)
|
||||
if (s1 == 1) then
|
||||
diag_H_mat_elem_fock = E0 - fock_diag_tmp(1,h1) &
|
||||
@ -1926,7 +1926,7 @@ subroutine get_excitation_spin(det1,det2,exc,degree,phase,Nint)
|
||||
return
|
||||
|
||||
case (1)
|
||||
call get_mono_excitation_spin(det1,det2,exc,phase,Nint)
|
||||
call get_single_excitation_spin(det1,det2,exc,phase,Nint)
|
||||
return
|
||||
|
||||
case(0)
|
||||
@ -2098,7 +2098,7 @@ subroutine get_double_excitation_spin(det1,det2,exc,phase,Nint)
|
||||
|
||||
end
|
||||
|
||||
subroutine get_mono_excitation_spin(det1,det2,exc,phase,Nint)
|
||||
subroutine get_single_excitation_spin(det1,det2,exc,phase,Nint)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -2174,7 +2174,7 @@ subroutine get_mono_excitation_spin(det1,det2,exc,phase,Nint)
|
||||
enddo
|
||||
end
|
||||
|
||||
subroutine i_H_j_mono_spin(key_i,key_j,Nint,spin,hij)
|
||||
subroutine i_H_j_single_spin(key_i,key_j,Nint,spin,hij)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -2190,8 +2190,8 @@ subroutine i_H_j_mono_spin(key_i,key_j,Nint,spin,hij)
|
||||
|
||||
PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map
|
||||
|
||||
call get_mono_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||
call get_mono_excitation_from_fock(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
|
||||
call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||
call get_single_excitation_from_fock(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
|
||||
end
|
||||
|
||||
subroutine i_H_j_double_spin(key_i,key_j,Nint,hij)
|
||||
@ -2240,8 +2240,8 @@ subroutine i_H_j_double_alpha_beta(key_i,key_j,Nint,hij)
|
||||
|
||||
PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map
|
||||
|
||||
call get_mono_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint)
|
||||
call get_mono_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint)
|
||||
call get_single_excitation_spin(key_i(1,1),key_j(1,1),exc(0,1,1),phase,Nint)
|
||||
call get_single_excitation_spin(key_i(1,2),key_j(1,2),exc(0,1,2),phase2,Nint)
|
||||
phase = phase*phase2
|
||||
if (exc(1,1,1) == exc(1,2,2)) then
|
||||
hij = phase * big_array_exchange_integrals(exc(1,1,1),exc(1,1,2),exc(1,2,1))
|
||||
|
@ -1,5 +1,5 @@
|
||||
|
||||
subroutine i_Wee_j_mono(key_i,key_j,Nint,spin,hij)
|
||||
subroutine i_Wee_j_single(key_i,key_j,Nint,spin,hij)
|
||||
use bitmasks
|
||||
implicit none
|
||||
BEGIN_DOC
|
||||
@ -15,8 +15,8 @@ subroutine i_Wee_j_mono(key_i,key_j,Nint,spin,hij)
|
||||
|
||||
PROVIDE big_array_exchange_integrals mo_two_e_integrals_in_map
|
||||
|
||||
call get_mono_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||
call mono_excitation_wee(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
|
||||
call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||
call single_excitation_wee(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
|
||||
end
|
||||
|
||||
|
||||
@ -188,7 +188,7 @@ subroutine i_H_j_mono_spin_one_e(key_i,key_j,Nint,spin,hij)
|
||||
integer :: exc(0:2,2)
|
||||
double precision :: phase
|
||||
|
||||
call get_mono_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||
call get_single_excitation_spin(key_i(1,spin),key_j(1,spin),exc,phase,Nint)
|
||||
integer :: m,p
|
||||
m = exc(1,1)
|
||||
p = exc(1,2)
|
||||
@ -252,7 +252,7 @@ subroutine i_H_j_one_e(key_i,key_j,Nint,hij)
|
||||
if(degree==0)then
|
||||
hij = diag_H_mat_elem_one_e(key_i,N_int)
|
||||
else
|
||||
call get_mono_excitation(key_i,key_j,exc,phase,Nint)
|
||||
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||
if (exc(0,1,1) == 1) then
|
||||
! Mono alpha
|
||||
m = exc(1,1,1)
|
||||
@ -340,7 +340,7 @@ subroutine i_H_j_two_e(key_i,key_j,Nint,hij)
|
||||
exc(1,2,2) ,mo_integrals_map) )
|
||||
endif
|
||||
case (1)
|
||||
call get_mono_excitation(key_i,key_j,exc,phase,Nint)
|
||||
call get_single_excitation(key_i,key_j,exc,phase,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
|
||||
if (exc(0,1,1) == 1) then
|
||||
@ -354,7 +354,7 @@ subroutine i_H_j_two_e(key_i,key_j,Nint,hij)
|
||||
p = exc(1,2,2)
|
||||
spin = 2
|
||||
endif
|
||||
call mono_excitation_wee(key_i,key_j,p,m,spin,phase,hij)
|
||||
call single_excitation_wee(key_i,key_j,p,m,spin,phase,hij)
|
||||
case (0)
|
||||
double precision :: diag_wee_mat_elem
|
||||
hij = diag_wee_mat_elem(key_i,Nint)
|
||||
|
@ -2,10 +2,10 @@ BEGIN_PROVIDER [ double precision, mo_one_e_integrals,(mo_num,mo_num)]
|
||||
implicit none
|
||||
integer :: i,j,n,l
|
||||
BEGIN_DOC
|
||||
! array of the mono electronic hamiltonian on the MOs basis :
|
||||
! sum of the kinetic and nuclear electronic potential (and pseudo potential if needed)
|
||||
! array of the one-electron Hamiltonian on the |MO| basis :
|
||||
! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed)
|
||||
END_DOC
|
||||
print*,'Providing the mono electronic integrals'
|
||||
print*,'Providing the one-electron integrals'
|
||||
|
||||
IF (read_mo_one_e_integrals) THEN
|
||||
call ezfio_get_mo_one_e_ints_mo_one_e_integrals(mo_one_e_integrals)
|
||||
|
@ -198,7 +198,7 @@ subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_
|
||||
double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st)
|
||||
double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st)
|
||||
integer :: i,k, c_ref, ni, ex
|
||||
integer, external :: connected_to_ref_by_mono
|
||||
integer, external :: connected_to_ref_by_single
|
||||
logical, external :: is_in_wavefunction
|
||||
|
||||
integer(bit_kind), allocatable :: minilist(:,:,:)
|
||||
@ -232,7 +232,7 @@ subroutine perturb_buffer_by_mono_$PERT(i_generator,buffer,buffer_size,e_2_pert_
|
||||
|
||||
do i=1,buffer_size
|
||||
|
||||
c_ref = connected_to_ref_by_mono(buffer(1,1,i),psi_det_generators,Nint,i_generator,N_det)
|
||||
c_ref = connected_to_ref_by_single(buffer(1,1,i),psi_det_generators,Nint,i_generator,N_det)
|
||||
|
||||
if (c_ref /= 0) then
|
||||
cycle
|
||||
|
Loading…
Reference in New Issue
Block a user