LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2025-01-09 12:44:07 +01:00
Code Issues Releases Wiki Activity

Merge branch 'master' of github.com:LCPQ/quantum_package

Browse Source 
Conflicts:
	src/Hartree_Fock/README.rst
This commit is contained in:
Manu 2014-05-21 22:42:13 +02:00
commit 9e16c5526a
19 changed files with 646 additions and 367 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scripts/check_dependencies.sh
View File

@ -51,7 +51,7 @@ DEPS=$(unique_list $DEPS_LONG)
if [[ ! "$COMMAND_LINE" == "$DEPS" ]]
then
DEPS=$(check_dependencies.sh $DEPS)
DEPS=$(${QPACKAGE_ROOT}/scripts/check_dependencies.sh ${DEPS})
fi
echo $DEPS

38
scripts/generate_h_apply.py
View File

@ -10,7 +10,8 @@ subroutine
parameters
initialization
declarations
keys_work
keys_work_locked
keys_work_unlocked
finalization
""".split()
@ -24,7 +25,10 @@ class H_apply(object):
self.openmp = openmp
if openmp:
s["subroutine"] += "_OpenMP"
self.selection_pt2 = None
self.perturbation = None
#s["omp_parallel"] = """!$OMP PARALLEL DEFAULT(NONE) &
s["omp_parallel"] = """!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(i,j,k,l,keys_out,hole,particle, &
@ -34,7 +38,7 @@ class H_apply(object):
!$OMP occ_hole_tmp,key_idx,i_b,j_b,key,N_elec_in_key_part_1,&
!$OMP N_elec_in_key_hole_1,N_elec_in_key_part_2, &
!$OMP N_elec_in_key_hole_2,ia_ja_pairs) &
!$OMP SHARED(key_in,N_int,elec_num_tab, &
!$OMP SHARED(key_in,N_int,elec_num_tab,mo_tot_num, &
!$OMP hole_1, particl_1, hole_2, particl_2, &
!$OMP lck,thresh,elec_alpha_num)"""
s["omp_init_lock"] = "call omp_init_lock(lck)"
@ -72,6 +76,8 @@ class H_apply(object):
return buffer
def set_perturbation(self,pert):
if self.perturbation is not None:
raise
self.perturbation = pert
if pert is not None:
self.data["parameters"] = ",sum_e_2_pert_in,sum_norm_pert_in,sum_H_pert_diag_in,N_st,Nint"
@ -83,16 +89,17 @@ class H_apply(object):
double precision :: sum_e_2_pert(N_st)
double precision :: sum_norm_pert(N_st)
double precision :: sum_H_pert_diag
double precision :: e_2_pert_buffer(N_st,size_max)
double precision :: coef_pert_buffer(N_st,size_max)
"""
self.data["size_max"] = "256"
self.data["initialization"] = """
E_ref = diag_H_mat_elem(key_in,N_int)
sum_e_2_pert = sum_e_2_pert_in
sum_norm_pert = sum_norm_pert_in
sum_H_pert_diag = sum_H_pert_diag_in
"""
self.data["keys_work"] += """
call perturb_buffer_%s(keys_out,key_idx,sum_e_2_pert, &
self.data["keys_work_unlocked"] += """
call perturb_buffer_%s(keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, &
sum_norm_pert,sum_H_pert_diag,N_st,Nint)
"""%(pert,)
self.data["finalization"] = """
@ -101,10 +108,29 @@ class H_apply(object):
sum_H_pert_diag_in = sum_H_pert_diag
"""
if self.openmp:
self.data["omp_set_lock"] = ""
self.data["omp_unset_lock"] = ""
self.data["omp_test_lock"] = ".False."
self.data["omp_parallel"] += """&
!$OMP SHARED(N_st) &
!$OMP SHARED(N_st,Nint) PRIVATE(e_2_pert_buffer,coef_pert_buffer) &
!$OMP REDUCTION(+:sum_e_2_pert, sum_norm_pert, sum_H_pert_diag)"""
def set_selection_pt2(self,pert):
if self.selection_pt2 is not None:
raise
self.set_perturbation(pert)
self.selection_pt2 = pert
if pert is not None:
self.data["size_max"] = str(1024*128)
self.data["keys_work_unlocked"] = """
e_2_pert_buffer = 0.d0
coef_pert_buffer = 0.d0
""" + self.data["keys_work_unlocked"]
self.data["keys_work_locked"] = """
call fill_H_apply_buffer_selection(key_idx,keys_out,e_2_pert_buffer,coef_pert_buffer,N_st,N_int)
"""
self.data["omp_test_lock"] = "omp_test_lock(lck)"
self.data["omp_set_lock"] = "call omp_set_lock(lck)"
self.data["omp_unset_lock"] = "call omp_unset_lock(lck)"

22
src/Dets/H_apply.irp.f
View File

@ -33,11 +33,12 @@ subroutine resize_H_apply_buffer_det(new_size)
integer, intent(in) :: new_size
integer(bit_kind), allocatable :: buffer_det(:,:,:)
double precision, allocatable :: buffer_coef(:,:)
double precision, allocatable :: buffer_e2(:,:)
integer :: i,j,k
integer :: Ndet
ASSERT (new_size > 0)
allocate ( buffer_det(N_int,2,new_size), buffer_coef(new_size,N_states) )
allocate ( buffer_det(N_int,2,new_size), buffer_coef(new_size,N_states), buffer_e2(new_size,N_states) )
do i=1,min(new_size,H_apply_buffer_N_det)
do k=1,N_int
@ -48,9 +49,10 @@ subroutine resize_H_apply_buffer_det(new_size)
ASSERT (sum(popcnt(H_apply_buffer_det(:,2,i))) == elec_beta_num )
enddo
do k=1,N_states
do i=1,min(new_size,H_apply_buffer_N_det)
buffer_coef(i,k) = H_apply_buffer_coef(i,k)
enddo
do i=1,min(new_size,H_apply_buffer_N_det)
buffer_coef(i,k) = H_apply_buffer_coef(i,k)
buffer_e2(i,k) = H_apply_buffer_e2(i,k)
enddo
enddo
H_apply_buffer_size = new_size
@ -70,20 +72,23 @@ subroutine resize_H_apply_buffer_det(new_size)
do k=1,N_states
do i=1,H_apply_buffer_N_det
H_apply_buffer_coef(i,k) = buffer_coef(i,k)
H_apply_buffer_e2(i,k) = buffer_e2(i,k)
enddo
enddo
deallocate (buffer_det, buffer_coef)
SOFT_TOUCH H_apply_buffer_det H_apply_buffer_coef H_apply_buffer_N_det
deallocate (buffer_det, buffer_coef, buffer_e2)
SOFT_TOUCH H_apply_buffer_det H_apply_buffer_coef H_apply_buffer_N_det H_apply_buffer_e2
end
BEGIN_PROVIDER [ integer(bit_kind), H_apply_buffer_det,(N_int,2,H_apply_buffer_size) ]
&BEGIN_PROVIDER [ double precision, H_apply_buffer_coef,(H_apply_buffer_size,N_states) ]
&BEGIN_PROVIDER [ double precision, H_apply_buffer_e2,(H_apply_buffer_size,N_states) ]
&BEGIN_PROVIDER [ integer, H_apply_buffer_N_det ]
implicit none
BEGIN_DOC
! Buffer of determinants/coefficients for H_apply. Uninitialized. Filled by H_apply subroutines.
! Buffer of determinants/coefficients/perturbative energy for H_apply.
! Uninitialized. Filled by H_apply subroutines.
END_DOC
H_apply_buffer_N_det = 0
@ -148,8 +153,9 @@ subroutine copy_H_apply_buffer_to_wf
psi_coef(i+N_det_old,k) = H_apply_buffer_coef(i,k)
enddo
enddo
H_apply_buffer_N_det = 0
SOFT_TOUCH psi_det psi_coef
SOFT_TOUCH psi_det psi_coef H_apply_buffer_N_det H_apply_buffer_det H_apply_buffer_coef H_apply_buffer_e2
end

66
src/Dets/H_apply_template.f
View File

@ -7,6 +7,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame
! particles.
! Assume N_int is already provided.
END_DOC
integer,parameter :: size_max = $size_max
$declarations
integer(omp_lock_kind) :: lck
integer(bit_kind),intent(in) :: key_in(N_int,2)
@ -26,13 +27,12 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame
integer :: N_elec_in_key_hole_1(2),N_elec_in_key_part_1(2)
integer :: N_elec_in_key_hole_2(2),N_elec_in_key_part_2(2)
integer,parameter :: size_max = $size_max
double precision :: hij_elec, mo_bielec_integral, thresh
integer, allocatable :: ia_ja_pairs(:,:,:)
double precision :: diag_H_mat_elem
PROVIDE mo_integrals_map ref_bitmask_energy
PROVIDE mo_bielec_integrals_in_map
PROVIDE mo_integrals_map ref_bitmask_energy key_pattern_not_in_ref
PROVIDE mo_bielec_integrals_in_map reference_energy psi_ref_coef psi_ref
$set_i_H_j_threshold
@ -156,8 +156,9 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame
hij_tab(key_idx) = hij_elec
ASSERT (key_idx <= size_max)
if (key_idx == size_max) then
$keys_work_unlocked
$omp_set_lock
$keys_work
$keys_work_locked
$omp_unset_lock
key_idx = 0
endif
@ -165,7 +166,8 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame
enddo
if (key_idx > ishft(size_max,-5)) then
if ($omp_test_lock) then
$keys_work
$keys_work_unlocked
$keys_work_locked
$omp_unset_lock
key_idx = 0
endif
@ -204,8 +206,9 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame
hij_tab(key_idx) = hij_elec
ASSERT (key_idx <= size_max)
if (key_idx == size_max) then
$keys_work_unlocked
$omp_set_lock
$keys_work
$keys_work_locked
$omp_unset_lock
key_idx = 0
endif
@ -213,7 +216,8 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame
enddo
if (key_idx > ishft(size_max,-5)) then
if ($omp_test_lock) then
$keys_work
$keys_work_locked
$keys_work_unlocked
$omp_unset_lock
key_idx = 0
endif
@ -222,8 +226,9 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2 $parame
enddo ! ii
$omp_enddo
enddo ! ispin
$keys_work_unlocked
$omp_set_lock
$keys_work
$keys_work_locked
$omp_unset_lock
deallocate (keys_out,hij_tab,ia_ja_pairs)
$omp_end_parallel
@ -241,6 +246,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1 $parameters )
! particles.
! Assume N_int is already provided.
END_DOC
integer,parameter :: size_max = $size_max
$declarations
integer(omp_lock_kind) :: lck
integer(bit_kind),intent(in) :: key_in(N_int,2)
@ -260,13 +266,12 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1 $parameters )
integer :: N_elec_in_key_hole_1(2),N_elec_in_key_part_1(2)
integer :: N_elec_in_key_hole_2(2),N_elec_in_key_part_2(2)
integer,parameter :: size_max = $size_max
double precision :: hij_elec, thresh
integer, allocatable :: ia_ja_pairs(:,:,:)
double precision :: diag_H_mat_elem
PROVIDE mo_integrals_map ref_bitmask_energy
PROVIDE mo_bielec_integrals_in_map
PROVIDE mo_integrals_map ref_bitmask_energy key_pattern_not_in_ref
PROVIDE mo_bielec_integrals_in_map reference_energy psi_ref_coef psi_ref
$set_i_H_j_threshold
@ -311,7 +316,6 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1 $parameters )
integer(bit_kind) :: test(N_int,2)
double precision :: accu
accu = 0.d0
hij_elec = 0.d0
do ispin=1,2
other_spin = iand(ispin,1)+1
$omp_do
@ -325,33 +329,33 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1 $parameters )
k_a = ishft(j_a-1,-bit_kind_shift)+1
l_a = j_a-ishft(k_a-1,bit_kind_shift)-1
hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a)
call i_H_j(hole,key_in,N_int,hij_elec)
if(dabs(hij_elec) .ge. thresh)then
key_idx += 1
do k=1,N_int
keys_out(k,1,key_idx) = hole(k,1)
keys_out(k,2,key_idx) = hole(k,2)
enddo
hij_tab(key_idx) = hij_elec
if (key_idx > ishft(size_max,-5)) then
if ($omp_test_lock) then
$keys_work
$omp_unset_lock
key_idx = 0
endif
endif
if (key_idx == size_max) then
$omp_set_lock
$keys_work
key_idx += 1
do k=1,N_int
keys_out(k,1,key_idx) = hole(k,1)
keys_out(k,2,key_idx) = hole(k,2)
enddo
hij_tab(key_idx) = hij_elec
if (key_idx > ishft(size_max,-5)) then
if ($omp_test_lock) then
$keys_work_unlocked
$keys_work_locked
$omp_unset_lock
key_idx = 0
endif
endif
if (key_idx == size_max) then
$keys_work_unlocked
$omp_set_lock
$keys_work_locked
$omp_unset_lock
key_idx = 0
endif
enddo ! ii
$omp_enddo
enddo ! ispin
$keys_work_unlocked
$omp_set_lock
$keys_work
$keys_work_locked
$omp_unset_lock
deallocate (keys_out,hij_tab,ia_ja_pairs)
$omp_end_parallel

470
src/Dets/connected_to_ref.irp.f
View File

@ -1,254 +1,256 @@
integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet,thresh)
use bitmasks
implicit none
integer, intent(in) :: Nint, N_past_in, Ndet
integer(bit_kind), intent(in) :: keys(ishft(Nint,-1),2,Ndet)
integer(bit_kind), intent(in) :: key(ishft(Nint,-1),2)
double precision, intent(in) :: thresh
integer :: N_past
integer :: i, l
integer :: degree_x2
logical :: det_is_not_or_may_be_in_ref, t
double precision :: hij_elec
! output : 0 : not connected
! i : connected to determinant i of the past
! -i : is the ith determinant of the refernce wf keys
ASSERT (Nint == N_int)
connected_to_ref = 0
N_past = max(1,N_past_in)
if (Nint == 1) then
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i)))
if(degree_x2 == 0)then
use bitmasks
implicit none
integer, intent(in) :: Nint, N_past_in, Ndet
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
integer(bit_kind), intent(in) :: key(Nint,2)
double precision, intent(in) :: thresh
integer :: N_past
integer :: i, l
integer :: degree_x2
logical :: det_is_not_or_may_be_in_ref, t
double precision :: hij_elec
! output : 0 : not connected
! i : connected to determinant i of the past
! -i : is the ith determinant of the refernce wf keys
ASSERT (Nint > 0)
ASSERT (Nint == N_int)
connected_to_ref = 0
N_past = max(1,N_past_in)
if (Nint == 1) then
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i)))
if(degree_x2 == 0)then
connected_to_ref = -i
return
endif
if (degree_x2 > 5) then
cycle
else
call i_H_j(keys(1,1,i),key,N_int,hij_elec)
if(dabs(hij_elec).lt.thresh)cycle
connected_to_ref = i
return
endif
enddo
!DIR$ FORCEINLINE
t = det_is_not_or_may_be_in_ref(key,N_int)
if ( t ) then
return
endif
do i=N_past,Ndet
if ( (key(1,1) /= keys(1,1,i)).or. &
(key(1,2) /= keys(1,2,i)) ) then
cycle
endif
connected_to_ref = -i
return
endif
if (degree_x2 > 5) then
cycle
else
call i_H_j(keys(1,1,i),key,N_int,hij_elec)
if(dabs(hij_elec).lt.thresh)cycle
connected_to_ref = i
return
endif
enddo
!DIR$ FORCEINLINE
t = det_is_not_or_may_be_in_ref(key,N_int)
if ( t ) then
return
endif
do i=N_past,Ndet
if ( (key(1,1) /= keys(1,1,i)).or. &
(key(1,2) /= keys(1,2,i)) ) then
cycle
endif
connected_to_ref = -i
return
enddo
return
else if (Nint==2) then
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i))) + &
popcnt(xor( key(2,1), keys(2,1,i))) + &
popcnt(xor( key(2,2), keys(2,2,i)))
if(degree_x2 == 0)then
enddo
return
else if (Nint==2) then
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i))) + &
popcnt(xor( key(2,1), keys(2,1,i))) + &
popcnt(xor( key(2,2), keys(2,2,i)))
if(degree_x2 == 0)then
connected_to_ref = -i
return
endif
if (degree_x2 > 5) then
cycle
else
call i_H_j(keys(1,1,i),key,N_int,hij_elec)
if(dabs(hij_elec).lt.thresh)cycle
connected_to_ref = i
return
endif
enddo
!DIR$ FORCEINLINE
t = det_is_not_or_may_be_in_ref(key,N_int)
if ( t ) then
return
endif
!DIR$ LOOP COUNT (1000)
do i=N_past+1,Ndet
if ( (key(1,1) /= keys(1,1,i)).or. &
(key(1,2) /= keys(1,2,i)).or. &
(key(2,1) /= keys(2,1,i)).or. &
(key(2,2) /= keys(2,2,i)) ) then
cycle
endif
connected_to_ref = -i
return
endif
if (degree_x2 > 5) then
cycle
else
call i_H_j(keys(1,1,i),key,N_int,hij_elec)
if(dabs(hij_elec).lt.thresh)cycle
connected_to_ref = i
return
endif
enddo
!DIR$ FORCEINLINE
t = det_is_not_or_may_be_in_ref(key,N_int)
if ( t ) then
return
endif
!DIR$ LOOP COUNT (1000)
do i=N_past+1,Ndet
if ( (key(1,1) /= keys(1,1,i)).or. &
(key(1,2) /= keys(1,2,i)).or. &
(key(2,1) /= keys(2,1,i)).or. &
(key(2,2) /= keys(2,2,i)) ) then
cycle
endif
connected_to_ref = -i
return
enddo
return
else if (Nint==3) then
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i))) + &
popcnt(xor( key(2,1), keys(2,1,i))) + &
popcnt(xor( key(2,2), keys(2,2,i))) + &
popcnt(xor( key(3,1), keys(3,1,i))) + &
popcnt(xor( key(3,2), keys(3,2,i)))
if(degree_x2 == 0)then
enddo
return
else if (Nint==3) then
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i))) + &
popcnt(xor( key(2,1), keys(2,1,i))) + &
popcnt(xor( key(2,2), keys(2,2,i))) + &
popcnt(xor( key(3,1), keys(3,1,i))) + &
popcnt(xor( key(3,2), keys(3,2,i)))
if(degree_x2 == 0)then
connected_to_ref = -i
return
endif
if (degree_x2 > 5) then
cycle
else
call i_H_j(keys(1,1,i),key,N_int,hij_elec)
if(dabs(hij_elec).lt.thresh)cycle
connected_to_ref = i
return
endif
enddo
!DIR$ FORCEINLINE
t = det_is_not_or_may_be_in_ref(key,N_int)
if ( t ) then
return
endif
do i=N_past+1,Ndet
if ( (key(1,1) /= keys(1,1,i)).or. &
(key(1,2) /= keys(1,2,i)).or. &
(key(2,1) /= keys(2,1,i)).or. &
(key(2,2) /= keys(2,2,i)).or. &
(key(3,1) /= keys(3,1,i)).or. &
(key(3,2) /= keys(3,2,i)) ) then
cycle
endif
connected_to_ref = -i
return
endif
if (degree_x2 > 5) then
cycle
else
call i_H_j(keys(1,1,i),key,N_int,hij_elec)
if(dabs(hij_elec).lt.thresh)cycle
connected_to_ref = i
return
endif
enddo
!DIR$ FORCEINLINE
t = det_is_not_or_may_be_in_ref(key,N_int)
if ( t ) then
return
endif
do i=N_past+1,Ndet
if ( (key(1,1) /= keys(1,1,i)).or. &
(key(1,2) /= keys(1,2,i)).or. &
(key(2,1) /= keys(2,1,i)).or. &
(key(2,2) /= keys(2,2,i)).or. &
(key(3,1) /= keys(3,1,i)).or. &
(key(3,2) /= keys(3,2,i)) ) then
cycle
endif
connected_to_ref = -i
return
enddo
return
else
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i)))
!DEC$ LOOP COUNT MIN(3)
do l=2,Nint
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) + &
popcnt(xor( key(l,2), keys(l,2,i)))
enddo
if(degree_x2 == 0)then
connected_to_ref = -i
enddo
return
else
do i=N_past-1,1,-1
degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + &
popcnt(xor( key(1,2), keys(1,2,i)))
!DEC$ LOOP COUNT MIN(3)
do l=2,Nint
degree_x2 = degree_x2 + popcnt(xor( key(l,1), keys(l,1,i))) +&
popcnt(xor( key(l,2), keys(l,2,i)))
enddo
if(degree_x2 == 0)then
connected_to_ref = -i
return
endif
if (degree_x2 > 5) then
cycle
else
call i_H_j(keys(1,1,i),key,N_int,hij_elec)
if(dabs(hij_elec).lt.thresh)cycle
connected_to_ref = i
return
endif
enddo
!DIR$ FORCEINLINE
t = det_is_not_or_may_be_in_ref(key,N_int)
if ( t ) then
return
endif
if (degree_x2 > 5) then
cycle
else
call i_H_j(keys(1,1,i),key,N_int,hij_elec)
if(dabs(hij_elec).lt.thresh)cycle
connected_to_ref = i
return
endif
enddo
!DIR$ FORCEINLINE
t = det_is_not_or_may_be_in_ref(key,N_int)
if ( t ) then
return
endif
do i=N_past+1,Ndet
if ( (key(1,1) /= keys(1,1,i)).or. &
(key(1,2) /= keys(1,2,i)) ) then
cycle
else
connected_to_ref = -1
!DEC$ LOOP COUNT MIN(3)
do l=2,Nint
if ( (key(l,1) /= keys(l,1,i)).or. &
(key(l,2) /= keys(l,2,i)) ) then
connected_to_ref = 0
exit
endif
enddo
if (connected_to_ref /= 0) then
return
endif
endif
enddo
endif
endif
do i=N_past+1,Ndet
if ( (key(1,1) /= keys(1,1,i)).or. &
(key(1,2) /= keys(1,2,i)) ) then
cycle
else
connected_to_ref = -1
!DEC$ LOOP COUNT MIN(3)
do l=2,Nint
if ( (key(l,1) /= keys(l,1,i)).or. &
(key(l,2) /= keys(l,2,i)) ) then
connected_to_ref = 0
exit
endif
enddo
if (connected_to_ref /= 0) then
return
endif
endif
enddo
endif
end
logical function det_is_not_or_may_be_in_ref(key,Nint)
implicit none
! If true, det is not in ref
! If false, det may be in ref
integer, intent(in) :: key(Nint,2), Nint
integer :: key_int
integer*1 :: key_short(4)
!DIR$ ATTRIBUTES ALIGN : 32 :: key_short
equivalence (key_int,key_short)
integer :: i, ispin
det_is_not_or_may_be_in_ref = .False.
do ispin=1,2
do i=1,Nint
key_int = key(i,ispin)
if ( &
key_pattern_not_in_ref(key_short(1), i, ispin) &
.or.key_pattern_not_in_ref(key_short(2), i, ispin) &
.or.key_pattern_not_in_ref(key_short(3), i, ispin) &
.or.key_pattern_not_in_ref(key_short(4), i, ispin) &
) then
det_is_not_or_may_be_in_ref = .True.
use bitmasks
implicit none
BEGIN_DOC
! If true, det is not in ref
! If false, det may be in ref
END_DOC
integer(bit_kind), intent(in) :: key(Nint,2), Nint
integer(bit_kind) :: key_int
integer*1 :: key_short(bit_kind)
!DIR$ ATTRIBUTES ALIGN : 32 :: key_short
equivalence (key_int,key_short)
integer :: i, ispin, k
det_is_not_or_may_be_in_ref = .False.
do ispin=1,2
do i=1,Nint
key_int = key(i,ispin)
do k=1,bit_kind
det_is_not_or_may_be_in_ref = &
det_is_not_or_may_be_in_ref .or. &
key_pattern_not_in_ref(key_short(k), i, ispin)
enddo
if(det_is_not_or_may_be_in_ref) then
return
endif
endif
enddo
enddo
enddo
end
BEGIN_PROVIDER [ logical, key_pattern_not_in_ref, (-128:127,N_int,2) ]
implicit none
BEGIN_DOC
! Min and max values of the integers of the keys of the reference
END_DOC
integer :: i, j, ispin
integer :: key
integer*1 :: key_short(4)
equivalence (key,key_short)
integer :: idx
key_pattern_not_in_ref = .True.
do j=1,N_det
do ispin=1,2
do i=1,N_int
key = psi_det(i,ispin,j)
key_pattern_not_in_ref( key_short(1), i, ispin ) = .False.
key_pattern_not_in_ref( key_short(2), i, ispin ) = .False.
key_pattern_not_in_ref( key_short(3), i, ispin ) = .False.
key_pattern_not_in_ref( key_short(4), i, ispin ) = .False.
enddo
use bitmasks
implicit none
BEGIN_DOC
! Min and max values of the integers of the keys of the reference
END_DOC
integer :: i, j, ispin
integer(bit_kind) :: key
integer*1 :: key_short(bit_kind)
equivalence (key,key_short)
integer :: idx, k
key_pattern_not_in_ref = .True.
do j=1,N_det
do ispin=1,2
do i=1,N_int
key = psi_det(i,ispin,j)
do k=1,bit_kind
key_pattern_not_in_ref( key_short(k), i, ispin ) = .False.
enddo
enddo
enddo
enddo
enddo
END_PROVIDER

3
src/Dets/filter_connected.irp.f
View File

@ -95,6 +95,7 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
integer :: degree_x2
ASSERT (Nint > 0)
ASSERT (Nint == N_int)
ASSERT (sze > 0)
l=1
@ -118,8 +119,8 @@ subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
!DIR$ LOOP COUNT (1000)
do i=1,sze
degree_x2 = popcnt(xor( key1(1,1,i), key2(1,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2))) + &
popcnt(xor( key1(2,1,i), key2(2,1))) + &
popcnt(xor( key1(1,2,i), key2(1,2))) + &
popcnt(xor( key1(2,2,i), key2(2,2)))
if (degree_x2 < 5) then
if(degree_x2 .ne. 0)then

10
src/Dets/slater_rules.irp.f
View File

@ -492,9 +492,9 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
use bitmasks
implicit none
integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate
integer, intent(in) :: keys(Nint,2,Ndet_max)
integer(bit_kind), intent(in) :: keys(Nint,2,Ndet)
integer(bit_kind), intent(in) :: key(Nint,2)
double precision, intent(in) :: coef(Ndet_max,Nstate)
integer, intent(in) :: key(Nint,2)
double precision, intent(out) :: i_H_psi_array(Nstate)
integer :: i, ii,j
@ -503,6 +503,11 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
double precision :: hij
integer :: idx(0:Ndet)
ASSERT (Nint > 0)
ASSERT (N_int == Nint)
ASSERT (Nstate > 0)
ASSERT (Ndet > 0)
ASSERT (Ndet_max >= Ndet)
i_H_psi_array = 0.d0
call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx)
do ii=1,idx(0)
@ -512,6 +517,7 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
do j = 1, Nstate
i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij
enddo
print *, 'x', coef(i,1), hij, i_H_psi_array(1)
enddo
end

43
src/Hartree_Fock/README.rst
View File

@ -21,19 +21,19 @@ Documentation
.. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file.
`fock_matrix_alpha_ao <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L/BEGIN_PROVIDER [ double precision, Fock_matrix_alpha_ao, (ao_num_align, ao_num) ]/;">`_
`fock_matrix_alpha_ao <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L83>`_
Alpha Fock matrix in AO basis set
`fock_matrix_alpha_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L/BEGIN_PROVIDER [ double precision, Fock_matrix_alpha_mo, (mo_tot_num_align,mo_tot_num) ]/;">`_
`fock_matrix_alpha_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L172>`_
Fock matrix on the MO basis
`fock_matrix_beta_ao <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L/&BEGIN_PROVIDER [ double precision, Fock_matrix_beta_ao, (ao_num_align, ao_num) ]/;">`_
`fock_matrix_beta_ao <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L84>`_
Alpha Fock matrix in AO basis set
`fock_matrix_beta_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L/BEGIN_PROVIDER [ double precision, Fock_matrix_beta_mo, (mo_tot_num_align,mo_tot_num) ]/;">`_
`fock_matrix_beta_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L192>`_
Fock matrix on the MO basis
`fock_matrix_diag_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L/&BEGIN_PROVIDER [ double precision, Fock_matrix_diag_mo, (mo_tot_num)]/;">`_
`fock_matrix_diag_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L2>`_
Fock matrix on the MO basis.
For open shells, the ROHF Fock Matrix is
.br
@ -48,7 +48,7 @@ Documentation
K = Fb - Fa
.br
`fock_matrix_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L/BEGIN_PROVIDER [ double precision, Fock_matrix_mo, (mo_tot_num_align,mo_tot_num) ]/;">`_
`fock_matrix_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L1>`_
Fock matrix on the MO basis.
For open shells, the ROHF Fock Matrix is
.br
@ -63,46 +63,49 @@ Documentation
K = Fb - Fa
.br
`hf_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L/BEGIN_PROVIDER [ double precision, HF_energy ]/;">`_
`hf_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/Fock_matrix.irp.f#L211>`_
Hartree-Fock energy
`hf_density_matrix_ao <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/HF_density_matrix_ao.irp.f#L/BEGIN_PROVIDER [ double precision, HF_density_matrix_ao, (ao_num_align,ao_num) ]/;">`_
`hf_density_matrix_ao <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/HF_density_matrix_ao.irp.f#L46>`_
Density matrix in the AO basis
`hf_density_matrix_ao_alpha <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/HF_density_matrix_ao.irp.f#L/BEGIN_PROVIDER [ double precision, HF_density_matrix_ao_alpha, (ao_num_align,ao_num) ]/;">`_
`hf_density_matrix_ao_alpha <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/HF_density_matrix_ao.irp.f#L1>`_
Alpha and Beta density matrix in the AO basis
`hf_density_matrix_ao_beta <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/HF_density_matrix_ao.irp.f#L/&BEGIN_PROVIDER [ double precision, HF_density_matrix_ao_beta, (ao_num_align,ao_num) ]/;">`_
`hf_density_matrix_ao_beta <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/HF_density_matrix_ao.irp.f#L2>`_
Alpha and Beta density matrix in the AO basis
`diagonal_fock_matrix_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/diagonalize_fock.irp.f#L/BEGIN_PROVIDER [ double precision, diagonal_Fock_matrix_mo, (mo_tot_num) ]/;">`_
`diagonal_fock_matrix_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/diagonalize_fock.irp.f#L1>`_
Diagonal Fock matrix in the MO basis
`eigenvectors_fock_matrix_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/diagonalize_fock.irp.f#L/&BEGIN_PROVIDER [ double precision, eigenvectors_Fock_matrix_mo, (ao_num_align,mo_tot_num) ]/;">`_
`eigenvectors_fock_matrix_mo <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/diagonalize_fock.irp.f#L2>`_
Diagonal Fock matrix in the MO basis
`do_diis <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/options.irp.f#L/BEGIN_PROVIDER [ logical, do_DIIS ]/;">`_
`scf_iteration <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/mo_SCF_iterations.irp.f#L1>`_
Undocumented
`do_diis <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/options.irp.f#L41>`_
If True, compute integrals on the fly
`n_it_scf_max <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/options.irp.f#L/BEGIN_PROVIDER [ integer, n_it_scf_max]/;">`_
`n_it_scf_max <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/options.irp.f#L22>`_
Maximum number of SCF iterations
`thresh_scf <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/options.irp.f#L/BEGIN_PROVIDER [ double precision,thresh_SCF ]/;">`_
`thresh_scf <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/options.irp.f#L1>`_
Threshold on the convergence of the Hartree Fock energy
`bi_elec_ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L/&BEGIN_PROVIDER [ double precision, bi_elec_ref_bitmask_energy ]/;">`_
`bi_elec_ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L5>`_
Energy of the reference bitmask used in Slater rules
`kinetic_ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L/&BEGIN_PROVIDER [ double precision, kinetic_ref_bitmask_energy ]/;">`_
`kinetic_ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L3>`_
Energy of the reference bitmask used in Slater rules
`mono_elec_ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L/&BEGIN_PROVIDER [ double precision, mono_elec_ref_bitmask_energy ]/;">`_
`mono_elec_ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L2>`_
Energy of the reference bitmask used in Slater rules
`nucl_elec_ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L/&BEGIN_PROVIDER [ double precision, nucl_elec_ref_bitmask_energy ]/;">`_
`nucl_elec_ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L4>`_
Energy of the reference bitmask used in Slater rules
`ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L/BEGIN_PROVIDER [ double precision, ref_bitmask_energy ]/;">`_
`ref_bitmask_energy <http://github.com/LCPQ/quantum_package/tree/master/src/Hartree_Fock/ref_bitmask.irp.f#L1>`_
Energy of the reference bitmask used in Slater rules

30
src/Hartree_Fock_AOs/README.rst
View File

@ -1,30 +0,0 @@
===================
Hartree-Fock Module
===================
Needed Modules
==============
.. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file.
* `AOs <http://github.com/LCPQ/quantum_package/tree/master/src/AOs>`_
* `BiInts <http://github.com/LCPQ/quantum_package/tree/master/src/BiInts>`_
* `Bitmask <http://github.com/LCPQ/quantum_package/tree/master/src/Bitmask>`_
* `Electrons <http://github.com/LCPQ/quantum_package/tree/master/src/Electrons>`_
* `Ezfio_files <http://github.com/LCPQ/quantum_package/tree/master/src/Ezfio_files>`_
* `MonoInts <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts>`_
* `MOs <http://github.com/LCPQ/quantum_package/tree/master/src/MOs>`_
* `Nuclei <http://github.com/LCPQ/quantum_package/tree/master/src/Nuclei>`_
* `Output <http://github.com/LCPQ/quantum_package/tree/master/src/Output>`_
* `Utils <http://github.com/LCPQ/quantum_package/tree/master/src/Utils>`_
Documentation
=============
.. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file.

6
src/MOGuess/README.rst
View File

@ -23,7 +23,8 @@ Documentation
.. NEEDED_MODULES file.
`h_core_guess <http://github.com/LCPQ/quantum_package/tree/master/src/MOGuess/H_CORE_guess.irp.f#L1>`_
None
Undocumented
`ao_ortho_lowdin_coef <http://github.com/LCPQ/quantum_package/tree/master/src/MOGuess/mo_ortho_lowdin.irp.f#L2>`_
matrix of the coefficients of the mos generated by the
orthonormalization by the S^{-1/2} canonical transformation of the aos
@ -34,6 +35,7 @@ None
supposed to be the Identity
`ao_ortho_lowdin_nucl_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MOGuess/pot_mo_ortho_lowdin_ints.irp.f#L1>`_
None
Undocumented

170
src/MonoInts/README.rst
View File

@ -17,115 +17,223 @@ Documentation
.. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file.
`ao_mono_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L/BEGIN_PROVIDER [ double precision, ao_mono_elec_integral,(ao_num_align,ao_num)]/;">`_
`ao_mono_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L122>`_
array of the mono electronic hamiltonian on the AOs basis
: sum of the kinetic and nuclear electronic potential
`ao_overlap <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L/BEGIN_PROVIDER [ double precision, ao_overlap,(ao_num_align,ao_num) ]/;">`_
`ao_overlap <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L1>`_
Overlap between atomic basis functions:
:math:`\int \chi_i(r) \chi_j(r) dr)`
`ao_overlap_abs <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L/BEGIN_PROVIDER [ double precision, ao_overlap_abs,(ao_num_align,ao_num) ]/;">`_
`ao_overlap_abs <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L65>`_
Overlap between absolute value of atomic basis functions:
:math:`\int |\chi_i(r)| |\chi_j(r)| dr)`
`ao_overlap_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L/&BEGIN_PROVIDER [ double precision, ao_overlap_x,(ao_num_align,ao_num) ]/;">`_
`ao_overlap_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L2>`_
Overlap between atomic basis functions:
:math:`\int \chi_i(r) \chi_j(r) dr)`
`ao_overlap_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L/&BEGIN_PROVIDER [ double precision, ao_overlap_y,(ao_num_align,ao_num) ]/;">`_
`ao_overlap_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L3>`_
Overlap between atomic basis functions:
:math:`\int \chi_i(r) \chi_j(r) dr)`
`ao_overlap_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L/&BEGIN_PROVIDER [ double precision, ao_overlap_z,(ao_num_align,ao_num) ]/;">`_
`ao_overlap_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/ao_mono_ints.irp.f#L4>`_
Overlap between atomic basis functions:
:math:`\int \chi_i(r) \chi_j(r) dr)`
`check_ortho <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/check_orthonormality.irp.f#L/subroutine check_ortho/;">`_
`check_ortho <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/check_orthonormality.irp.f#L1>`_
Undocumented
`do_print <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/check_orthonormality.irp.f#L/subroutine do_print/;">`_
`do_print <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/check_orthonormality.irp.f#L11>`_
Undocumented
`n_pt_max_i_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/dimensions.irp.f#L/&BEGIN_PROVIDER [ integer, n_pt_max_i_x]/;">`_
`n_pt_max_i_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/dimensions.irp.f#L2>`_
Undocumented
`n_pt_max_integrals <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/dimensions.irp.f#L/BEGIN_PROVIDER [ integer, n_pt_max_integrals ]/;">`_
`n_pt_max_integrals <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/dimensions.irp.f#L1>`_
Undocumented
`ao_deriv2_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_ao_ints.irp.f#L/BEGIN_PROVIDER [ double precision, ao_deriv2_x,(ao_num_align,ao_num) ]/;">`_
`ao_deriv2_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_ao_ints.irp.f#L1>`_
second derivatives matrix elements in the ao basis
.. math::
.br
{\tt ao_deriv2_x} = \langle \chi_i(x,y,z) \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
`ao_deriv2_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_ao_ints.irp.f#L/&BEGIN_PROVIDER [ double precision, ao_deriv2_y,(ao_num_align,ao_num) ]/;">`_
`ao_deriv2_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_ao_ints.irp.f#L2>`_
second derivatives matrix elements in the ao basis
.. math::
.br
{\tt ao_deriv2_x} = \langle \chi_i(x,y,z) \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
`ao_deriv2_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_ao_ints.irp.f#L/&BEGIN_PROVIDER [ double precision, ao_deriv2_z,(ao_num_align,ao_num) ]/;">`_
`ao_deriv2_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_ao_ints.irp.f#L3>`_
second derivatives matrix elements in the ao basis
.. math::
.br
{\tt ao_deriv2_x} = \langle \chi_i(x,y,z) \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle
`ao_kinetic_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_ao_ints.irp.f#L/BEGIN_PROVIDER [double precision, ao_kinetic_integral, (ao_num_align,ao_num)]/;">`_
`ao_kinetic_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_ao_ints.irp.f#L126>`_
array of the priminitve basis kinetic integrals
\langle \chi_i |\hat{T}| \chi_j \rangle
`mo_kinetic_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_mo_ints.irp.f#L/BEGIN_PROVIDER [double precision, mo_kinetic_integral, (mo_tot_num_align,mo_tot_num)]/;">`_
`mo_kinetic_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/kin_mo_ints.irp.f#L1>`_
Undocumented
`mo_mono_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/mo_mono_ints.irp.f#L/BEGIN_PROVIDER [ double precision, mo_mono_elec_integral,(mo_tot_num_align,mo_tot_num)]/;">`_
`mo_mono_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/mo_mono_ints.irp.f#L35>`_
array of the mono electronic hamiltonian on the MOs basis
: sum of the kinetic and nuclear electronic potential
`mo_overlap <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/mo_mono_ints.irp.f#L/BEGIN_PROVIDER [ double precision, mo_overlap,(mo_tot_num_align,mo_tot_num)]/;">`_
`mo_overlap <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/mo_mono_ints.irp.f#L1>`_
Undocumented
`orthonormalize_mos <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/orthonormalize.irp.f#L/subroutine orthonormalize_mos/;">`_
`orthonormalize_mos <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/orthonormalize.irp.f#L1>`_
Undocumented
`ao_nucl_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/BEGIN_PROVIDER [ double precision, ao_nucl_elec_integral, (ao_num_align,ao_num)]/;">`_
`ao_nucl_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L1>`_
interaction nuclear electron
`give_polynom_mult_center_mono_elec <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/subroutine give_polynom_mult_center_mono_elec(A_center,B_center,alpha,beta,power_A,power_B,C_center,n_pt_in,d,n_pt_out)/;">`_
`give_polynom_mult_center_mono_elec <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L157>`_
Undocumented
`i_x1_pol_mult_mono_elec <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/recursive subroutine I_x1_pol_mult_mono_elec(a,c,R1x,R1xp,R2x,d,nd,n_pt_in)/;">`_
`i_x1_pol_mult_mono_elec <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L285>`_
Undocumented
`i_x2_pol_mult_mono_elec <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/recursive subroutine I_x2_pol_mult_mono_elec(c,R1x,R1xp,R2x,d,nd,dim)/;">`_
`i_x2_pol_mult_mono_elec <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L357>`_
Undocumented
`int_gaus_pol <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/double precision function int_gaus_pol(alpha,n)/;">`_
`int_gaus_pol <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L428>`_
Undocumented
`nai_pol_mult <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/double precision function NAI_pol_mult(A_center,B_center,power_A,power_B,alpha,beta,C_center,n_pt_in)/;">`_
`nai_pol_mult <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L82>`_
Undocumented
`v_e_n <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/double precision function V_e_n(a_x,a_y,a_z,b_x,b_y,b_z,alpha,beta)/;">`_
`v_e_n <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L409>`_
Undocumented
`v_phi <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/double precision function V_phi(n,m)/;">`_
`v_phi <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L473>`_
Undocumented
`v_r <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/double precision function V_r(n,alpha)/;">`_
`v_r <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L457>`_
Undocumented
`v_theta <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/double precision function V_theta(n,m)/;">`_
`v_theta <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L486>`_
Undocumented
`wallis <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L/double precision function Wallis(n)/;">`_
`wallis <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_ao_ints.irp.f#L502>`_
Undocumented
`mo_nucl_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_mo_ints.irp.f#L/BEGIN_PROVIDER [double precision, mo_nucl_elec_integral, (mo_tot_num_align,mo_tot_num)]/;">`_
`mo_nucl_elec_integral <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/pot_mo_ints.irp.f#L1>`_
Undocumented
`save_ortho_mos <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/save_ortho_mos.irp.f#L/subroutine save_ortho_mos/;">`_
`save_ortho_mos <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/save_ortho_mos.irp.f#L1>`_
Undocumented
`ao_deriv_1_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L148>`_
array of the integrals of AO_i * d/dx AO_j
array of the integrals of AO_i * d/dy AO_j
array of the integrals of AO_i * d/dz AO_j
`ao_deriv_1_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L149>`_
array of the integrals of AO_i * d/dx AO_j
array of the integrals of AO_i * d/dy AO_j
array of the integrals of AO_i * d/dz AO_j
`ao_deriv_1_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L150>`_
array of the integrals of AO_i * d/dx AO_j
array of the integrals of AO_i * d/dy AO_j
array of the integrals of AO_i * d/dz AO_j
`ao_dipole_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L75>`_
array of the integrals of AO_i * x AO_j
array of the integrals of AO_i * y AO_j
array of the integrals of AO_i * z AO_j
`ao_dipole_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L76>`_
array of the integrals of AO_i * x AO_j
array of the integrals of AO_i * y AO_j
array of the integrals of AO_i * z AO_j
`ao_dipole_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L77>`_
array of the integrals of AO_i * x AO_j
array of the integrals of AO_i * y AO_j
array of the integrals of AO_i * z AO_j
`ao_spread_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L1>`_
array of the integrals of AO_i * x^2 AO_j
array of the integrals of AO_i * y^2 AO_j
array of the integrals of AO_i * z^2 AO_j
`ao_spread_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L2>`_
array of the integrals of AO_i * x^2 AO_j
array of the integrals of AO_i * y^2 AO_j
array of the integrals of AO_i * z^2 AO_j
`ao_spread_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L3>`_
array of the integrals of AO_i * x^2 AO_j
array of the integrals of AO_i * y^2 AO_j
array of the integrals of AO_i * z^2 AO_j
`overlap_bourrin_deriv_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L359>`_
Undocumented
`overlap_bourrin_dipole <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L318>`_
Undocumented
`overlap_bourrin_spread <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L265>`_
Undocumented
`overlap_bourrin_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L374>`_
Undocumented
`overlap_bourrin_x_abs <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L226>`_
Undocumented
`power <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_ao.irp.f#L310>`_
Undocumented
`mo_deriv_1_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L69>`_
array of the integrals of MO_i * d/dx MO_j
array of the integrals of MO_i * d/dy MO_j
array of the integrals of MO_i * d/dz MO_j
`mo_deriv_1_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L70>`_
array of the integrals of MO_i * d/dx MO_j
array of the integrals of MO_i * d/dy MO_j
array of the integrals of MO_i * d/dz MO_j
`mo_deriv_1_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L71>`_
array of the integrals of MO_i * d/dx MO_j
array of the integrals of MO_i * d/dy MO_j
array of the integrals of MO_i * d/dz MO_j
`mo_dipole_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L1>`_
array of the integrals of MO_i * x MO_j
array of the integrals of MO_i * y MO_j
array of the integrals of MO_i * z MO_j
`mo_dipole_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L2>`_
array of the integrals of MO_i * x MO_j
array of the integrals of MO_i * y MO_j
array of the integrals of MO_i * z MO_j
`mo_dipole_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L3>`_
array of the integrals of MO_i * x MO_j
array of the integrals of MO_i * y MO_j
array of the integrals of MO_i * z MO_j
`mo_spread_x <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L36>`_
array of the integrals of MO_i * x^2 MO_j
array of the integrals of MO_i * y^2 MO_j
array of the integrals of MO_i * z^2 MO_j
`mo_spread_y <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L37>`_
array of the integrals of MO_i * x^2 MO_j
array of the integrals of MO_i * y^2 MO_j
array of the integrals of MO_i * z^2 MO_j
`mo_spread_z <http://github.com/LCPQ/quantum_package/tree/master/src/MonoInts/spread_dipole_mo.irp.f#L38>`_
array of the integrals of MO_i * x^2 MO_j
array of the integrals of MO_i * y^2 MO_j
array of the integrals of MO_i * z^2 MO_j

2
src/NEEDED_MODULES
View File

@ -1 +1 @@
AOs Bitmask Electrons Ezfio_files MOs Nuclei Output Utils Hartree_Fock BiInts MonoInts MOGuess Dets DensityMatrix CISD Perturbation
AOs Bitmask Electrons Ezfio_files MOs Nuclei Output Utils Hartree_Fock BiInts MonoInts MOGuess Dets DensityMatrix CISD Perturbation Selection

6
src/Perturbation/ASSUMPTIONS.rst Normal file
View File

@ -0,0 +1,6 @@
* This is not allowed:
subroutine &
pt2_....

8
src/Perturbation/Makefile Normal file
View File

@ -0,0 +1,8 @@
default: all
# Define here all new external source files and objects.Don't forget to prefix the
# object files with IRPF90_temp/
SRC=perturbation_template.f
OBJ=
include $(QPACKAGE_ROOT)/src/Makefile.common

1
src/Perturbation/NEEDED_MODULES Normal file
View File

@ -0,0 +1 @@
AOs BiInts Bitmask Dets Electrons Ezfio_files Hartree_Fock MonoInts MOs Nuclei Output Utils

20
src/Perturbation/README.rst
View File

@ -82,6 +82,26 @@ Documentation
.. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file.
`pt2_epstein_nesbet <http://github.com/LCPQ/quantum_package/tree/master/src/Perturbation/epstein_nesbet.irp.f#L1>`_
compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
.br
for the various n_st states.
.br
c_pert(i) = <psi(i)|H|det_pert>/( E(i) - <det_pert|H|det_pert> )
.br
e_2_pert(i) = <psi(i)|H|det_pert>^2/( E(i) - <det_pert|H|det_pert> )
.br
`pt2_epstein_nesbet_2x2 <http://github.com/LCPQ/quantum_package/tree/master/src/Perturbation/epstein_nesbet.irp.f#L33>`_
compute the Epstein-Nesbet 2x2 diagonalization coefficient and energetic contribution
.br
for the various n_st states.
.br
e_2_pert(i) = 0.5 * (( <det_pert|H|det_pert> - E(i) ) - sqrt( ( <det_pert|H|det_pert> - E(i)) ^2 + 4 <psi(i)|H|det_pert>^2 )
.br
c_pert(i) = e_2_pert(i)/ <psi(i)|H|det_pert>
.br
Needed Modules

68
src/Perturbation/epstein_nesbet.irp.f Normal file
View File

@ -0,0 +1,68 @@
subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st)
use bitmasks
implicit none
integer, intent(in) :: Nint,ndet,n_st
integer(bit_kind), intent(in) :: det_pert(Nint,2)
double precision , intent(out) :: c_pert(n_st),e_2_pert(n_st),H_pert_diag
double precision :: i_H_psi_array(N_st)
BEGIN_DOC
! compute the standard Epstein-Nesbet perturbative first order coefficient and second order energetic contribution
!
! for the various n_st states.
!
! c_pert(i) = <psi(i)|H|det_pert>/( E(i) - <det_pert|H|det_pert> )
!
! e_2_pert(i) = <psi(i)|H|det_pert>^2/( E(i) - <det_pert|H|det_pert> )
!
END_DOC
integer :: i,j
double precision :: diag_H_mat_elem
ASSERT (Nint == N_int)
ASSERT (Nint > 0)
call i_H_psi(det_pert,psi_ref,psi_ref_coef,Nint,ndet,psi_ref_size,n_st,i_H_psi_array)
H_pert_diag = diag_H_mat_elem(det_pert,Nint)
do i =1,n_st
c_pert(i) = i_H_psi_array(i) / (reference_energy(i) - H_pert_diag)
e_2_pert(i) = c_pert(i) * i_H_psi_array(i)
enddo
end
subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,n_st)
use bitmasks
implicit none
integer, intent(in) :: Nint,ndet,n_st
integer(bit_kind), intent(in) :: det_pert(Nint,2)
double precision , intent(out) :: c_pert(n_st),e_2_pert(n_st),H_pert_diag
double precision :: i_H_psi_array(N_st)
BEGIN_DOC
! compute the Epstein-Nesbet 2x2 diagonalization coefficient and energetic contribution
!
! for the various n_st states.
!
! e_2_pert(i) = 0.5 * (( <det_pert|H|det_pert> - E(i) ) - sqrt( ( <det_pert|H|det_pert> - E(i)) ^2 + 4 <psi(i)|H|det_pert>^2 )
!
! c_pert(i) = e_2_pert(i)/ <psi(i)|H|det_pert>
!
END_DOC
integer :: i,j
double precision :: diag_H_mat_elem,delta_e
ASSERT (Nint == N_int)
ASSERT (Nint > 0)
print *, 'coefs'
print *, psi_ref_coef(1:N_det_ref,1)
print *, '-----'
call i_H_psi(det_pert,psi_ref,psi_ref_coef,Nint,N_det_ref,psi_ref_size,n_st,i_H_psi_array)
H_pert_diag = diag_H_mat_elem(det_pert,Nint)
do i =1,n_st
delta_e = H_pert_diag - reference_energy(i)
e_2_pert(i) = 0.5d0 * (delta_e - dsqrt(delta_e * delta_e + 4.d0 * i_H_psi_array(i) * i_H_psi_array(i)))
c_pert(i) = e_2_pert(i)/i_H_psi_array(i)
enddo
print *, e_2_pert, delta_e , i_H_psi_array
end

47
src/Perturbation/perturbation_template.f Normal file
View File

@ -0,0 +1,47 @@
BEGIN_SHELL [ /usr/bin/env python ]
import perturbation
END_SHELL
subroutine perturb_buffer_$PERT(buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint)
implicit none
BEGIN_DOC
! Applly pertubration ``$PERT`` to the buffer of determinants generated in the H_apply
! routine.
END_DOC
integer, intent(in) :: Nint, N_st, buffer_size
integer(bit_kind), intent(in) :: buffer(Nint,2,buffer_size)
double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(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
integer :: i,k, c_ref
integer :: connected_to_ref
ASSERT (Nint > 0)
ASSERT (Nint == N_int)
ASSERT (buffer_size >= 0)
ASSERT (minval(sum_norm_pert) >= 0.d0)
ASSERT (N_st > 0)
do i = 1,buffer_size
c_ref = connected_to_ref(buffer(1,1,i),psi_det,Nint,N_det_ref,N_det,h_apply_threshold)
if (c_ref /= 0) then
cycle
endif
call pt2_$PERT(buffer(1,1,i), &
c_pert,e_2_pert,H_pert_diag,Nint,n_det_ref,n_st)
do k = 1,N_st
e_2_pert_buffer(k,i) = e_2_pert(k)
coef_pert_buffer(k,i) = c_pert(k)
sum_norm_pert(k) += c_pert(k) * c_pert(k)
sum_e_2_pert(k) += e_2_pert(k)
sum_H_pert_diag(k) += c_pert(k) * c_pert(k) * H_pert_diag
enddo
enddo
end

1
src/Utils/LinearAlgebra.irp.f
View File

@ -76,6 +76,7 @@ subroutine ortho_lowdin(overlap,LDA,N,C,LDC,m)
!$OMP END DO NOWAIT
enddo
!$OMP BARRIER
!$OMP DO
do j=1,n
do i=1,m