10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-07-05 10:55:59 +02:00

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

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

View File

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

View File

@ -10,7 +10,8 @@ subroutine
parameters parameters
initialization initialization
declarations declarations
keys_work keys_work_locked
keys_work_unlocked
finalization finalization
""".split() """.split()
@ -24,7 +25,10 @@ class H_apply(object):
self.openmp = openmp self.openmp = openmp
if openmp: if openmp:
s["subroutine"] += "_OpenMP" s["subroutine"] += "_OpenMP"
self.selection_pt2 = None
self.perturbation = None self.perturbation = None
#s["omp_parallel"] = """!$OMP PARALLEL DEFAULT(NONE) & #s["omp_parallel"] = """!$OMP PARALLEL DEFAULT(NONE) &
s["omp_parallel"] = """!$OMP PARALLEL DEFAULT(SHARED) & s["omp_parallel"] = """!$OMP PARALLEL DEFAULT(SHARED) &
!$OMP PRIVATE(i,j,k,l,keys_out,hole,particle, & !$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 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_1,N_elec_in_key_part_2, &
!$OMP N_elec_in_key_hole_2,ia_ja_pairs) & !$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 hole_1, particl_1, hole_2, particl_2, &
!$OMP lck,thresh,elec_alpha_num)""" !$OMP lck,thresh,elec_alpha_num)"""
s["omp_init_lock"] = "call omp_init_lock(lck)" s["omp_init_lock"] = "call omp_init_lock(lck)"
@ -72,6 +76,8 @@ class H_apply(object):
return buffer return buffer
def set_perturbation(self,pert): def set_perturbation(self,pert):
if self.perturbation is not None:
raise
self.perturbation = pert self.perturbation = pert
if pert is not None: 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" 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_e_2_pert(N_st)
double precision :: sum_norm_pert(N_st) double precision :: sum_norm_pert(N_st)
double precision :: sum_H_pert_diag 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["size_max"] = "256"
self.data["initialization"] = """ self.data["initialization"] = """
E_ref = diag_H_mat_elem(key_in,N_int)
sum_e_2_pert = sum_e_2_pert_in sum_e_2_pert = sum_e_2_pert_in
sum_norm_pert = sum_norm_pert_in sum_norm_pert = sum_norm_pert_in
sum_H_pert_diag = sum_H_pert_diag_in sum_H_pert_diag = sum_H_pert_diag_in
""" """
self.data["keys_work"] += """ self.data["keys_work_unlocked"] += """
call perturb_buffer_%s(keys_out,key_idx,sum_e_2_pert, & 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) sum_norm_pert,sum_H_pert_diag,N_st,Nint)
"""%(pert,) """%(pert,)
self.data["finalization"] = """ self.data["finalization"] = """
@ -101,10 +108,29 @@ class H_apply(object):
sum_H_pert_diag_in = sum_H_pert_diag sum_H_pert_diag_in = sum_H_pert_diag
""" """
if self.openmp: if self.openmp:
self.data["omp_set_lock"] = ""
self.data["omp_unset_lock"] = ""
self.data["omp_test_lock"] = ".False." self.data["omp_test_lock"] = ".False."
self.data["omp_parallel"] += """& 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)""" !$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)"

View File

@ -33,11 +33,12 @@ subroutine resize_H_apply_buffer_det(new_size)
integer, intent(in) :: new_size integer, intent(in) :: new_size
integer(bit_kind), allocatable :: buffer_det(:,:,:) integer(bit_kind), allocatable :: buffer_det(:,:,:)
double precision, allocatable :: buffer_coef(:,:) double precision, allocatable :: buffer_coef(:,:)
double precision, allocatable :: buffer_e2(:,:)
integer :: i,j,k integer :: i,j,k
integer :: Ndet integer :: Ndet
ASSERT (new_size > 0) 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 i=1,min(new_size,H_apply_buffer_N_det)
do k=1,N_int 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 ) ASSERT (sum(popcnt(H_apply_buffer_det(:,2,i))) == elec_beta_num )
enddo enddo
do k=1,N_states do k=1,N_states
do i=1,min(new_size,H_apply_buffer_N_det) do i=1,min(new_size,H_apply_buffer_N_det)
buffer_coef(i,k) = H_apply_buffer_coef(i,k) buffer_coef(i,k) = H_apply_buffer_coef(i,k)
enddo buffer_e2(i,k) = H_apply_buffer_e2(i,k)
enddo
enddo enddo
H_apply_buffer_size = new_size H_apply_buffer_size = new_size
@ -70,20 +72,23 @@ subroutine resize_H_apply_buffer_det(new_size)
do k=1,N_states do k=1,N_states
do i=1,H_apply_buffer_N_det do i=1,H_apply_buffer_N_det
H_apply_buffer_coef(i,k) = buffer_coef(i,k) H_apply_buffer_coef(i,k) = buffer_coef(i,k)
H_apply_buffer_e2(i,k) = buffer_e2(i,k)
enddo enddo
enddo enddo
deallocate (buffer_det, buffer_coef) deallocate (buffer_det, buffer_coef, buffer_e2)
SOFT_TOUCH H_apply_buffer_det H_apply_buffer_coef H_apply_buffer_N_det SOFT_TOUCH H_apply_buffer_det H_apply_buffer_coef H_apply_buffer_N_det H_apply_buffer_e2
end end
BEGIN_PROVIDER [ integer(bit_kind), H_apply_buffer_det,(N_int,2,H_apply_buffer_size) ] 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_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 ] &BEGIN_PROVIDER [ integer, H_apply_buffer_N_det ]
implicit none implicit none
BEGIN_DOC 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 END_DOC
H_apply_buffer_N_det = 0 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) psi_coef(i+N_det_old,k) = H_apply_buffer_coef(i,k)
enddo enddo
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 end

View File

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

View File

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

View File

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

View File

@ -492,9 +492,9 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array)
use bitmasks use bitmasks
implicit none implicit none
integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate 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) double precision, intent(in) :: coef(Ndet_max,Nstate)
integer, intent(in) :: key(Nint,2)
double precision, intent(out) :: i_H_psi_array(Nstate) double precision, intent(out) :: i_H_psi_array(Nstate)
integer :: i, ii,j 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 double precision :: hij
integer :: idx(0:Ndet) 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 i_H_psi_array = 0.d0
call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx) call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx)
do ii=1,idx(0) 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 do j = 1, Nstate
i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij
enddo enddo
print *, 'x', coef(i,1), hij, i_H_psi_array(1)
enddo enddo
end end

View File

@ -21,19 +21,19 @@ Documentation
.. Do not edit this section. It was auto-generated from the .. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file. .. 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 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 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 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 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. Fock matrix on the MO basis.
For open shells, the ROHF Fock Matrix is For open shells, the ROHF Fock Matrix is
.br .br
@ -48,7 +48,7 @@ Documentation
K = Fb - Fa K = Fb - Fa
.br .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. Fock matrix on the MO basis.
For open shells, the ROHF Fock Matrix is For open shells, the ROHF Fock Matrix is
.br .br
@ -63,46 +63,49 @@ Documentation
K = Fb - Fa K = Fb - Fa
.br .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 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 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 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 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 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 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 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 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 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 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 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 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 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 Energy of the reference bitmask used in Slater rules

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.

View File

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

View File

@ -17,115 +17,223 @@ Documentation
.. Do not edit this section. It was auto-generated from the .. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file. .. 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 array of the mono electronic hamiltonian on the AOs basis
: sum of the kinetic and nuclear electronic potential : 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: Overlap between atomic basis functions:
:math:`\int \chi_i(r) \chi_j(r) dr)` :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: Overlap between absolute value of atomic basis functions:
:math:`\int |\chi_i(r)| |\chi_j(r)| dr)` :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: Overlap between atomic basis functions:
:math:`\int \chi_i(r) \chi_j(r) dr)` :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: Overlap between atomic basis functions:
:math:`\int \chi_i(r) \chi_j(r) dr)` :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: Overlap between atomic basis functions:
:math:`\int \chi_i(r) \chi_j(r) dr)` :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 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 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 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 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 second derivatives matrix elements in the ao basis
.. math:: .. math::
.br .br
{\tt ao_deriv2_x} = \langle \chi_i(x,y,z) \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle {\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 second derivatives matrix elements in the ao basis
.. math:: .. math::
.br .br
{\tt ao_deriv2_x} = \langle \chi_i(x,y,z) \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle {\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 second derivatives matrix elements in the ao basis
.. math:: .. math::
.br .br
{\tt ao_deriv2_x} = \langle \chi_i(x,y,z) \frac{\partial^2}{\partial x^2} |\chi_j (x,y,z) \rangle {\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 array of the priminitve basis kinetic integrals
\langle \chi_i |\hat{T}| \chi_j \rangle \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 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 array of the mono electronic hamiltonian on the MOs basis
: sum of the kinetic and nuclear electronic potential : 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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 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

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

View File

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

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

View File

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

View File

@ -82,6 +82,26 @@ Documentation
.. Do not edit this section. It was auto-generated from the .. Do not edit this section. It was auto-generated from the
.. NEEDED_MODULES file. .. 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 Needed Modules

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

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

View File

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