LCPQ/qp2
9
1
Fork 0
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-06-29 15:54:42 +02:00
Code Releases Activity

Optimized phasemask

Browse Source
This commit is contained in:
Anthony Scemama 2021-03-26 01:04:23 +01:00
parent d217a6b9f1
commit d79724b7e7
1 changed files with 56 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
src/cipsi/selection.irp.f
View File

@ -8,27 +8,56 @@ subroutine get_mask_phase(det1, pm, Nint)
integer(bit_kind), intent(out) :: pm(Nint,2) integer(bit_kind), intent(out) :: pm(Nint,2)
integer(bit_kind) :: tmp1, tmp2 integer(bit_kind) :: tmp1, tmp2
integer :: i integer :: i
pm(1:Nint,1:2) = det1(1:Nint,1:2)
tmp1 = 0_8 tmp1 = 0_8
tmp2 = 0_8 tmp2 = 0_8
do i=1,Nint select case (Nint)
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 1))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 1)) BEGIN_TEMPLATE
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2)) case ($Nint)
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2)) do i=1,$Nint
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4)) pm(i,1) = ieor(det1(i,1), shiftl(det1(i,1), 1))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4)) pm(i,2) = ieor(det1(i,2), shiftl(det1(i,2), 1))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8)) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8)) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16)) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16)) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32)) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32)) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8))
pm(i,1) = ieor(pm(i,1), tmp1) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16))
pm(i,2) = ieor(pm(i,2), tmp2) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16))
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1) pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32))
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2) pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32))
end do pm(i,1) = ieor(pm(i,1), tmp1)
pm(i,2) = ieor(pm(i,2), tmp2)
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1)
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2)
end do
SUBST [ Nint ]
1;;
2;;
3;;
4;;
END_TEMPLATE
case default
do i=1,Nint
pm(i,1) = ieor(det1(i,1), shiftl(det1(i,1), 1))
pm(i,2) = ieor(det1(i,2), shiftl(det1(i,2), 1))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 2))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 4))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 4))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 8))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 8))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 16))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 16))
pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 32))
pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 32))
pm(i,1) = ieor(pm(i,1), tmp1)
pm(i,2) = ieor(pm(i,2), tmp2)
if(iand(popcnt(det1(i,1)), 1) == 1) tmp1 = not(tmp1)
if(iand(popcnt(det1(i,2)), 1) == 1) tmp2 = not(tmp2)
end do
end select
end subroutine end subroutine
@ -445,11 +474,17 @@ subroutine select_singles_and_doubles(i_generator,hole_mask,particle_mask,fock_d
endif endif
do i=1,fullinteresting(0) do i=1,fullinteresting(0)
fullminilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,fullinteresting(i)) do k=1,N_int
fullminilist(k,1,i) = psi_det_sorted(k,1,fullinteresting(i))
fullminilist(k,2,i) = psi_det_sorted(k,2,fullinteresting(i))
enddo
enddo enddo
do i=1,interesting(0) do i=1,interesting(0)
minilist(1:N_int,1:2,i) = psi_det_sorted(1:N_int,1:2,interesting(i)) do k=1,N_int
minilist(k,1,i) = psi_det_sorted(k,1,interesting(i))
minilist(k,2,i) = psi_det_sorted(k,2,interesting(i))
enddo
enddo enddo
do s2=s1,2 do s2=s1,2