LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-12-21 11:03:29 +01:00
Code Releases Activity

Mono -> Single

Browse Source
This commit is contained in:
Anthony Scemama 2019-02-04 23:51:09 +01:00
parent 37fe028626
commit 60255980e9
14 changed files with 82 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
REPLACE
View File

@ -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

4
src/davidson/u0_h_u0.irp.f
View File

@ -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)

4
src/davidson/u0_wee_u0.irp.f
View File

@ -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

18
src/determinants/connected_to_ref.irp.f
View File

@ -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

2
src/determinants/create_excitations.irp.f
View File

@ -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

4
src/determinants/density_matrix.irp.f
View File

@ -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

4
src/determinants/example.irp.f
View File

@ -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)

4
src/determinants/h_apply.template.f
View File

@ -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)

8
src/determinants/mono_excitations_bielec.irp.f → src/determinants/single_excitation_two_e.irp.f
View File

@ -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)

8
src/determinants/single_excitations.irp.f
View File

@ -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

56
src/determinants/slater_rules.irp.f
View File

@ -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))

14
src/determinants/slater_rules_wee_mono.irp.f
View File

@ -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)

6
src/mo_one_e_ints/mo_one_e_ints.irp.f
View File

@ -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)

4
src/perturbation/perturbation.template.f
View File

@ -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