LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-23 04:43:50 +01:00
Code Issues Releases Wiki Activity

enforced electron pair ban

Browse Source
This commit is contained in:
Yann Garniron 2016-09-08 15:22:09 +02:00
parent 741b5deaba
commit 90b84581b0
4 changed files with 127 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
plugins/Full_CI_ZMQ/fci_zmq.irp.f
View File

@ -79,15 +79,6 @@ program fci_zmq
endif endif
E_CI_before = CI_energy E_CI_before = CI_energy
call ezfio_set_full_ci_energy(CI_energy) call ezfio_set_full_ci_energy(CI_energy)
print *, N_det , N_det_max,maxval(abs(pt2(1:N_st))), pt2_max
do i=1, N_det
call assert(popcnt(psi_det_sorted(1,2,i)) == 9, "nelec...")
call assert(popcnt(psi_det_sorted(1,1,i)) == 9, "nelec...")
!call debug_det(psi_det_sorted(1,1,i), N_int)
do j=1,i-1
call assert(.not. detEq(psi_det_sorted(1,1,i), psi_det_sorted(1,1,j), N_int), "OOQSDSD")
end do
end do
enddo enddo
N_det = min(N_det_max,N_det) N_det = min(N_det_max,N_det)
touch N_det psi_det psi_coef touch N_det psi_det psi_coef

30
plugins/Full_CI_ZMQ/selection.irp.f
View File

@ -1,18 +1,28 @@
use bitmasks use bitmasks
BEGIN_PROVIDER [ double precision, integral8, (mo_tot_num, mo_tot_num, mo_tot_num, mo_tot_num) ] ! BEGIN_PROVIDER [ double precision, integral8, (mo_tot_num, mo_tot_num, mo_tot_num, mo_tot_num) ]
use bitmasks ! use bitmasks
! implicit none
!
! integer :: h1, h2
!
! integral8 = 0d0
! do h1=1, mo_tot_num
! do h2=1, mo_tot_num
! call get_mo_bielec_integrals_ij(h1, h2 ,mo_tot_num,integral8(1,1,h1,h2),mo_integrals_map)
! end do
! end do
! END_PROVIDER
double precision function integral8(i,j,k,l)
implicit none implicit none
integer :: h1, h2 integer, intent(in) :: i,j,k,l
double precision, external :: get_mo_bielec_integral
integral8 = 0d0 integral8 = get_mo_bielec_integral(i,j,k,l,mo_integrals_map)
do h1=1, mo_tot_num end function
do h2=1, mo_tot_num
call get_mo_bielec_integrals_ij(h1, h2 ,mo_tot_num,integral8(1,1,h1,h2),mo_integrals_map)
end do
end do
END_PROVIDER
BEGIN_PROVIDER [ integer(bit_kind), psi_phasemask, (N_int, 2, N_det)] BEGIN_PROVIDER [ integer(bit_kind), psi_phasemask, (N_int, 2, N_det)]

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

@ -44,7 +44,7 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
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) !call assert(ok, irp_here)
logical :: banned(mo_tot_num, mo_tot_num) logical :: banned(mo_tot_num, mo_tot_num,2)
logical :: bannedOrb(mo_tot_num, 2) logical :: bannedOrb(mo_tot_num, 2)
banned = .false. banned = .false.
@ -121,13 +121,13 @@ subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_d
endif endif
pt2(1) += e_pert pt2(1) += e_pert
if(dabs(e_pert) > buf%mini) then if(dabs(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"
print *, i_generator, s1, s2, h1, h2,p1,p2 ! print *, i_generator, s1, s2, h1, h2,p1,p2
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, e_pert)
end if end if
end do end do
@ -141,13 +141,15 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat)
integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel) integer(bit_kind),intent(in) :: mask(N_int, 2), det(N_int, 2, N_sel)
integer, intent(in) :: sp, i_gen, N_sel integer, intent(in) :: sp, i_gen, N_sel
logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) logical, intent(inout) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num, 2)
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
integer :: i, j, h(0:2,2), p(0:4,2), nt integer :: i, j, k, l, h(0:2,2), p(0:4,2), nt
integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2) integer(bit_kind) :: perMask(N_int, 2), mobMask(N_int, 2), negMask(N_int, 2)
logical :: bandon
mat = 0d0 mat = 0d0
bandon = .false.
do i=1,N_int do i=1,N_int
negMask(i,1) = not(mask(i,1)) negMask(i,1) = not(mask(i,1))
@ -181,6 +183,18 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat)
if(nt == 3) call past_d1(bannedOrb, p) if(nt == 3) call past_d1(bannedOrb, p)
!call assert(nt /= 2, "should have been discarded") !call assert(nt /= 2, "should have been discarded")
else else
if(i == i_gen) then
bandon = .true.
if(sp == 3) then
banned(:,:,2) = transpose(banned(:,:,1))
else
do k=1,mo_tot_num
do l=k+1,mo_tot_num
banned(l,k,1) = banned(k,l,1)
end do
end do
end if
end if
if(nt == 4) then if(nt == 4) then
call get_d2(det(1,1,i), psi_phasemask(1,1,i), bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, i)) call get_d2(det(1,1,i), psi_phasemask(1,1,i), bannedOrb, banned, mat, mask, h, p, sp, psi_selectors_coef_transp(1, i))
else if(nt == 3) then else if(nt == 3) then
@ -190,6 +204,7 @@ subroutine splash_pq(mask, sp, det, i_gen, N_sel, bannedOrb, banned, mat)
end if end if
end if end if
end do end do
call assert(bandon, "BANDON")
end subroutine end subroutine
@ -198,12 +213,12 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
implicit none implicit none
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2), phasemask(N_int, 2) integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2), phasemask(N_int, 2)
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
double precision, intent(in) :: coefs(N_states) double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
integer, intent(in) :: h(0:2,2), p(0:4,2), sp integer, intent(in) :: h(0:2,2), p(0:4,2), sp
double precision, external :: get_phase_bi double precision, external :: get_phase_bi, integral8
integer :: i, j, tip, ma, mi, puti, putj integer :: i, j, tip, ma, mi, puti, putj
integer :: h1, h2, p1, p2, i1, i2 integer :: h1, h2, p1, p2, i1, i2
@ -213,6 +228,8 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
integer, parameter :: turn2(2) = (/2, 1/) integer, parameter :: turn2(2) = (/2, 1/)
integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/))
integer :: bant
bant = 1
tip = p(0,1) * p(0,2) tip = p(0,1) * p(0,2)
!call assert(p(0,1) + p(0,2) == 4, irp_here//"df") !call assert(p(0,1) + p(0,2) == 4, irp_here//"df")
@ -223,6 +240,8 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
!print *, "d2 SPtip", SP, tip !print *, "d2 SPtip", SP, tip
if(sp == 3) then if(sp == 3) then
if(ma == 2) bant = 2
if(tip == 3) then if(tip == 3) then
puti = p(1, mi) puti = p(1, mi)
do i = 1, 3 do i = 1, 3
@ -236,6 +255,7 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
h1 = h(1, ma) h1 = h(1, ma)
h2 = h(2, ma) h2 = h(2, ma)
if(banned(putj,puti,bant)) cycle
hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask, mi, ma, puti, putj) !call debug_hij(hij, gen, mask, mi, ma, puti, putj)
@ -256,6 +276,8 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
h1 = h(1,1) h1 = h(1,1)
h2 = h(1,2) h2 = h(1,2)
if(banned(puti,putj,bant)) cycle
hij = integral8(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2) hij = integral8(p1, p2, h1, h2) * get_phase_bi(phasemask, 1, 2, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask, 1, 2, puti, putj) !call debug_hij(hij, gen, mask, 1, 2, puti, putj)
@ -276,6 +298,9 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
i2 = turn2d(2, i, j) i2 = turn2d(2, i, j)
p1 = p(i1, ma) p1 = p(i1, ma)
p2 = p(i2, ma) p2 = p(i2, ma)
if(banned(puti,putj,1)) cycle
hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2) hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, ma, ma, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask, ma, ma, puti, putj) !call debug_hij(hij, gen, mask, ma, ma, puti, putj)
mat(:, puti, putj) += coefs * hij mat(:, puti, putj) += coefs * hij
@ -290,6 +315,9 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
p2 = p(i, ma) p2 = p(i, ma)
puti = p(turn3(1,i), ma) puti = p(turn3(1,i), ma)
putj = p(turn3(2,i), ma) putj = p(turn3(2,i), ma)
if(banned(puti,putj,1)) cycle
hij = integral8(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2) hij = integral8(p1, p2, h1, h2) * get_phase_bi(phasemask, mi, ma, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask, ma, ma, puti, putj) !call debug_hij(hij, gen, mask, ma, ma, puti, putj)
mat(:, min(puti, putj), max(puti, putj)) += coefs * hij mat(:, min(puti, putj), max(puti, putj)) += coefs * hij
@ -302,11 +330,14 @@ subroutine get_d2(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
p2 = p(2, mi) p2 = p(2, mi)
h1 = h(1, mi) h1 = h(1, mi)
h2 = h(2, mi) h2 = h(2, mi)
if(.not. banned(puti,putj,1)) then
hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2) hij = (integral8(p1, p2, h1, h2) - integral8(p2,p1, h1, h2)) * get_phase_bi(phasemask, mi, mi, h1, p1, h2, p2)
!call debug_hij(hij, gen, mask,ma,ma, puti, putj) !call debug_hij(hij, gen, mask,ma,ma, puti, putj)
mat(:, puti, putj) += coefs * hij mat(:, puti, putj) += coefs * hij
end if end if
end if end if
end if
end subroutine end subroutine
@ -343,12 +374,12 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
implicit none implicit none
integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2), phasemask(N_int, 2) integer(bit_kind), intent(in) :: mask(N_int, 2), gen(N_int, 2), phasemask(N_int, 2)
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
integer(bit_kind) :: det(N_int, 2) integer(bit_kind) :: det(N_int, 2)
double precision, intent(in) :: coefs(N_states) double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
double precision :: hij, tmp_row(N_states, mo_tot_num), tmp_row2(N_states, mo_tot_num) double precision :: hij, tmp_row(N_states, mo_tot_num), tmp_row2(N_states, mo_tot_num)
double precision, external :: get_phase_bi double precision, external :: get_phase_bi, integral8
logical :: lbanned(mo_tot_num, 2), ok logical :: lbanned(mo_tot_num, 2), ok
integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j, hfix, pfix, h1, h2, p1, p2, ib integer :: puti, putj, ma, mi, s1, s2, i, i1, i2, j, hfix, pfix, h1, h2, p1, p2, ib
@ -358,6 +389,8 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
integer, parameter :: turn2(2) = (/2,1/) integer, parameter :: turn2(2) = (/2,1/)
integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) integer, parameter :: turn3(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/))
integer :: bant
lbanned = bannedOrb lbanned = bannedOrb
@ -371,11 +404,14 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
ma = 1 ma = 1
if(p(0,2) >= 2) ma = 2 if(p(0,2) >= 2) ma = 2
mi = turn2(ma) mi = turn2(ma)
bant = 1
!print *, "d1 SP", sp, p(0,1)*p(0,2) !print *, "d1 SP", sp, p(0,1)*p(0,2)
if(sp == 3) then if(sp == 3) then
!move MA !move MA
!call assert(p(0,1)*p(0,2) == 2, "ddmmm") !call assert(p(0,1)*p(0,2) == 2, "ddmmm")
if(ma == 2) bant = 2
puti = p(1,mi) puti = p(1,mi)
hfix = h(1,ma) hfix = h(1,ma)
p1 = p(1,ma) p1 = p(1,ma)
@ -383,13 +419,13 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
if(.not. bannedOrb(puti, mi)) then if(.not. bannedOrb(puti, mi)) then
tmp_row = 0d0 tmp_row = 0d0
do putj=1, hfix-1 do putj=1, hfix-1
if(lbanned(putj, ma)) cycle if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle
hij = (integral8(p1, p2, putj, hfix)-integral8(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) hij = (integral8(p1, p2, putj, hfix)-integral8(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2)
!call debug_hij(hij, gen, mask, mi, ma, puti, putj) !call debug_hij(hij, gen, mask, mi, ma, puti, putj)
tmp_row(:,putj) += hij * coefs tmp_row(:,putj) += hij * coefs
end do end do
do putj=hfix+1, mo_tot_num do putj=hfix+1, mo_tot_num
if(lbanned(putj, ma)) cycle if(lbanned(putj, ma) .or. banned(putj, puti,bant)) cycle
hij = (integral8(p1, p2, hfix, putj)-integral8(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) hij = (integral8(p1, p2, hfix, putj)-integral8(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2)
!call debug_hij(hij, gen, mask, mi, ma, puti, putj) !call debug_hij(hij, gen, mask, mi, ma, puti, putj)
tmp_row(:,putj) += hij * coefs tmp_row(:,putj) += hij * coefs
@ -410,13 +446,18 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
if(lbanned(puti,mi)) cycle if(lbanned(puti,mi)) cycle
!p1 fixed !p1 fixed
putj = p1 putj = p1
if(.not. banned(putj,puti,bant)) then
hij = integral8(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix) hij = integral8(p2,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p2, puti, pfix)
!call debug_hij(hij, gen, mask, mi, ma, puti, putj)
tmp_row(:,puti) += hij * coefs tmp_row(:,puti) += hij * coefs
end if
!call debug_hij(hij, gen, mask, mi, ma, puti, putj)
putj = p2 putj = p2
if(.not. banned(putj,puti,bant)) then
hij = integral8(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix) hij = integral8(p1,pfix,hfix,puti) * get_phase_bi(phasemask, ma, mi, hfix, p1, puti, pfix)
!call debug_hij(hij, gen, mask, mi, ma, puti, putj) !call debug_hij(hij, gen, mask, mi, ma, puti, putj)
tmp_row2(:,puti) += hij * coefs tmp_row2(:,puti) += hij * coefs
end if
end do end do
if(mi == 1) then if(mi == 1) then
@ -435,13 +476,13 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
p2 = p(turn3(2,i), ma) p2 = p(turn3(2,i), ma)
tmp_row = 0d0 tmp_row = 0d0
do putj=1,hfix-1 do putj=1,hfix-1
if(lbanned(putj,ma)) cycle if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle
hij = (integral8(p1, p2, putj, hfix)-integral8(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2) hij = (integral8(p1, p2, putj, hfix)-integral8(p2,p1,putj,hfix)) * get_phase_bi(phasemask, ma, ma, putj, p1, hfix, p2)
!call debug_hij(hij, gen, mask, ma, ma, puti, putj) !call debug_hij(hij, gen, mask, ma, ma, puti, putj)
tmp_row(:,putj) += hij * coefs tmp_row(:,putj) += hij * coefs
end do end do
do putj=hfix+1,mo_tot_num do putj=hfix+1,mo_tot_num
if(lbanned(putj,ma)) cycle if(lbanned(putj,ma) .or. banned(puti,putj,1)) cycle
hij = (integral8(p1, p2, hfix, putj)-integral8(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2) hij = (integral8(p1, p2, hfix, putj)-integral8(p2,p1,hfix,putj)) * get_phase_bi(phasemask, ma, ma, hfix, p1, putj, p2)
!call debug_hij(hij, gen, mask, ma, ma, puti, putj) !call debug_hij(hij, gen, mask, ma, ma, puti, putj)
tmp_row(:,putj) += hij * coefs tmp_row(:,putj) += hij * coefs
@ -461,14 +502,18 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
do puti=1,mo_tot_num do puti=1,mo_tot_num
if(lbanned(puti,ma)) cycle if(lbanned(puti,ma)) cycle
putj = p2 putj = p2
if(.not. banned(puti,putj,1)) then
hij = integral8(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1) hij = integral8(pfix, p1, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p1)
!call debug_hij(hij, gen, mask, ma, ma, putj, puti) !call debug_hij(hij, gen, mask, ma, ma, putj, puti)
tmp_row(:,puti) += hij * coefs tmp_row(:,puti) += hij * coefs
end if
putj = p1 putj = p1
if(.not. banned(puti,putj,1)) then
hij = integral8(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2) hij = integral8(pfix, p2, hfix, puti) * get_phase_bi(phasemask, mi, ma, hfix, pfix, puti, p2)
!call debug_hij(hij, gen, mask, ma, ma, putj, puti) !call debug_hij(hij, gen, mask, ma, ma, putj, puti)
tmp_row2(:,puti) += hij * coefs tmp_row2(:,puti) += hij * coefs
end if
end do end do
mat(:,:p2-1,p2) += tmp_row(:,:p2-1) mat(:,:p2-1,p2) += tmp_row(:,:p2-1)
mat(:,p2,p2:) += tmp_row(:,p2:) mat(:,p2,p2:) += tmp_row(:,p2:)
@ -492,7 +537,7 @@ subroutine get_d1(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
do i2=ib,p(0,s2) do i2=ib,p(0,s2)
p1 = p(i1,s1) p1 = p(i1,s1)
p2 = p(i2,s2) p2 = p(i2,s2)
if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2)) cycle if(bannedOrb(p1, s1) .or. bannedOrb(p2, s2) .or. banned(p1, p2, 1)) 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 i_h_j(gen, det, N_int, hij) call i_h_j(gen, det, N_int, hij)
mat(:, p1, p2) += coefs * hij mat(:, p1, p2) += coefs * hij
@ -508,7 +553,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
implicit none implicit none
integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2), phasemask(N_int, 2) integer(bit_kind), intent(in) :: gen(N_int, 2), mask(N_int, 2), phasemask(N_int, 2)
logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num) logical, intent(in) :: bannedOrb(mo_tot_num, 2), banned(mo_tot_num, mo_tot_num,2)
integer(bit_kind) :: det(N_int, 2) integer(bit_kind) :: det(N_int, 2)
double precision, intent(in) :: coefs(N_states) double precision, intent(in) :: coefs(N_states)
double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num) double precision, intent(inout) :: mat(N_states, mo_tot_num, mo_tot_num)
@ -516,9 +561,12 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
integer :: i, j, s, h1, h2, p1, p2, puti, putj integer :: i, j, s, h1, h2, p1, p2, puti, putj
double precision :: hij, phase double precision :: hij, phase
double precision, external :: get_phase_bi double precision, external :: get_phase_bi, integral8
logical :: ok logical :: ok
integer :: bant
bant = 1
!print *, "d0 SP", sp !print *, "d0 SP", sp
if(sp == 3) then ! AB if(sp == 3) then ! AB
@ -528,7 +576,7 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
if(bannedOrb(p1, 1)) cycle if(bannedOrb(p1, 1)) cycle
do p2=1, mo_tot_num do p2=1, mo_tot_num
if(bannedOrb(p2,2)) cycle if(bannedOrb(p2,2)) cycle
if(banned(p1, p2)) cycle ! rentable? if(banned(p1, p2, bant)) cycle ! rentable?
if(p1 == h1 .or. p2 == h2) then if(p1 == h1 .or. p2 == h2) then
call apply_particles(mask, 1,p1,2,p2, det, ok, N_int) call apply_particles(mask, 1,p1,2,p2, det, ok, N_int)
!call assert(ok, "zsdq") !call assert(ok, "zsdq")
@ -549,10 +597,9 @@ subroutine get_d0(gen, phasemask, bannedOrb, banned, mat, mask, h, p, sp, coefs)
if(bannedOrb(puti, sp)) cycle if(bannedOrb(puti, sp)) cycle
do putj=puti+1, mo_tot_num do putj=puti+1, mo_tot_num
if(bannedOrb(putj, sp)) cycle if(bannedOrb(putj, sp)) cycle
if(banned(puti, putj)) cycle ! rentable? if(banned(puti, putj, bant)) cycle ! rentable?
if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then if(puti == p1 .or. putj == p2 .or. puti == p2 .or. putj == p1) then
call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int) call apply_particles(mask, sp,puti,sp,putj, det, ok, N_int)
call ASSERT(ok, "ssss")
call i_h_j(gen, det, N_int, hij) call i_h_j(gen, det, N_int, hij)
mat(:, puti, putj) += coefs * hij mat(:, puti, putj) += coefs * hij
else else

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

@ -160,7 +160,7 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2) integer, intent(in) :: sp, h(0:2, 2), p(0:3, 2)
integer :: i, j, h1, h2, p1, p2, sfix, hfix, pfix, hmob, pmob, puti integer :: i, j, h1, h2, p1, p2, sfix, hfix, pfix, hmob, pmob, puti
double precision :: hij double precision :: hij
double precision, external :: get_phase_bi double precision, external :: get_phase_bi, integral8
integer, parameter :: turn3_2(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/)) integer, parameter :: turn3_2(2,3) = reshape((/2,3, 1,3, 1,2/), (/2,3/))
integer, parameter :: turn2(2) = (/2,1/) integer, parameter :: turn2(2) = (/2,1/)
@ -170,6 +170,7 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
h2 = h(2, sp) h2 = h(2, sp)
do i=1,3 do i=1,3
puti = p(i, sp) puti = p(i, sp)
if(bannedOrb(puti)) cycle
p1 = p(turn3_2(1,i), sp) p1 = p(turn3_2(1,i), sp)
p2 = p(turn3_2(2,i), sp) p2 = p(turn3_2(2,i), sp)
hij = integral8(p1, p2, h1, h2) - integral8(p2, p1, h1, h2) hij = integral8(p1, p2, h1, h2) - integral8(p2, p1, h1, h2)
@ -184,6 +185,7 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
hmob = h(1,sp) hmob = h(1,sp)
do j=1,2 do j=1,2
puti = p(j, sp) puti = p(j, sp)
if(bannedOrb(puti)) cycle
pmob = p(turn2(j), sp) pmob = p(turn2(j), sp)
hij = integral8(pfix, pmob, hfix, hmob) hij = integral8(pfix, pmob, hfix, hmob)
hij *= get_phase_bi(phasemask, sp, sfix, hmob, pmob, hfix, pfix) hij *= get_phase_bi(phasemask, sp, sfix, hmob, pmob, hfix, pfix)
@ -192,6 +194,7 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
end do end do
else else
puti = p(1,sp) puti = p(1,sp)
if(.not. bannedOrb(puti)) then
sfix = turn2(sp) sfix = turn2(sp)
p1 = p(1,sfix) p1 = p(1,sfix)
p2 = p(2,sfix) p2 = p(2,sfix)
@ -202,6 +205,7 @@ subroutine get_m2(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
!call debug_hij_mo(hij, gen, mask, sp, puti) !call debug_hij_mo(hij, gen, mask, sp, puti)
vect(:, puti) += hij * coefs vect(:, puti) += hij * coefs
end if end if
end if
end subroutine end subroutine
@ -219,7 +223,7 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
logical :: ok, lbanned(mo_tot_num) logical :: ok, lbanned(mo_tot_num)
integer(bit_kind) :: det(N_int, 2) integer(bit_kind) :: det(N_int, 2)
double precision :: hij double precision :: hij
double precision, external :: get_phase_bi double precision, external :: get_phase_bi, integral8
lbanned = bannedOrb lbanned = bannedOrb
sh = 1 sh = 1
@ -246,7 +250,7 @@ subroutine get_m1(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
if(lbanned(i)) cycle if(lbanned(i)) cycle
hij = (integral8(p1, p2, hole, i) - integral8(p2, p1, hole, i)) hij = (integral8(p1, p2, hole, i) - integral8(p2, p1, hole, i))
hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2) hij *= get_phase_bi(phasemask, sp, sp, hole, p1, i, p2)
call debug_hij_mo(hij, gen, mask, sp, i) !call debug_hij_mo(hij, gen, mask, sp, i)
vect(:,i) += hij * coefs vect(:,i) += hij * coefs
end do end do