mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-06-26 15:12:19 +02:00
Guarded trailz with IRP_IF
This commit is contained in:
parent
46d9f3c847
commit
e2565bab76
|
|
@ -97,7 +97,11 @@ subroutine configuration_to_dets(o,d,sze,n_alpha,Nint)
|
|||
do while(v /= 0_bit_kind)
|
||||
n = n+1
|
||||
iint(n) = i
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
ipos(n) = popcnt(ieor(v,v-1))-1
|
||||
IRP_ELSE
|
||||
ipos(n) = trailz(v)
|
||||
IRP_ENDIF
|
||||
v = iand(v,v-1)
|
||||
enddo
|
||||
n_alpha_in_single = n_alpha_in_single - popcnt( o(i,2) )
|
||||
|
|
@ -130,7 +134,11 @@ subroutine configuration_to_dets(o,d,sze,n_alpha,Nint)
|
|||
v_prev = v
|
||||
t = ior(v,v-1)
|
||||
tt = t+1
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
v = ior(tt, shiftr( and(not(t),tt) - 1, popcnt(ieor(v,v-1))) )
|
||||
IRP_ELSE
|
||||
v = ior(tt, shiftr( and(not(t),tt) - 1, trailz(v)+1) )
|
||||
IRP_ENDIF
|
||||
|
||||
! Find what has changed between v_prev and v
|
||||
diff = ieor(v,v_prev)
|
||||
|
|
@ -141,7 +149,11 @@ subroutine configuration_to_dets(o,d,sze,n_alpha,Nint)
|
|||
|
||||
! Swap bits only where they have changed from v_prev to v
|
||||
do while (diff /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
k = popcnt(ieor(diff,diff-1))
|
||||
IRP_ELSE
|
||||
k = trailz(diff)+1
|
||||
IRP_ENDIF
|
||||
if (btest(v,k-1)) then
|
||||
d(iint(k),1,i) = ibset( d(iint(k),1,i), ipos(k) )
|
||||
d(iint(k),2,i) = ibclr( d(iint(k),2,i), ipos(k) )
|
||||
|
|
@ -165,7 +177,11 @@ subroutine configuration_to_dets(o,d,sze,n_alpha,Nint)
|
|||
v_prev = v
|
||||
t = ior(v,v-1)
|
||||
tt = t+1
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
v = ior(tt, shiftr( and(not(t),tt) - 1, popcnt(ieor(v,v-1))) )
|
||||
IRP_ELSE
|
||||
v = ior(tt, shiftr( and(not(t),tt) - 1, trailz(v)+1) )
|
||||
IRP_ENDIF
|
||||
|
||||
! Find what has changed between v_prev and v
|
||||
diff = ieor(v,v_prev)
|
||||
|
|
@ -176,7 +192,11 @@ subroutine configuration_to_dets(o,d,sze,n_alpha,Nint)
|
|||
|
||||
! Swap bits only where they have changed from v_prev to v
|
||||
do while (diff /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
k = popcnt(ieor(diff,diff-1))
|
||||
IRP_ELSE
|
||||
k = trailz(diff)+1
|
||||
IRP_ENDIF
|
||||
if (btest(v,k-1)) then
|
||||
d(iint(k),1,i) = ibset( d(iint(k),1,i), ipos(k) )
|
||||
d(iint(k),2,i) = ibclr( d(iint(k),2,i), ipos(k) )
|
||||
|
|
@ -235,7 +255,11 @@ subroutine configuration_to_dets_tree_addressing(o,d,sze,n_alpha,Nint)
|
|||
do while(v /= 0_bit_kind)
|
||||
n = n+1
|
||||
iint(n) = i
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
ipos(n) = popcnt(ieor(v,v-1))-1
|
||||
IRP_ELSE
|
||||
ipos(n) = trailz(v)
|
||||
IRP_ENDIF
|
||||
v = iand(v,v-1)
|
||||
enddo
|
||||
n_alpha_in_single = n_alpha_in_single - popcnt( o(i,2) )
|
||||
|
|
@ -268,7 +292,11 @@ subroutine configuration_to_dets_tree_addressing(o,d,sze,n_alpha,Nint)
|
|||
v_prev = v
|
||||
t = ior(v,v-1)
|
||||
tt = t+1
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
v = ior(tt, shiftr( and(not(t),tt) - 1, popcnt(ieor(v,v-1))) )
|
||||
IRP_ELSE
|
||||
v = ior(tt, shiftr( and(not(t),tt) - 1, trailz(v)+1) )
|
||||
IRP_ENDIF
|
||||
|
||||
! Find what has changed between v_prev and v
|
||||
diff = ieor(v,v_prev)
|
||||
|
|
@ -279,7 +307,11 @@ subroutine configuration_to_dets_tree_addressing(o,d,sze,n_alpha,Nint)
|
|||
|
||||
! Swap bits only where they have changed from v_prev to v
|
||||
do while (diff /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
k = popcnt(ieor(diff,diff-1))
|
||||
IRP_ELSE
|
||||
k = trailz(diff)+1
|
||||
IRP_ENDIF
|
||||
if (btest(v,k-1)) then
|
||||
d(iint(k),1,i) = ibset( d(iint(k),1,i), ipos(k) )
|
||||
d(iint(k),2,i) = ibclr( d(iint(k),2,i), ipos(k) )
|
||||
|
|
@ -303,7 +335,11 @@ subroutine configuration_to_dets_tree_addressing(o,d,sze,n_alpha,Nint)
|
|||
v_prev = v
|
||||
t = ior(v,v-1)
|
||||
tt = t+1
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
v = ior(tt, shiftr( and(not(t),tt) - 1, popcnt(ieor(v,v-1))) )
|
||||
IRP_ELSE
|
||||
v = ior(tt, shiftr( and(not(t),tt) - 1, trailz(v)+1) )
|
||||
IRP_ENDIF
|
||||
|
||||
! Find what has changed between v_prev and v
|
||||
diff = ieor(v,v_prev)
|
||||
|
|
@ -314,7 +350,11 @@ subroutine configuration_to_dets_tree_addressing(o,d,sze,n_alpha,Nint)
|
|||
|
||||
! Swap bits only where they have changed from v_prev to v
|
||||
do while (diff /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
k = popcnt(ieor(diff,diff-1))
|
||||
IRP_ELSE
|
||||
k = trailz(diff)+1
|
||||
IRP_ENDIF
|
||||
if (btest(v,k-1)) then
|
||||
d(iint(k),1,i) = ibset( d(iint(k),1,i), ipos(k) )
|
||||
d(iint(k),2,i) = ibclr( d(iint(k),2,i), ipos(k) )
|
||||
|
|
|
|||
|
|
@ -98,7 +98,11 @@ subroutine get_phase_qp_to_cfg(Ialpha, Ibeta, phaseout)
|
|||
|
||||
do while(detb(k) /= 0_bit_kind)
|
||||
! Find the lowest beta electron and clear it
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
ipos = popcnt(ieor(detb(k),detb(k)-1))-1
|
||||
IRP_ELSE
|
||||
ipos = trailz(detb(k))
|
||||
IRP_ENDIF
|
||||
detb(k) = ibclr(detb(k),ipos)
|
||||
|
||||
! Create a mask will all MOs higher than the beta electron
|
||||
|
|
|
|||
|
|
@ -206,7 +206,11 @@ subroutine get_double_excitation(det1,det2,exc,phase,Nint)
|
|||
particle = iand(tmp, det2(l,ispin))
|
||||
hole = iand(tmp, det1(l,ispin))
|
||||
do while (particle /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
tz = popcnt(ieor(particle,particle-1))-1
|
||||
IRP_ELSE
|
||||
tz = trailz(particle)
|
||||
IRP_ENDIF
|
||||
idx_particle = idx_particle + 1
|
||||
exc(0,2,ispin) = exc(0,2,ispin) + 1
|
||||
exc(idx_particle,2,ispin) = tz+ishift
|
||||
|
|
@ -216,7 +220,11 @@ subroutine get_double_excitation(det1,det2,exc,phase,Nint)
|
|||
exit
|
||||
endif
|
||||
do while (hole /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
tz = popcnt(ieor(hole,hole-1))-1
|
||||
IRP_ELSE
|
||||
tz = trailz(hole)
|
||||
IRP_ENDIF
|
||||
idx_hole = idx_hole + 1
|
||||
exc(0,1,ispin) = exc(0,1,ispin) + 1
|
||||
exc(idx_hole,1,ispin) = tz+ishift
|
||||
|
|
@ -373,12 +381,20 @@ subroutine get_single_excitation(det1,det2,exc,phase,Nint)
|
|||
particle = iand(tmp, det2(l,ispin))
|
||||
hole = iand(tmp, det1(l,ispin))
|
||||
if (particle /= 0_bit_kind) then
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
tz = popcnt(ieor(particle,particle-1))-1
|
||||
IRP_ELSE
|
||||
tz = trailz(particle)
|
||||
IRP_ENDIF
|
||||
exc(0,2,ispin) = 1
|
||||
exc(1,2,ispin) = tz+ishift
|
||||
endif
|
||||
if (hole /= 0_bit_kind) then
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
tz = popcnt(ieor(hole,hole-1))-1
|
||||
IRP_ELSE
|
||||
tz = trailz(hole)
|
||||
IRP_ENDIF
|
||||
exc(0,1,ispin) = 1
|
||||
exc(1,1,ispin) = tz+ishift
|
||||
endif
|
||||
|
|
@ -445,14 +461,22 @@ subroutine bitstring_to_list_ab( string, list, n_elements, Nint)
|
|||
do i=1,Nint
|
||||
l = string(i,1)
|
||||
do while (l /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
j = popcnt(ieor(l,l-1))-1
|
||||
IRP_ELSE
|
||||
j = trailz(l)
|
||||
IRP_ENDIF
|
||||
n_elements(1) = n_elements(1)+1
|
||||
l = ibclr(l,j)
|
||||
list(n_elements(1),1) = ishift+j
|
||||
enddo
|
||||
l = string(i,2)
|
||||
do while (l /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
j = popcnt(ieor(l,l-1))-1
|
||||
IRP_ELSE
|
||||
j = trailz(l)
|
||||
IRP_ENDIF
|
||||
n_elements(2) = n_elements(2)+1
|
||||
l = ibclr(l,j)
|
||||
list(n_elements(2),2) = ishift+j
|
||||
|
|
@ -2006,7 +2030,11 @@ subroutine get_double_excitation_spin(det1,det2,exc,phase,Nint)
|
|||
particle = iand(tmp, det2(l))
|
||||
hole = iand(tmp, det1(l))
|
||||
do while (particle /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
tz = popcnt(ieor(particle,particle-1))-1
|
||||
IRP_ELSE
|
||||
tz = trailz(particle)
|
||||
IRP_ENDIF
|
||||
idx_particle = idx_particle + 1
|
||||
exc(0,2) = exc(0,2) + 1
|
||||
exc(idx_particle,2) = tz+ishift
|
||||
|
|
@ -2016,7 +2044,11 @@ subroutine get_double_excitation_spin(det1,det2,exc,phase,Nint)
|
|||
exit
|
||||
endif
|
||||
do while (hole /= 0_bit_kind)
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
tz = popcnt(ieor(hole,hole-1))-1
|
||||
IRP_ELSE
|
||||
tz = trailz(hole)
|
||||
IRP_ENDIF
|
||||
idx_hole = idx_hole + 1
|
||||
exc(0,1) = exc(0,1) + 1
|
||||
exc(idx_hole,1) = tz+ishift
|
||||
|
|
@ -2133,12 +2165,20 @@ subroutine get_single_excitation_spin(det1,det2,exc,phase,Nint)
|
|||
particle = iand(tmp, det2(l))
|
||||
hole = iand(tmp, det1(l))
|
||||
if (particle /= 0_bit_kind) then
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
tz = popcnt(ieor(particle,particle-1))-1
|
||||
IRP_ELSE
|
||||
tz = trailz(particle)
|
||||
IRP_ENDIF
|
||||
exc(0,2) = 1
|
||||
exc(1,2) = tz+ishift
|
||||
endif
|
||||
if (hole /= 0_bit_kind) then
|
||||
IRP_IF WITHOUT_TRAILZ
|
||||
tz = popcnt(ieor(hole,hole-1))-1
|
||||
IRP_ELSE
|
||||
tz = trailz(hole)
|
||||
IRP_ENDIF
|
||||
exc(0,1) = 1
|
||||
exc(1,1) = tz+ishift
|
||||
endif
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user