LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-11-18 12:03:57 +01:00
Code Issues Releases Wiki Activity

fci_zmq with N_states > 1

Browse Source
This commit is contained in:
Yann Garniron 2016-10-03 14:30:13 +02:00
parent 521c37add9
commit 74ffa71dc6
2 changed files with 35 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
plugins/Full_CI_ZMQ/selection_double.irp.f
View File

@ -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 do istate=1,N_states
delta_E = E0(istate) - Hii
if (delta_E < 0.d0) then 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)
else 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)
endif endif
pt2(1) += e_pert pt2(istate) += e_pert
if(dabs(e_pert) > buf%mini) then 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

16
plugins/Full_CI_ZMQ/selection_single.irp.f
View File

@ -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
delta_E = E0(istate) - Hii
if (delta_E < 0.d0) then 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)
else 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)
endif endif
pt2(1) += e_pert pt2(istate) += e_pert
if(dabs(e_pert) > buf%mini) call add_to_selection_buffer(buf, det, 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