PTEROSOR/QuantumPackage
10
0
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-26 15:12:19 +02: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_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 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 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) ASSERT (lrow <= N_det_alpha_unique)
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) 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) !DIR$ LOOP COUNT AVG(4)
do l=1,N_st do l=1,N_st
@ -568,7 +568,7 @@ compute_singles=.True.
ASSERT (lcol <= N_det_beta_unique) ASSERT (lcol <= N_det_beta_unique)
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) 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) l_a = psi_bilinear_matrix_transp_order(l_b)
ASSERT (l_a <= N_det) ASSERT (l_a <= N_det)
!DIR$ LOOP COUNT AVG(4) !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) ASSERT (lrow <= N_det_alpha_unique)
tmp_det2(1:$N_int,1) = psi_det_alpha_unique(1:$N_int, lrow) 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 do l=1,N_st
v_t(l,k_a) = v_t(l,k_a) + hij * u_t(l,l_a) 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) ASSERT (lcol <= N_det_beta_unique)
tmp_det2(1:$N_int,2) = psi_det_beta_unique (1:$N_int, lcol) 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) l_a = psi_bilinear_matrix_transp_order(l_b)
ASSERT (l_a <= N_det) ASSERT (l_a <= N_det)
do l=1,N_st 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 use bitmasks
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -202,7 +202,7 @@ logical function is_connected_to_by_mono(key,keys,Nint,Ndet)
ASSERT (Nint > 0) ASSERT (Nint > 0)
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
is_connected_to_by_mono = .false. is_connected_to_by_single = .false.
do i=1,Ndet do i=1,Ndet
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + & 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 if (degree_x2 > 2) then
cycle cycle
else else
is_connected_to_by_mono = .true. is_connected_to_by_single = .true.
return return
endif endif
enddo 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 use bitmasks
implicit none implicit none
BEGIN_DOC 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 > 0)
ASSERT (Nint == N_int) ASSERT (Nint == N_int)
connected_to_ref_by_mono = 0 connected_to_ref_by_single = 0
N_past = max(1,N_past_in) N_past = max(1,N_past_in)
if (Nint == 1) then 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 else if (degree_x2 == 4)then
cycle cycle
else if(degree_x2 == 2)then else if(degree_x2 == 2)then
connected_to_ref_by_mono = i connected_to_ref_by_single = i
return return
endif endif
enddo 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 else if (degree_x2 == 4)then
cycle cycle
else if(degree_x2 == 2)then else if(degree_x2 == 2)then
connected_to_ref_by_mono = i connected_to_ref_by_single = i
return return
endif endif
enddo 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 else if (degree_x2 == 4)then
cycle cycle
else if(degree_x2 == 2)then else if(degree_x2 == 2)then
connected_to_ref_by_mono = i connected_to_ref_by_single = i
return return
endif endif
enddo 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 else if (degree_x2 == 4)then
cycle cycle
else if(degree_x2 == 2)then else if(degree_x2 == 2)then
connected_to_ref_by_mono = i connected_to_ref_by_single = i
return return
endif endif
enddo 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 implicit none
BEGIN_DOC BEGIN_DOC
! Apply the single excitation operator : a^{dager}_(i_particle) a_(i_hole) of spin = ispin ! 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) call get_excitation_degree_spin(tmp_det(1,1),tmp_det2,degree,N_int)
if (degree == 1) then if (degree == 1) then
exc = 0 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) call decode_exc_spin(exc,h1,p1,h2,p2)
do m=1,N_states do m=1,N_states
ckl = psi_bilinear_matrix_values(k_a,m)*psi_bilinear_matrix_values(l,m) * phase 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) call get_excitation_degree_spin(tmp_det(1,2),tmp_det2,degree,N_int)
if (degree == 1) then if (degree == 1) then
exc = 0 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) call decode_exc_spin(exc,h1,p1,h2,p2)
do m=1,N_states do m=1,N_states
ckl = psi_bilinear_matrix_transp_values(k_b,m)*psi_bilinear_matrix_transp_values(l,m) * phase 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*,'h1 --> p1 of spin s1'
print*,'i_ok == +1 : excitation is possible ' print*,'i_ok == +1 : excitation is possible '
print*,'i_ok == -1 : excitation is NOT 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'
print*, h1,p1,s1,i_ok print*, h1,p1,s1,i_ok
if(i_ok == -1)then if(i_ok == -1)then
@ -54,7 +54,7 @@ subroutine example_determinants
h1 = elec_alpha_num h1 = elec_alpha_num
p1 = elec_alpha_num + 1 p1 = elec_alpha_num + 1
s1 = 2 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'
print*, h1,p1,s1,i_ok print*, h1,p1,s1,i_ok
call i_H_j(det_i,det_i,N_int,h0i) 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(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) 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 hole_save = hole
! Build array of the non-zero integrals of second excitation ! 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 enddo
endif endif
! does all the mono excitations of the same spin ! does all the single excitations of the same spin
i=0 i=0
do kk = 1,N_elec_in_key_hole_2(ispin) do kk = 1,N_elec_in_key_hole_2(ispin)
i_b = occ_hole_tmp(kk,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 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 use bitmasks
implicit none implicit none
integer,intent(in) :: h,p,spin integer,intent(in) :: h,p,spin
@ -79,7 +79,7 @@ BEGIN_PROVIDER [double precision, fock_wee_closed_shell, (mo_num, mo_num) ]
enddo enddo
double precision :: array_coulomb(mo_num),array_exchange(mo_num) 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) 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) do i0 = 1, n_occ_ab(1)
i=occ(i0,1) i=occ(i0,1)
do j0 = 1, n_occ_ab_virt(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
enddo enddo
! virt ---> virt mono excitations ! virt ---> virt single excitations
do i0 = 1, n_occ_ab_virt(1) do i0 = 1, n_occ_ab_virt(1)
i=occ_virt(i0,1) i=occ_virt(i0,1)
do j0 = 1, n_occ_ab_virt(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
enddo enddo
! docc ---> docc mono excitations ! docc ---> docc single excitations
do i0 = 1, n_occ_ab(1) do i0 = 1, n_occ_ab(1)
i=occ(i0,1) i=occ(i0,1)
do j0 = 1, n_occ_ab(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(:) double precision, allocatable :: array_coulomb(:),array_exchange(:)
allocate (array_coulomb(mo_num),array_exchange(mo_num)) allocate (array_coulomb(mo_num),array_exchange(mo_num))
call bitstring_to_list_ab(key_virt, occ_virt, n_occ_ab_virt, N_int) 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) do i0 = 1, n_occ_ab(1)
i=occ(i0,1) i=occ(i0,1)
do j0 = 1, n_occ_ab_virt(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
enddo enddo
! virt ---> virt mono excitations ! virt ---> virt single excitations
do i0 = 1, n_occ_ab_virt(1) do i0 = 1, n_occ_ab_virt(1)
i=occ_virt(i0,1) i=occ_virt(i0,1)
do j0 = 1, n_occ_ab_virt(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
enddo enddo
! docc ---> docc mono excitations ! docc ---> docc single excitations
do i0 = 1, n_occ_ab(1) do i0 = 1, n_occ_ab(1)
i=occ(i0,1) i=occ(i0,1)
do j0 = 1, n_occ_ab(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 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 use bitmasks
implicit none implicit none
integer,intent(in) :: h,p,spin 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 return
case (1) case (1)
call get_mono_excitation(det1,det2,exc,phase,Nint) call get_single_excitation(det1,det2,exc,phase,Nint)
return return
case(0) 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 use bitmasks
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -499,7 +499,7 @@ subroutine i_H_j_s2(key_i,key_j,Nint,hij,s2)
select case (degree) select case (degree)
case (2) case (2)
call get_double_excitation(key_i,key_j,exc,phase,Nint) 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(0,1,1) == 1) then
if ( (exc(1,1,1) == exc(1,2,2)).and.(exc(1,1,2) == exc(1,2,1)) ) then if ( (exc(1,1,1) == exc(1,2,2)).and.(exc(1,1,2) == exc(1,2,1)) ) then
s2 = -phase 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) ) exc(1,2,2) ,mo_integrals_map) )
endif endif
case (1) 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 !DIR$ FORCEINLINE
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
! Mono alpha ! Single alpha
if (exc(0,1,1) == 1) then if (exc(0,1,1) == 1) then
m = exc(1,1,1) m = exc(1,1,1)
p = exc(1,2,1) p = exc(1,2,1)
spin = 1 spin = 1
! Mono beta ! Single beta
else else
m = exc(1,1,2) m = exc(1,1,2)
p = exc(1,2,2) p = exc(1,2,2)
spin = 2 spin = 2
endif 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) case (0)
double precision, external :: diag_S_mat_elem double precision, external :: diag_S_mat_elem
@ -602,7 +602,7 @@ subroutine i_H_j(key_i,key_j,Nint,hij)
case (2) case (2)
call get_double_excitation(key_i,key_j,exc,phase,Nint) call get_double_excitation(key_i,key_j,exc,phase,Nint)
if (exc(0,1,1) == 1) then 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 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)) 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 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) ) exc(1,2,2) ,mo_integrals_map) )
endif endif
case (1) 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 !DIR$ FORCEINLINE
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
if (exc(0,1,1) == 1) then if (exc(0,1,1) == 1) then
! Mono alpha ! Single alpha
m = exc(1,1,1) m = exc(1,1,1)
p = exc(1,2,1) p = exc(1,2,1)
spin = 1 spin = 1
else else
! Mono beta ! Single beta
m = exc(1,1,2) m = exc(1,1,2)
p = exc(1,2,2) p = exc(1,2,2)
spin = 2 spin = 2
endif 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) case (0)
hij = diag_H_mat_elem(key_i,Nint) 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) case (2)
call get_double_excitation(key_i,key_j,exc,phase,Nint) call get_double_excitation(key_i,key_j,exc,phase,Nint)
if (exc(0,1,1) == 1) then if (exc(0,1,1) == 1) then
! Mono alpha, mono beta ! Single alpha, single beta
hij = phase*get_two_e_integral( & hij = phase*get_two_e_integral( &
exc(1,1,1), & exc(1,1,1), &
exc(1,1,2), & 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) ) exc(1,2,2) ,mo_integrals_map) )
endif endif
case (1) 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 !DIR$ FORCEINLINE
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
has_mipi = .False. has_mipi = .False.
if (exc(0,1,1) == 1) then if (exc(0,1,1) == 1) then
! Mono alpha ! Single alpha
m = exc(1,1,1) m = exc(1,1,1)
p = exc(1,2,1) p = exc(1,2,1)
do k = 1, elec_alpha_num 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 enddo
else else
! Mono beta ! Single beta
m = exc(1,1,2) m = exc(1,1,2)
p = exc(1,2,2) p = exc(1,2,2)
do k = 1, elec_beta_num 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 use bitmasks
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -1154,7 +1154,7 @@ subroutine get_excitation_degree_vector_mono(key1,key2,degree,Nint,sze,idx)
end 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 use bitmasks
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -1202,7 +1202,7 @@ subroutine get_excitation_degree_vector_mono_or_exchange(key1,key2,degree,Nint,s
enddo enddo
else 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 stop
endif endif
@ -1322,7 +1322,7 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint,
end 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 use bitmasks
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -1635,7 +1635,7 @@ double precision function diag_H_mat_elem_fock(det_ref,det_pert,fock_diag_tmp,Ni
endif endif
else if (degree == 1) then 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) call decode_exc(exc,1,h1,p1,h2,p2,s1,s2)
if (s1 == 1) then if (s1 == 1) then
diag_H_mat_elem_fock = E0 - fock_diag_tmp(1,h1) & 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 return
case (1) case (1)
call get_mono_excitation_spin(det1,det2,exc,phase,Nint) call get_single_excitation_spin(det1,det2,exc,phase,Nint)
return return
case(0) case(0)
@ -2098,7 +2098,7 @@ subroutine get_double_excitation_spin(det1,det2,exc,phase,Nint)
end end
subroutine get_mono_excitation_spin(det1,det2,exc,phase,Nint) subroutine get_single_excitation_spin(det1,det2,exc,phase,Nint)
use bitmasks use bitmasks
implicit none implicit none
BEGIN_DOC BEGIN_DOC
@ -2174,7 +2174,7 @@ subroutine get_mono_excitation_spin(det1,det2,exc,phase,Nint)
enddo enddo
end 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 use bitmasks
implicit none implicit none
BEGIN_DOC 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 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_single_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_from_fock(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
end end
subroutine i_H_j_double_spin(key_i,key_j,Nint,hij) 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 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_single_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,2),key_j(1,2),exc(0,1,2),phase2,Nint)
phase = phase*phase2 phase = phase*phase2
if (exc(1,1,1) == exc(1,2,2)) then 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)) 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 use bitmasks
implicit none implicit none
BEGIN_DOC 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 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_single_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 single_excitation_wee(key_i,key_j,exc(1,1),exc(1,2),spin,phase,hij)
end 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) integer :: exc(0:2,2)
double precision :: phase 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 integer :: m,p
m = exc(1,1) m = exc(1,1)
p = exc(1,2) p = exc(1,2)
@ -252,7 +252,7 @@ subroutine i_H_j_one_e(key_i,key_j,Nint,hij)
if(degree==0)then if(degree==0)then
hij = diag_H_mat_elem_one_e(key_i,N_int) hij = diag_H_mat_elem_one_e(key_i,N_int)
else 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 if (exc(0,1,1) == 1) then
! Mono alpha ! Mono alpha
m = exc(1,1,1) 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) ) exc(1,2,2) ,mo_integrals_map) )
endif endif
case (1) 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 !DIR$ FORCEINLINE
call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint) call bitstring_to_list_ab(key_i, occ, n_occ_ab, Nint)
if (exc(0,1,1) == 1) then 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) p = exc(1,2,2)
spin = 2 spin = 2
endif 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) case (0)
double precision :: diag_wee_mat_elem double precision :: diag_wee_mat_elem
hij = diag_wee_mat_elem(key_i,Nint) 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 implicit none
integer :: i,j,n,l integer :: i,j,n,l
BEGIN_DOC BEGIN_DOC
! array of the mono electronic hamiltonian on the MOs basis : ! array of the one-electron Hamiltonian on the |MO| basis :
! sum of the kinetic and nuclear electronic potential (and pseudo potential if needed) ! sum of the kinetic and nuclear electronic potentials (and pseudo potential if needed)
END_DOC END_DOC
print*,'Providing the mono electronic integrals' print*,'Providing the one-electron integrals'
IF (read_mo_one_e_integrals) THEN IF (read_mo_one_e_integrals) THEN
call ezfio_get_mo_one_e_ints_mo_one_e_integrals(mo_one_e_integrals) 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, 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) double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st)
integer :: i,k, c_ref, ni, ex 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 logical, external :: is_in_wavefunction
integer(bit_kind), allocatable :: minilist(:,:,:) 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 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 if (c_ref /= 0) then
cycle cycle