mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
fci_zmq with N_states > 1
This commit is contained in:
parent
521c37add9
commit
74ffa71dc6
@ -31,7 +31,6 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
|||||||
call bitstring_to_list_ab(particle, particle_list, N_particles, N_int)
|
call bitstring_to_list_ab(particle, particle_list, N_particles, N_int)
|
||||||
|
|
||||||
|
|
||||||
!call assert(psi_det_generators(1,1,i_generator) == psi_det_sorted(1,1,i_generator), "sorted selex")
|
|
||||||
do s1=1,2
|
do s1=1,2
|
||||||
do s2=s1,2
|
do s2=s1,2
|
||||||
sp = s1
|
sp = s1
|
||||||
@ -43,7 +42,6 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
|||||||
h1 = hole_list(i1,s1)
|
h1 = hole_list(i1,s1)
|
||||||
h2 = hole_list(i2,s2)
|
h2 = hole_list(i2,s2)
|
||||||
call apply_holes(psi_det_generators(1,1,i_generator), s1,h1,s2,h2, mask, ok, N_int)
|
call apply_holes(psi_det_generators(1,1,i_generator), s1,h1,s2,h2, mask, ok, N_int)
|
||||||
!call assert(ok, irp_here)
|
|
||||||
|
|
||||||
logical :: banned(mo_tot_num, mo_tot_num,2)
|
logical :: banned(mo_tot_num, mo_tot_num,2)
|
||||||
logical :: bannedOrb(mo_tot_num, 2)
|
logical :: bannedOrb(mo_tot_num, 2)
|
||||||
@ -88,14 +86,13 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
double precision, intent(inout) :: pt2(N_states)
|
double precision, intent(inout) :: pt2(N_states)
|
||||||
type(selection_buffer), intent(inout) :: buf
|
type(selection_buffer), intent(inout) :: buf
|
||||||
logical :: ok
|
logical :: ok
|
||||||
integer :: s1, s2, p1, p2, ib, j
|
integer :: s1, s2, p1, p2, ib, j, istate
|
||||||
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
||||||
double precision :: e_pert, delta_E, val, Hii
|
double precision :: e_pert, delta_E, val, Hii, max_e_pert
|
||||||
double precision, external :: diag_H_mat_elem_fock
|
double precision, external :: diag_H_mat_elem_fock
|
||||||
|
|
||||||
logical, external :: detEq
|
logical, external :: detEq
|
||||||
|
|
||||||
if(N_states > 1) stop "fill_buffer_double N_states > 1"
|
|
||||||
|
|
||||||
if(sp == 3) then
|
if(sp == 3) then
|
||||||
s1 = 1
|
s1 = 1
|
||||||
@ -106,7 +103,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
end if
|
end if
|
||||||
|
|
||||||
call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int)
|
call apply_holes(psi_det_generators(1,1,i_generator), s1, h1, s2, h2, mask, ok, N_int)
|
||||||
!call assert(ok, "sosoqs")
|
|
||||||
do p1=1,mo_tot_num
|
do p1=1,mo_tot_num
|
||||||
if(bannedOrb(p1, s1)) cycle
|
if(bannedOrb(p1, s1)) cycle
|
||||||
ib = 1
|
ib = 1
|
||||||
@ -116,19 +113,24 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
if(banned(p1,p2)) cycle
|
if(banned(p1,p2)) cycle
|
||||||
if(mat(1, p1, p2) == 0d0) cycle
|
if(mat(1, p1, p2) == 0d0) cycle
|
||||||
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
call apply_particles(mask, s1, p1, s2, p2, det, ok, N_int)
|
||||||
!call assert(ok, "ododod")
|
|
||||||
val = mat(1, p1, p2)
|
val = mat(1, p1, p2)
|
||||||
|
|
||||||
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
||||||
|
max_e_pert = 0d0
|
||||||
delta_E = E0(1) - Hii
|
|
||||||
if (delta_E < 0.d0) then
|
do istate=1,N_states
|
||||||
e_pert = 0.5d0 * (-dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
delta_E = E0(istate) - Hii
|
||||||
else
|
if (delta_E < 0.d0) then
|
||||||
e_pert = 0.5d0 * ( dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
e_pert = 0.5d0 * (-dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
||||||
endif
|
else
|
||||||
pt2(1) += e_pert
|
e_pert = 0.5d0 * ( dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
||||||
if(dabs(e_pert) > buf%mini) then
|
endif
|
||||||
|
pt2(istate) += e_pert
|
||||||
|
if(dabs(e_pert) > dabs(max_e_pert)) max_e_pert = e_pert
|
||||||
|
end do
|
||||||
|
|
||||||
|
if(dabs(max_e_pert) > buf%mini) then
|
||||||
! do j=1,buf%cur-1
|
! do j=1,buf%cur-1
|
||||||
! if(detEq(buf%det(1,1,j), det, N_int)) then
|
! if(detEq(buf%det(1,1,j), det, N_int)) then
|
||||||
! print *, "tops"
|
! print *, "tops"
|
||||||
@ -136,7 +138,7 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
|
|||||||
! stop
|
! stop
|
||||||
! end if
|
! end if
|
||||||
! end do
|
! end do
|
||||||
call add_to_selection_buffer(buf, det, e_pert)
|
call add_to_selection_buffer(buf, det, max_e_pert)
|
||||||
end if
|
end if
|
||||||
end do
|
end do
|
||||||
end do
|
end do
|
||||||
|
@ -72,12 +72,11 @@ subroutine fill_buffer_single(i_generator, sp, h1, bannedOrb, fock_diag_tmp, E0,
|
|||||||
double precision, intent(inout) :: pt2(N_states)
|
double precision, intent(inout) :: pt2(N_states)
|
||||||
type(selection_buffer), intent(inout) :: buf
|
type(selection_buffer), intent(inout) :: buf
|
||||||
logical :: ok
|
logical :: ok
|
||||||
integer :: s1, s2, p1, p2, ib
|
integer :: s1, s2, p1, p2, ib, istate
|
||||||
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
integer(bit_kind) :: mask(N_int, 2), det(N_int, 2)
|
||||||
double precision :: e_pert, delta_E, val, Hii
|
double precision :: e_pert, delta_E, val, Hii, max_e_pert
|
||||||
double precision, external :: diag_H_mat_elem_fock
|
double precision, external :: diag_H_mat_elem_fock
|
||||||
|
|
||||||
if(N_states > 1) stop "fill_buffer_single N_states > 1"
|
|
||||||
|
|
||||||
call apply_hole(psi_det_generators(1,1,i_generator), sp, h1, mask, ok, N_int)
|
call apply_hole(psi_det_generators(1,1,i_generator), sp, h1, mask, ok, N_int)
|
||||||
|
|
||||||
@ -88,15 +87,20 @@ subroutine fill_buffer_single(i_generator, sp, h1, bannedOrb, fock_diag_tmp, E0,
|
|||||||
val = vect(1, p1)
|
val = vect(1, p1)
|
||||||
|
|
||||||
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
Hii = diag_H_mat_elem_fock(psi_det_generators(1,1,i_generator),det,fock_diag_tmp,N_int)
|
||||||
|
max_e_pert = 0d0
|
||||||
|
|
||||||
delta_E = E0(1) - Hii
|
do istate=1,N_states
|
||||||
if (delta_E < 0.d0) then
|
delta_E = E0(istate) - Hii
|
||||||
e_pert = 0.5d0 * (-dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
if (delta_E < 0.d0) then
|
||||||
else
|
e_pert = 0.5d0 * (-dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
||||||
e_pert = 0.5d0 * ( dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
else
|
||||||
endif
|
e_pert = 0.5d0 * ( dsqrt(delta_E * delta_E + 4.d0 * val * val) - delta_E)
|
||||||
pt2(1) += e_pert
|
endif
|
||||||
if(dabs(e_pert) > buf%mini) call add_to_selection_buffer(buf, det, e_pert)
|
pt2(istate) += e_pert
|
||||||
|
if(dabs(e_pert) > dabs(max_e_pert)) max_e_pert = e_pert
|
||||||
|
end do
|
||||||
|
|
||||||
|
if(dabs(max_e_pert) > buf%mini) call add_to_selection_buffer(buf, det, max_e_pert)
|
||||||
end do
|
end do
|
||||||
end subroutine
|
end subroutine
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user