mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-22 20:35:19 +01:00
fixed fragmentation
This commit is contained in:
parent
28f1c57697
commit
4908a68983
@ -261,16 +261,12 @@ subroutine get_m0(gen, phasemask, bannedOrb, vect, mask, h, p, sp, coefs)
|
||||
end do
|
||||
end subroutine
|
||||
|
||||
|
||||
! Selection double
|
||||
! ----------------
|
||||
|
||||
subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf)
|
||||
subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,pt2,buf,subset)
|
||||
use bitmasks
|
||||
use selection_types
|
||||
implicit none
|
||||
|
||||
integer, intent(in) :: i_generator
|
||||
integer, intent(in) :: i_generator, subset
|
||||
integer(bit_kind), intent(in) :: hole_mask(N_int,2), particle_mask(N_int,2)
|
||||
double precision, intent(in) :: fock_diag_tmp(mo_tot_num)
|
||||
double precision, intent(in) :: E0(N_states)
|
||||
@ -287,6 +283,8 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
||||
integer(bit_kind), allocatable :: minilist(:, :, :), fullminilist(:, :, :)
|
||||
|
||||
logical :: monoAdo, monoBdo;
|
||||
integer :: maskInd
|
||||
maskInd = -1
|
||||
|
||||
monoAdo = .true.
|
||||
monoBdo = .true.
|
||||
@ -339,6 +337,19 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
||||
|
||||
do s1=1,2
|
||||
do i1=N_holes(s1),1,-1 ! Generate low excitations first
|
||||
!if(subset /= 0 .and. mod(maskInd, 10) /= (subset-1)) then
|
||||
! maskInd += 1
|
||||
! cycle
|
||||
!end if
|
||||
maskInd += 1
|
||||
|
||||
|
||||
|
||||
|
||||
if(subset == 0 .or. mod(maskInd, 8) == (subset-1)) then
|
||||
|
||||
|
||||
|
||||
h1 = hole_list(i1,s1)
|
||||
call apply_hole(psi_det_generators(1,1,i_generator), s1,h1, pmask, ok, N_int)
|
||||
|
||||
@ -387,27 +398,30 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
||||
end if
|
||||
end do
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
end if
|
||||
|
||||
|
||||
|
||||
do s2=s1,2
|
||||
sp = s1
|
||||
|
||||
if(s1 /= s2) sp = 3
|
||||
|
||||
ib = 1
|
||||
if(s1 == s2) ib = i1+1
|
||||
monoAdo = .true.
|
||||
do i2=N_holes(s2),ib,-1 ! Generate low excitations first
|
||||
|
||||
h2 = hole_list(i2,s2)
|
||||
call apply_hole(pmask, s2,h2, mask, ok, N_int)
|
||||
|
||||
logical :: banned(mo_tot_num, mo_tot_num,2)
|
||||
logical :: bannedOrb(mo_tot_num, 2)
|
||||
|
||||
if(subset == 0 .or. mod(maskInd, 8) == (subset-1)) then
|
||||
h2 = hole_list(i2,s2)
|
||||
call apply_hole(pmask, s2,h2, mask, ok, N_int)
|
||||
banned = .false.
|
||||
|
||||
call spot_isinwf(mask, fullminilist, i_generator, fullinteresting(0), banned, fullMatch, fullinteresting)
|
||||
|
||||
if(fullMatch) cycle
|
||||
|
||||
bannedOrb(1:mo_tot_num, 1:2) = .true.
|
||||
do s3=1,2
|
||||
do i=1,N_particles(s3)
|
||||
@ -426,9 +440,14 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
||||
end if
|
||||
|
||||
|
||||
call spot_isinwf(mask, fullminilist, i_generator, fullinteresting(0), banned, fullMatch, fullinteresting)
|
||||
if(fullMatch) cycle
|
||||
|
||||
mat = 0d0
|
||||
call splash_pq(mask, sp, minilist, i_generator, interesting(0), bannedOrb, banned, mat, interesting)
|
||||
|
||||
call fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf)
|
||||
end if
|
||||
enddo
|
||||
if(s1 /= s2) monoBdo = .false.
|
||||
enddo
|
||||
@ -437,6 +456,7 @@ subroutine select_doubles(i_generator,hole_mask,particle_mask,fock_diag_tmp,E0,p
|
||||
end subroutine
|
||||
|
||||
|
||||
|
||||
subroutine fill_buffer_double(i_generator, sp, h1, h2, bannedOrb, banned, fock_diag_tmp, E0, pt2, mat, buf)
|
||||
use bitmasks
|
||||
use selection_types
|
||||
|
Loading…
Reference in New Issue
Block a user