10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-22 20:35:19 +01:00

Fixed selection

This commit is contained in:
Anthony Scemama 2017-05-19 14:38:48 +02:00
parent c518bcff0e
commit 0de5cafcc0

View File

@ -306,6 +306,9 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
logical :: monoAdo, monoBdo logical :: monoAdo, monoBdo
integer :: maskInd integer :: maskInd
integer(bit_kind), allocatable:: preinteresting_det(:,:,:)
allocate (preinteresting_det(N_int,2,N_det))
PROVIDE fragment_count PROVIDE fragment_count
monoAdo = .true. monoAdo = .true.
@ -410,6 +413,10 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
if(i <= N_det_selectors) then if(i <= N_det_selectors) then
preinteresting(0) += 1 preinteresting(0) += 1
preinteresting(preinteresting(0)) = i preinteresting(preinteresting(0)) = i
do j=1,N_int
preinteresting_det(j,1,preinteresting(0)) = psi_det_sorted(j,1,i)
preinteresting_det(j,2,preinteresting(0)) = psi_det_sorted(j,2,i)
enddo
else if(nt <= 2) then else if(nt <= 2) then
prefullinteresting(0) += 1 prefullinteresting(0) += 1
prefullinteresting(prefullinteresting(0)) = i prefullinteresting(prefullinteresting(0)) = i
@ -436,35 +443,36 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
do ii=1,preinteresting(0) do ii=1,preinteresting(0)
i = preinteresting(ii) i = preinteresting(ii)
mobMask(1,1) = iand(negMask(1,1), psi_det_sorted(1,1,preinteresting(ii))) mobMask(1,1) = iand(negMask(1,1), preinteresting_det(1,1,ii))
mobMask(1,2) = iand(negMask(1,2), psi_det_sorted(1,2,preinteresting(ii))) mobMask(1,2) = iand(negMask(1,2), preinteresting_det(1,2,ii))
nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2)) nt = popcnt(mobMask(1, 1)) + popcnt(mobMask(1, 2))
do j=2,N_int do j=2,N_int
mobMask(j,1) = iand(negMask(j,1), psi_det_sorted(1,1,preinteresting(ii))) mobMask(j,1) = iand(negMask(j,1), preinteresting_det(j,1,ii))
mobMask(j,2) = iand(negMask(j,2), psi_det_sorted(1,2,preinteresting(ii))) mobMask(j,2) = iand(negMask(j,2), preinteresting_det(j,2,ii))
nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2)) nt = nt+ popcnt(mobMask(j, 1)) + popcnt(mobMask(j, 2))
end do end do
if(nt <= 4) then if(nt <= 4) then
interesting(0) += 1 interesting(0) += 1
interesting(interesting(0)) = i interesting(interesting(0)) = i
minilist(1,1,interesting(0)) = psi_det_sorted(1,1,preinteresting(ii)) minilist(1,1,interesting(0)) = preinteresting_det(1,1,ii)
minilist(1,2,interesting(0)) = psi_det_sorted(1,2,preinteresting(ii)) minilist(1,2,interesting(0)) = preinteresting_det(1,2,ii)
do j=2,N_int do j=2,N_int
minilist(j,1,interesting(0)) = psi_det_sorted(1,1,preinteresting(ii)) minilist(j,1,interesting(0)) = preinteresting_det(j,1,ii)
minilist(j,2,interesting(0)) = psi_det_sorted(1,2,preinteresting(ii)) minilist(j,2,interesting(0)) = preinteresting_det(j,2,ii)
enddo enddo
if(nt <= 2) then if(nt <= 2) then
fullinteresting(0) += 1 fullinteresting(0) += 1
fullinteresting(fullinteresting(0)) = i fullinteresting(fullinteresting(0)) = i
fullminilist(1,1,fullinteresting(0)) = psi_det_sorted(1,1,preinteresting(ii)) fullminilist(1,1,fullinteresting(0)) = preinteresting_det(1,1,ii)
fullminilist(1,2,fullinteresting(0)) = psi_det_sorted(1,2,preinteresting(ii)) fullminilist(1,2,fullinteresting(0)) = preinteresting_det(1,2,ii)
do j=2,N_int do j=2,N_int
fullminilist(j,1,fullinteresting(0)) = psi_det_sorted(1,1,preinteresting(ii)) fullminilist(j,1,fullinteresting(0)) = preinteresting_det(j,1,ii)
fullminilist(j,2,fullinteresting(0)) = psi_det_sorted(1,2,preinteresting(ii)) fullminilist(j,2,fullinteresting(0)) = preinteresting_det(j,2,ii)
enddo enddo
end if end if
end if end if
end do end do
do ii=1,prefullinteresting(0) do ii=1,prefullinteresting(0)