mirror of
https://github.com/QuantumPackage/qp2.git
synced 2024-12-24 12:33:30 +01:00
Guarded shiftr with IRP_IF
This commit is contained in:
parent
e2565bab76
commit
ad6419f3af
@ -568,9 +568,17 @@ double precision function V_r(n,alpha)
|
||||
integer :: n
|
||||
include 'utils/constants.include.F'
|
||||
if(iand(n,1).eq.1)then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
V_r = 0.5d0 * fact(ishft(n,-1)) / (alpha ** (ishft(n,-1) + 1))
|
||||
IRP_ELSE
|
||||
V_r = 0.5d0 * fact(shiftr(n,1)) / (alpha ** (shiftr(n,1) + 1))
|
||||
IRP_ENDIF
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
V_r = sqpi * fact(n) / fact(ishft(n,-1)) * (0.5d0/sqrt(alpha)) ** (n+1)
|
||||
IRP_ELSE
|
||||
V_r = sqpi * fact(n) / fact(shiftr(n,1)) * (0.5d0/sqrt(alpha)) ** (n+1)
|
||||
IRP_ENDIF
|
||||
endif
|
||||
end
|
||||
|
||||
@ -585,7 +593,11 @@ double precision function V_phi(n,m)
|
||||
integer :: n,m, i
|
||||
double precision :: prod, Wallis
|
||||
prod = 1.d0
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
do i = 0,ishft(n,-1)-1
|
||||
IRP_ELSE
|
||||
do i = 0,shiftr(n,1)-1
|
||||
IRP_ENDIF
|
||||
prod = prod/ (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
|
||||
enddo
|
||||
V_phi = 4.d0 * prod * Wallis(m)
|
||||
@ -604,7 +616,11 @@ double precision function V_theta(n,m)
|
||||
include 'utils/constants.include.F'
|
||||
V_theta = 0.d0
|
||||
prod = 1.d0
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
do i = 0,ishft(n,-1)-1
|
||||
IRP_ELSE
|
||||
do i = 0,shiftr(n,1)-1
|
||||
IRP_ENDIF
|
||||
prod = prod / (1.d0 + dfloat(m+1)/dfloat(n-i-i-1))
|
||||
enddo
|
||||
V_theta = (prod+prod) * Wallis(m)
|
||||
@ -622,10 +638,18 @@ double precision function Wallis(n)
|
||||
integer :: n,p
|
||||
include 'utils/constants.include.F'
|
||||
if(iand(n,1).eq.0)then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
Wallis = fact(ishft(n,-1))
|
||||
IRP_ELSE
|
||||
Wallis = fact(shiftr(n,1))
|
||||
IRP_ENDIF
|
||||
Wallis = pi * fact(n) / (dble(ibset(0_8,n)) * (Wallis+Wallis)*Wallis)
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
p = ishft(n,-1)
|
||||
IRP_ELSE
|
||||
p = shiftr(n,1)
|
||||
IRP_ENDIF
|
||||
Wallis = fact(p)
|
||||
Wallis = dble(ibset(0_8,p+p)) * Wallis*Wallis / fact(p+p+1)
|
||||
endif
|
||||
|
@ -28,13 +28,25 @@ subroutine two_e_integrals_index(i,j,k,l,i1)
|
||||
integer(key_kind) :: p,q,r,s,i2
|
||||
p = min(i,k)
|
||||
r = max(i,k)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
p = p+ishft(r*r-r,-1)
|
||||
IRP_ELSE
|
||||
p = p+shiftr(r*r-r,1)
|
||||
IRP_ENDIF
|
||||
q = min(j,l)
|
||||
s = max(j,l)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
q = q+ishft(s*s-s,-1)
|
||||
IRP_ELSE
|
||||
q = q+shiftr(s*s-s,1)
|
||||
IRP_ENDIF
|
||||
i1 = min(p,q)
|
||||
i2 = max(p,q)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i1 = i1+ishft(i2*i2-i2,-1)
|
||||
IRP_ELSE
|
||||
i1 = i1+shiftr(i2*i2-i2,1)
|
||||
IRP_ENDIF
|
||||
end
|
||||
|
||||
|
||||
@ -59,10 +71,22 @@ subroutine two_e_integrals_index_reverse(i,j,k,l,i1)
|
||||
i = 0
|
||||
i2 = ceiling(0.5d0*(dsqrt(dble(shiftl(i1,3)+1))-1.d0))
|
||||
l(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i2,3)+1))-1.d0))
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i3 = i1 - ishft(i2*i2-i2,-1)
|
||||
IRP_ELSE
|
||||
i3 = i1 - shiftr(i2*i2-i2,1)
|
||||
IRP_ENDIF
|
||||
k(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0))
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j(1) = int(i2 - ishft(l(1)*l(1)-l(1),-1),4)
|
||||
IRP_ELSE
|
||||
j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4)
|
||||
IRP_ENDIF
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i(1) = int(i3 - ishft(k(1)*k(1)-k(1),-1),4)
|
||||
IRP_ELSE
|
||||
i(1) = int(i3 - shiftr(k(1)*k(1)-k(1),1),4)
|
||||
IRP_ENDIF
|
||||
|
||||
!ijkl
|
||||
i(2) = i(1) !ilkj
|
||||
|
@ -655,7 +655,11 @@ subroutine integrale_new(I_f,a_x,b_x,c_x,d_x,a_y,b_y,c_y,d_y,a_z,b_z,c_z,d_z,p,q
|
||||
double precision :: I_f, pq_inv, p10_1, p10_2, p01_1, p01_2,rho,pq_inv_2
|
||||
integer :: ix,iy,iz, jx,jy,jz, sx,sy,sz
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j = ishft(n_pt,-1)
|
||||
IRP_ELSE
|
||||
j = shiftr(n_pt,1)
|
||||
IRP_ENDIF
|
||||
ASSERT (n_pt > 1)
|
||||
pq_inv = 0.5d0/(p+q)
|
||||
pq_inv_2 = pq_inv + pq_inv
|
||||
@ -1178,9 +1182,17 @@ subroutine compute_ao_integrals_jl(j,l,n_integrals,buffer_i,buffer_value)
|
||||
|
||||
n_integrals = 0
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j1 = j+ishft(l*l-l,-1)
|
||||
IRP_ELSE
|
||||
j1 = j+shiftr(l*l-l,1)
|
||||
IRP_ENDIF
|
||||
do k = 1, ao_num ! r1
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i1 = ishft(k*k-k,-1)
|
||||
IRP_ELSE
|
||||
i1 = shiftr(k*k-k,1)
|
||||
IRP_ENDIF
|
||||
if (i1 > j1) then
|
||||
exit
|
||||
endif
|
||||
|
@ -337,7 +337,11 @@ logical function is_i_in_virtual(i)
|
||||
integer :: accu
|
||||
is_i_in_virtual = .False.
|
||||
key= 0_bit_kind
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i-shiftl(k-1,bit_kind_shift)-1
|
||||
key(k) = ibset(key(k),j)
|
||||
accu = 0
|
||||
|
@ -85,7 +85,11 @@ subroutine list_to_bitstring( string, list, n_elements, Nint)
|
||||
string = 0_bit_kind
|
||||
|
||||
do i=1,n_elements
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
iint = ishft(list(i)-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
iint = shiftr(list(i)-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
ipos = list(i)-shiftl((iint-1),bit_kind_shift)-1
|
||||
string(iint) = ibset( string(iint), ipos )
|
||||
enddo
|
||||
|
@ -10,7 +10,11 @@ logical function is_the_hole_in_det(key_in,ispin,i_hole)
|
||||
do i = 1, N_int
|
||||
itest(i) = 0_bit_kind
|
||||
enddo
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_hole-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
itest(k) = ibset(itest(k),j)
|
||||
j = 0
|
||||
@ -38,7 +42,11 @@ logical function is_the_particl_in_det(key_in,ispin,i_particl)
|
||||
do i = 1, N_int
|
||||
itest(i) = 0_bit_kind
|
||||
enddo
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_particl-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_particl-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_particl-shiftl(k-1,bit_kind_shift)-1
|
||||
itest(k) = ibset(itest(k),j)
|
||||
j = 0
|
||||
|
@ -21,7 +21,11 @@ subroutine modify_bitmasks_for_hole(i_hole)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_hole-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
do l = 1, 3
|
||||
i = index_holes_bitmask(l)
|
||||
@ -42,7 +46,11 @@ subroutine modify_bitmasks_for_hole_in_out(i_hole)
|
||||
! the electrons occupying i_hole
|
||||
END_DOC
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_hole-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
do l = 1, 3
|
||||
i = index_holes_bitmask(l)
|
||||
@ -73,7 +81,11 @@ subroutine modify_bitmasks_for_particl(i_part)
|
||||
enddo
|
||||
enddo
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_part-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_part-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_part-shiftl(k-1,bit_kind_shift)-1
|
||||
do l = 1, 3
|
||||
i = index_particl_bitmask(l)
|
||||
|
@ -633,7 +633,11 @@ integer function pt2_find_sample_lr(v, w, l_in, r_in)
|
||||
r=r_in
|
||||
|
||||
do while(r-l > 1)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i = ishft(r+l,-1)
|
||||
IRP_ELSE
|
||||
i = shiftr(r+l,1)
|
||||
IRP_ENDIF
|
||||
if(w(i) < v) then
|
||||
l = i
|
||||
else
|
||||
|
@ -77,6 +77,25 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
|
||||
integer :: p1_int, p2_int
|
||||
integer :: h1_bit, h2_bit
|
||||
integer :: p1_bit, p2_bit
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
h1_int = ishft(h1-1,-bit_kind_shift)+1
|
||||
h1_bit = h1 - ishft (h1_int-1,bit_kind_shift)-1
|
||||
|
||||
h2_int = ishft(h2-1,-bit_kind_shift)+1
|
||||
h2_bit = h2 - ishft(h2_int-1,bit_kind_shift)-1
|
||||
|
||||
p1_int = ishft(p1-1,-bit_kind_shift)+1
|
||||
p1_bit = p1 - ishft(p1_int-1,bit_kind_shift)-1
|
||||
|
||||
p2_int = ishft(p2-1,-bit_kind_shift)+1
|
||||
p2_bit = p2 - ishft(p2_int-1,bit_kind_shift)-1
|
||||
|
||||
! Put the phasemask bits at position 0, and add them all
|
||||
h1_bit = int(ishft(phasemask(h1_int,s1),-h1_bit))
|
||||
p1_bit = int(ishft(phasemask(p1_int,s1),-p1_bit))
|
||||
h2_bit = int(ishft(phasemask(h2_int,s2),-h2_bit))
|
||||
p2_bit = int(ishft(phasemask(p2_int,s2),-p2_bit))
|
||||
IRP_ELSE
|
||||
h1_int = shiftr(h1-1,bit_kind_shift)+1
|
||||
h1_bit = h1 - shiftl(h1_int-1,bit_kind_shift)-1
|
||||
|
||||
@ -95,6 +114,7 @@ double precision function get_phase_bi(phasemask, s1, s2, h1, p1, h2, p2, Nint)
|
||||
p1_bit = int(shiftr(phasemask(p1_int,s1),p1_bit))
|
||||
h2_bit = int(shiftr(phasemask(h2_int,s2),h2_bit))
|
||||
p2_bit = int(shiftr(phasemask(p2_int,s2),p2_bit))
|
||||
IRP_ENDIF
|
||||
|
||||
np = h1_bit + p1_bit + h2_bit + p2_bit
|
||||
|
||||
|
@ -135,7 +135,7 @@ IRP_ENDIF
|
||||
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))) )
|
||||
v = ior(tt, ishft( 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
|
||||
@ -178,7 +178,7 @@ IRP_ENDIF
|
||||
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))) )
|
||||
v = ior(tt, ishft( 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
|
||||
@ -293,7 +293,7 @@ IRP_ENDIF
|
||||
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))) )
|
||||
v = ior(tt, ishft( 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
|
||||
@ -336,7 +336,7 @@ IRP_ENDIF
|
||||
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))) )
|
||||
v = ior(tt, ishft( 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
|
||||
@ -563,7 +563,11 @@ BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
|
||||
! Binary search
|
||||
l = 0
|
||||
r = N_configuration+1
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j = ishft(r-l,-1)
|
||||
IRP_ELSE
|
||||
j = shiftr(r-l,1)
|
||||
IRP_ENDIF
|
||||
do while (j>=1)
|
||||
j = j+l
|
||||
if (bit_tmp(j) == key) then
|
||||
@ -588,7 +592,11 @@ BEGIN_PROVIDER [ integer, det_to_configuration, (N_det) ]
|
||||
else
|
||||
l = j
|
||||
endif
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j = ishft(r-l,-1)
|
||||
IRP_ELSE
|
||||
j = shiftr(r-l,1)
|
||||
IRP_ENDIF
|
||||
enddo
|
||||
|
||||
enddo
|
||||
@ -815,7 +823,11 @@ subroutine binary_search_cfg(cfgInp,addcfg,bit_tmp)
|
||||
! Binary search
|
||||
l = 0
|
||||
r = N_configuration+1
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j = ishft(r-l,-1)
|
||||
IRP_ELSE
|
||||
j = shiftr(r-l,1)
|
||||
IRP_ENDIF
|
||||
do while (j>=1)
|
||||
j = j+l
|
||||
if (bit_tmp(j) == key) then
|
||||
@ -845,7 +857,11 @@ subroutine binary_search_cfg(cfgInp,addcfg,bit_tmp)
|
||||
else
|
||||
l = j
|
||||
endif
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j = ishft(r-l,-1)
|
||||
IRP_ELSE
|
||||
j = shiftr(r-l,1)
|
||||
IRP_ENDIF
|
||||
enddo
|
||||
|
||||
addcfg = -1
|
||||
|
@ -11,8 +11,13 @@ integer*8 function configuration_search_key(cfg,Nint)
|
||||
integer :: i, n_open_shells
|
||||
integer*8 :: mask
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i = ishft(elec_alpha_num, -bit_kind_shift)+1
|
||||
configuration_search_key = int(ishft(ior(cfg(i,1),cfg(i,2)),-1)+sum(cfg),8)
|
||||
IRP_ELSE
|
||||
i = shiftr(elec_alpha_num, bit_kind_shift)+1
|
||||
configuration_search_key = int(shiftr(ior(cfg(i,1),cfg(i,2)),1)+sum(cfg),8)
|
||||
IRP_ENDIF
|
||||
|
||||
mask = X'00FFFFFFFFFFFFFF'
|
||||
configuration_search_key = iand(mask,configuration_search_key)
|
||||
|
@ -19,7 +19,11 @@ subroutine do_single_excitation_cfg(key_in,key_out,i_hole,i_particle,ok)
|
||||
key_out(:,:) = key_in(:,:)
|
||||
|
||||
! hole
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_hole-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
mask = ibset(0_bit_kind,j)
|
||||
|
||||
@ -46,7 +50,11 @@ subroutine do_single_excitation_cfg(key_in,key_out,i_hole,i_particle,ok)
|
||||
|
||||
|
||||
! particle
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_particle-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_particle-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_particle-shiftl(k-1,bit_kind_shift)-1
|
||||
mask = ibset(0_bit_kind,j)
|
||||
|
||||
@ -109,7 +117,11 @@ subroutine do_single_excitation_cfg_with_type(key_in,key_out,i_hole,i_particle,e
|
||||
key_out(:,:) = key_in(:,:)
|
||||
|
||||
! hole
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_hole-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
mask = ibset(0_bit_kind,j)
|
||||
|
||||
@ -138,7 +150,11 @@ subroutine do_single_excitation_cfg_with_type(key_in,key_out,i_hole,i_particle,e
|
||||
|
||||
|
||||
! particle
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_particle-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_particle-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_particle-shiftl(k-1,bit_kind_shift)-1
|
||||
mask = ibset(0_bit_kind,j)
|
||||
|
||||
|
@ -328,7 +328,11 @@ compute_singles=.True.
|
||||
! right_max = -1_8
|
||||
! right = singles_alpha_csc_idx(krow+1)
|
||||
! do while (right-left>0_8)
|
||||
!IRP_IF WITHOUT_SHIFTRL
|
||||
! k8 = ishft(right+left,-1)
|
||||
!IRP_ELSE
|
||||
! k8 = shiftr(right+left,1)
|
||||
|
||||
! if (singles_alpha_csc(k8) > lrow) then
|
||||
! right = k8
|
||||
! else if (singles_alpha_csc(k8) < lrow) then
|
||||
@ -356,7 +360,11 @@ compute_singles=.True.
|
||||
! left = last_found
|
||||
! right = right_max
|
||||
! do while (right-left>0_8)
|
||||
!IRP_IF WITHOUT_SHIFTRL
|
||||
! k8 = ishft(right+left,-1)
|
||||
!IRP_ELSE
|
||||
! k8 = shiftr(right+left,1)
|
||||
|
||||
! if (singles_alpha_csc(k8) > lrow) then
|
||||
! right = k8
|
||||
! else if (singles_alpha_csc(k8) < lrow) then
|
||||
|
@ -367,7 +367,11 @@ compute_singles=.True.
|
||||
! right_max = -1_8
|
||||
! right = singles_alpha_csc_idx(krow+1)
|
||||
! do while (right-left>0_8)
|
||||
!IRP_IF WITHOUT_SHIFTRL
|
||||
! k8 = ishft(right+left,-1)
|
||||
!IRP_ELSE
|
||||
! k8 = shiftr(right+left,1)
|
||||
!IRP_ENDIF
|
||||
! if (singles_alpha_csc(k8) > lrow) then
|
||||
! right = k8
|
||||
! else if (singles_alpha_csc(k8) < lrow) then
|
||||
@ -395,7 +399,11 @@ compute_singles=.True.
|
||||
! left = last_found
|
||||
! right = right_max
|
||||
! do while (right-left>0_8)
|
||||
!IRP_IF WITHOUT_SHIFTRL
|
||||
! k8 = ishft(right+left,-1)
|
||||
!IRP_ELSE
|
||||
! k8 = shiftr(right+left,1)
|
||||
!IRP_ENDIF
|
||||
! if (singles_alpha_csc(k8) > lrow) then
|
||||
! right = k8
|
||||
! else if (singles_alpha_csc(k8) < lrow) then
|
||||
|
@ -7,8 +7,13 @@ integer*8 function det_search_key(det,Nint)
|
||||
integer, intent(in) :: Nint
|
||||
integer(bit_kind), intent(in) :: det(Nint,2)
|
||||
integer :: i
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i = ishft(elec_alpha_num,- bit_kind_shift)+1
|
||||
det_search_key = int(ishft(ior(det(i,1),det(i,2)),-1)+sum(det),8)
|
||||
IRP_ELSE
|
||||
i = shiftr(elec_alpha_num, bit_kind_shift)+1
|
||||
det_search_key = int(shiftr(ior(det(i,1),det(i,2)),1)+sum(det),8)
|
||||
IRP_ENDIF
|
||||
end
|
||||
|
||||
|
||||
@ -53,7 +58,11 @@ integer function get_index_in_psi_det_sorted_bit(key,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
det_search = det_search_key(psi_det_sorted_bit(1,1,1),Nint)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
istep = ishft(iend-ibegin,-1)
|
||||
IRP_ELSE
|
||||
istep = shiftr(iend-ibegin,1)
|
||||
IRP_ENDIF
|
||||
i=ibegin+istep
|
||||
do while (istep > 0)
|
||||
!DIR$ FORCEINLINE
|
||||
@ -65,7 +74,11 @@ integer function get_index_in_psi_det_sorted_bit(key,Nint)
|
||||
else
|
||||
ibegin = i
|
||||
endif
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
istep = ishft(iend-ibegin,-1)
|
||||
IRP_ELSE
|
||||
istep = shiftr(iend-ibegin,1)
|
||||
IRP_ENDIF
|
||||
i = ibegin + istep
|
||||
end do
|
||||
|
||||
|
@ -18,7 +18,11 @@ subroutine do_single_excitation(key_in,i_hole,i_particle,ispin,i_ok)
|
||||
ASSERT (i_particle <= mo_num)
|
||||
i_ok = 1
|
||||
! hole
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_hole-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_hole-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_hole-shiftl(k-1,bit_kind_shift)-1
|
||||
mask = ibset(0_bit_kind,j)
|
||||
! check whether position j is occupied
|
||||
@ -30,7 +34,11 @@ subroutine do_single_excitation(key_in,i_hole,i_particle,ispin,i_ok)
|
||||
end if
|
||||
|
||||
! particle
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_particle-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_particle-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_particle-shiftl(k-1,bit_kind_shift)-1
|
||||
mask = ibset(0_bit_kind,j)
|
||||
if (iand(key_in(k,ispin),mask) == 0_bit_kind) then
|
||||
@ -92,7 +100,11 @@ logical function is_spin_flip_possible(key_in,i_flip,ispin)
|
||||
integer(bit_kind) :: key_tmp(N_int,2)
|
||||
is_spin_flip_possible = .False.
|
||||
key_tmp = 0_bit_kind
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_flip-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_flip-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_flip-shiftl(k-1,bit_kind_shift)-1
|
||||
key_tmp(k,1) = ibset(key_tmp(k,1),j)
|
||||
integer :: other_spin(2)
|
||||
|
@ -800,23 +800,39 @@ subroutine apply_excitation(det, exc, res, ok, Nint)
|
||||
|
||||
res = det
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(h1-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(h1-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = h1-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s1), ibset(0_bit_kind, pos)) == 0_8) return
|
||||
res(ii, s1) = ibclr(res(ii, s1), pos)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(p1-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(p1-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = p1-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s1),shiftl(1_bit_kind, pos)) /= 0_8) return
|
||||
res(ii, s1) = ibset(res(ii, s1), pos)
|
||||
|
||||
if(degree == 2) then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(h2-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(h2-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = h2-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s2), shiftl(1_bit_kind, pos)) == 0_8) return
|
||||
res(ii, s2) = ibclr(res(ii, s2), pos)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(p2-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(p2-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = p2-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s2), shiftl(1_bit_kind, pos)) /= 0_8) return
|
||||
res(ii, s2) = ibset(res(ii, s2), pos)
|
||||
@ -839,13 +855,21 @@ subroutine apply_particles(det, s1, p1, s2, p2, res, ok, Nint)
|
||||
res = det
|
||||
|
||||
if(p1 /= 0) then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii =ishft(p1-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii =shiftr(p1-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = p1-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s1), shiftl(1_bit_kind, pos)) /= 0_8) return
|
||||
res(ii, s1) = ibset(res(ii, s1), pos)
|
||||
end if
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(p2-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(p2-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = p2-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s2), shiftl(1_bit_kind, pos)) /= 0_8) return
|
||||
res(ii, s2) = ibset(res(ii, s2), pos)
|
||||
@ -868,13 +892,21 @@ subroutine apply_holes(det, s1, h1, s2, h2, res, ok, Nint)
|
||||
res = det
|
||||
|
||||
if(h1 /= 0) then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(h1-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(h1-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = h1-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s1), shiftl(1_bit_kind, pos)) == 0_8) return
|
||||
res(ii, s1) = ibclr(res(ii, s1), pos)
|
||||
end if
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(h2-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(h2-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = h2-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s2), shiftl(1_bit_kind, pos)) == 0_8) return
|
||||
res(ii, s2) = ibclr(res(ii, s2), pos)
|
||||
@ -895,7 +927,11 @@ subroutine apply_particle(det, s1, p1, res, ok, Nint)
|
||||
ok = .false.
|
||||
res = det
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(p1-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(p1-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = p1-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s1), shiftl(1_bit_kind, pos)) /= 0_8) return
|
||||
res(ii, s1) = ibset(res(ii, s1), pos)
|
||||
@ -917,7 +953,11 @@ subroutine apply_hole(det, s1, h1, res, ok, Nint)
|
||||
ok = .false.
|
||||
res = det
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
ii = ishft(h1-1,-bit_kind_shift) + 1
|
||||
IRP_ELSE
|
||||
ii = shiftr(h1-1,bit_kind_shift) + 1
|
||||
IRP_ENDIF
|
||||
pos = h1-1-shiftl(ii-1,bit_kind_shift)
|
||||
if(iand(det(ii, s1), shiftl(1_bit_kind, pos)) == 0_8) return
|
||||
res(ii, s1) = ibclr(res(ii, s1), pos)
|
||||
|
@ -22,12 +22,23 @@ subroutine $subroutine_diexc(key_in, key_prev, hole_1,particl_1, hole_2, particl
|
||||
do sp=1,2
|
||||
do ni=1,N_int
|
||||
do i=1,bit_kind_size
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
if(iand(1_bit_kind,ishft(key_in(ni, sp), (1-i))) == 0) then
|
||||
cycle
|
||||
end if
|
||||
IRP_ELSE
|
||||
if(iand(1_bit_kind,shiftr(key_in(ni, sp), (i-1))) == 0) then
|
||||
cycle
|
||||
end if
|
||||
IRP_ENDIF
|
||||
mi = (ni-1)*bit_kind_size+i
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
status(mi, sp) = int(iand(1_bit_kind,ishft(hole_1(ni,sp),(1-i))),4)
|
||||
status(mi, sp) = status(mi, sp) + 2*int(iand(1_bit_kind,ishft(hole_2(ni,sp),(1-i))),4)
|
||||
IRP_ELSE
|
||||
status(mi, sp) = int(iand(1_bit_kind,shiftr(hole_1(ni,sp),(i-1))),4)
|
||||
status(mi, sp) = status(mi, sp) + 2*int(iand(1_bit_kind,shiftr(hole_2(ni,sp),(i-1))),4)
|
||||
IRP_ENDIF
|
||||
if(status(mi, sp) /= 0 .and. mi > highest) then
|
||||
highest = mi
|
||||
end if
|
||||
@ -88,16 +99,26 @@ subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2,
|
||||
p2_mask(k,1) = 0_bit_kind
|
||||
p2_mask(k,2) = 0_bit_kind
|
||||
enddo
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
p1_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) = shiftl(one,iand(fh1-1,bit_kind_size-1))
|
||||
p2_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) = shiftl(one,iand(fh2-1,bit_kind_size-1))
|
||||
IRP_ELSE
|
||||
p1_mask(shiftr(fh1-1,bit_kind_shift) + 1, fs1) = shiftl(one,iand(fh1-1,bit_kind_size-1))
|
||||
p2_mask(shiftr(fh2-1,bit_kind_shift) + 1, fs2) = shiftl(one,iand(fh2-1,bit_kind_size-1))
|
||||
IRP_ENDIF
|
||||
|
||||
do k=1,N_int
|
||||
key_mask(k,1) = key_in(k,1)
|
||||
key_mask(k,2) = key_in(k,2)
|
||||
enddo
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
key_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) -= shiftl(one,iand(fh1-1,bit_kind_size-1))
|
||||
key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= shiftl(one,iand(fh2-1,bit_kind_size-1))
|
||||
IRP_ELSE
|
||||
key_mask(shiftr(fh1-1,bit_kind_shift) + 1, fs1) -= shiftl(one,iand(fh1-1,bit_kind_size-1))
|
||||
key_mask(shiftr(fh2-1,bit_kind_shift) + 1, fs2) -= shiftl(one,iand(fh2-1,bit_kind_size-1))
|
||||
IRP_ENDIF
|
||||
|
||||
|
||||
call $subroutine_diexcOrg(key_in, key_mask, p1_mask, particl_1, p2_mask, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters )
|
||||
@ -219,10 +240,18 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
||||
ASSERT (j_a > 0)
|
||||
ASSERT (j_a <= mo_num)
|
||||
hole = key_in
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_a-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_a-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_a-shiftl(k-1,bit_kind_shift)-1
|
||||
hole(k,ispin) = ibclr(hole(k,ispin),j)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k_a = ishft(j_a-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k_a = shiftr(j_a-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
l_a = j_a-shiftl(k_a-1,bit_kind_shift)-1
|
||||
hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a)
|
||||
|
||||
@ -269,11 +298,19 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
||||
hole = hole_save
|
||||
i_b = ib_jb_pairs(1,kk)
|
||||
j_b = ib_jb_pairs(2,kk)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_b-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_b-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_b-shiftl(k-1,bit_kind_shift)-1
|
||||
hole(k,other_spin) = ibclr(hole(k,other_spin),j)
|
||||
key = hole
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(j_b-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(j_b-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
l = j_b-shiftl(k-1,bit_kind_shift)-1
|
||||
key(k,other_spin) = ibset(key(k,other_spin),l)
|
||||
$filter2h2p_double
|
||||
@ -325,11 +362,19 @@ subroutine $subroutine_diexcOrg(key_in,key_mask,hole_1,particl_1,hole_2, particl
|
||||
hole = hole_save
|
||||
i_b = ib_jb_pairs(1,kk)
|
||||
j_b = ib_jb_pairs(2,kk)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_b-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_b-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_b-shiftl(k-1,bit_kind_shift)-1
|
||||
hole(k,ispin) = ibclr(hole(k,ispin),j)
|
||||
key = hole
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(j_b-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(j_b-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
l = j_b-shiftl(k-1,bit_kind_shift)-1
|
||||
key(k,ispin) = ibset(key(k,ispin),l)
|
||||
$filter2h2p_double
|
||||
@ -477,11 +522,19 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato
|
||||
i_a = ia_ja_pairs(1,ii,ispin)
|
||||
j_a = ia_ja_pairs(2,ii,ispin)
|
||||
hole = key_in
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(i_a-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(i_a-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
j = i_a-shiftl(k-1,bit_kind_shift)-1
|
||||
$filterhole
|
||||
hole(k,ispin) = ibclr(hole(k,ispin),j)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k_a = ishft(j_a-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k_a = shiftr(j_a-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
l_a = j_a-shiftl(k_a-1,bit_kind_shift)-1
|
||||
$filterparticle
|
||||
hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a)
|
||||
|
@ -51,7 +51,11 @@ subroutine get_excitation_degree(key1,key2,degree,Nint)
|
||||
|
||||
end select
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree = ishft(degree,-1)
|
||||
IRP_ELSE
|
||||
degree = shiftr(degree,1)
|
||||
IRP_ENDIF
|
||||
|
||||
end
|
||||
|
||||
@ -247,8 +251,13 @@ IRP_ENDIF
|
||||
ASSERT (low >= 0)
|
||||
ASSERT (high > 0)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(high,-bit_kind_shift)+1
|
||||
j = ishft(low,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(high,bit_kind_shift)+1
|
||||
j = shiftr(low,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
m = iand(high,bit_kind_size-1)
|
||||
n = iand(low,bit_kind_size-1)
|
||||
|
||||
@ -279,8 +288,13 @@ IRP_ENDIF
|
||||
ASSERT (low > 0)
|
||||
ASSERT (high > 0)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(high,-bit_kind_shift)+1
|
||||
j = ishft(low,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(high,bit_kind_shift)+1
|
||||
j = shiftr(low,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
m = iand(high,bit_kind_size-1)
|
||||
n = iand(low,bit_kind_size-1)
|
||||
|
||||
@ -409,8 +423,13 @@ IRP_ENDIF
|
||||
ASSERT (low >= 0)
|
||||
ASSERT (high > 0)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(high,-bit_kind_shift)+1
|
||||
j = ishft(low,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(high,bit_kind_shift)+1
|
||||
j = shiftr(low,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
m = iand(high,bit_kind_size-1)
|
||||
n = iand(low,bit_kind_size-1)
|
||||
|
||||
@ -1112,7 +1131,11 @@ subroutine get_excitation_degree_vector_single(key1,key2,degree,Nint,sze,idx)
|
||||
if (d > 2) then
|
||||
cycle
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1129,7 +1152,11 @@ subroutine get_excitation_degree_vector_single(key1,key2,degree,Nint,sze,idx)
|
||||
if (d > 2) then
|
||||
cycle
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1148,7 +1175,11 @@ subroutine get_excitation_degree_vector_single(key1,key2,degree,Nint,sze,idx)
|
||||
if (d > 2) then
|
||||
cycle
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1167,7 +1198,11 @@ subroutine get_excitation_degree_vector_single(key1,key2,degree,Nint,sze,idx)
|
||||
if (d > 2) then
|
||||
cycle
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1211,7 +1246,11 @@ subroutine get_excitation_degree_vector_single_or_exchange(key1,key2,degree,Nint
|
||||
if (d > 4)cycle
|
||||
if (d ==4)then
|
||||
if(popcnt(xor(key_tmp(1,1),key_tmp(1,2))) == 0)then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else
|
||||
@ -1219,7 +1258,11 @@ subroutine get_excitation_degree_vector_single_or_exchange(key1,key2,degree,Nint
|
||||
endif
|
||||
! pause
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1269,7 +1312,11 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint,
|
||||
degree_alpha = popcnt(key_tmp(1,1))
|
||||
degree_beta = popcnt(key_tmp(1,2))
|
||||
if(degree_alpha .ge.3 .or. degree_beta .ge.3 )cycle !! no double excitations of same spin
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
enddo
|
||||
@ -1289,7 +1336,11 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint,
|
||||
degree_alpha = popcnt(key_tmp(1,1)) + popcnt(key_tmp(2,1))
|
||||
degree_beta = popcnt(key_tmp(1,2)) + popcnt(key_tmp(2,2))
|
||||
if(degree_alpha .ge.3 .or. degree_beta .ge.3 )cycle !! no double excitations of same spin
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
enddo
|
||||
@ -1314,7 +1365,11 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint,
|
||||
degree_alpha = popcnt(key_tmp(1,1)) + popcnt(key_tmp(2,1)) + popcnt(key_tmp(3,1))
|
||||
degree_beta = popcnt(key_tmp(1,2)) + popcnt(key_tmp(2,2)) + popcnt(key_tmp(3,2))
|
||||
if(degree_alpha .ge.3 .or. degree_beta .ge.3 )cycle !! no double excitations of same spin
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
enddo
|
||||
@ -1336,7 +1391,11 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint,
|
||||
degree_beta += popcnt(key_tmp(m,2))
|
||||
enddo
|
||||
if(degree_alpha .ge.3 .or. degree_beta .ge.3 )cycle !! no double excitations of same spin
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
enddo
|
||||
@ -1391,19 +1450,30 @@ subroutine get_excitation_degree_vector_single_or_exchange_verbose(key1,key2,deg
|
||||
if (d > 4)cycle
|
||||
if (d ==4)then
|
||||
if(exchange_1 .eq. 0 ) then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else if (exchange_1 .eq. 2 .and. exchange_2.eq.2)then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else
|
||||
cycle
|
||||
endif
|
||||
! pause
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1423,11 +1493,19 @@ subroutine get_excitation_degree_vector_single_or_exchange_verbose(key1,key2,deg
|
||||
if (d > 4)cycle
|
||||
if (d ==4)then
|
||||
if(exchange_1 .eq. 0 ) then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else if (exchange_1 .eq. 2 .and. exchange_2.eq.2)then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else
|
||||
@ -1435,7 +1513,11 @@ subroutine get_excitation_degree_vector_single_or_exchange_verbose(key1,key2,deg
|
||||
endif
|
||||
! pause
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1460,11 +1542,19 @@ subroutine get_excitation_degree_vector_single_or_exchange_verbose(key1,key2,deg
|
||||
if (d > 4)cycle
|
||||
if (d ==4)then
|
||||
if(exchange_1 .eq. 0 ) then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else if (exchange_1 .eq. 2 .and. exchange_2.eq.2)then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else
|
||||
@ -1472,7 +1562,11 @@ subroutine get_excitation_degree_vector_single_or_exchange_verbose(key1,key2,deg
|
||||
endif
|
||||
! pause
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1495,18 +1589,30 @@ subroutine get_excitation_degree_vector_single_or_exchange_verbose(key1,key2,deg
|
||||
if (d > 4)cycle
|
||||
if (d ==4)then
|
||||
if(exchange_1 .eq. 0 ) then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else if (exchange_1 .eq. 2 .and. exchange_2.eq.2)then
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
else
|
||||
cycle
|
||||
endif
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1543,7 +1649,11 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
if (d > 4) then
|
||||
cycle
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1559,7 +1669,11 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
if (d > 4) then
|
||||
cycle
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1577,7 +1691,11 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
if (d > 4) then
|
||||
cycle
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1594,7 +1712,11 @@ subroutine get_excitation_degree_vector(key1,key2,degree,Nint,sze,idx)
|
||||
if (d > 4) then
|
||||
cycle
|
||||
else
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree(l) = ishft(d,-1)
|
||||
IRP_ELSE
|
||||
degree(l) = shiftr(d,1)
|
||||
IRP_ENDIF
|
||||
idx(l) = i
|
||||
l = l+1
|
||||
endif
|
||||
@ -1759,7 +1881,11 @@ subroutine a_operator(iorb,ispin,key,hjj,Nint,na,nb)
|
||||
ASSERT (ispin < 3)
|
||||
ASSERT (Nint > 0)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(iorb-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(iorb-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
ASSERT (k>0)
|
||||
l = iorb - shiftl(k-1,bit_kind_shift)-1
|
||||
key(k,ispin) = ibclr(key(k,ispin),l)
|
||||
@ -1820,7 +1946,11 @@ subroutine ac_operator(iorb,ispin,key,hjj,Nint,na,nb)
|
||||
ASSERT (tmp(1) == elec_alpha_num)
|
||||
ASSERT (tmp(2) == elec_beta_num)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(iorb-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(iorb-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
ASSERT (k >0)
|
||||
l = iorb - shiftl(k-1,bit_kind_shift)-1
|
||||
ASSERT (l >= 0)
|
||||
@ -1911,7 +2041,11 @@ subroutine get_excitation_degree_spin(key1,key2,degree,Nint)
|
||||
|
||||
end select
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
degree = ishft(degree,-1)
|
||||
IRP_ELSE
|
||||
degree = shiftr(degree,1)
|
||||
IRP_ENDIF
|
||||
|
||||
end
|
||||
|
||||
@ -2066,10 +2200,18 @@ IRP_ENDIF
|
||||
high = max(exc(1,1), exc(1,2))
|
||||
|
||||
ASSERT (low > 0)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j = ishft(low-1,-bit_kind_shift)+1 ! Find integer in array(Nint)
|
||||
IRP_ELSE
|
||||
j = shiftr(low-1,bit_kind_shift)+1 ! Find integer in array(Nint)
|
||||
IRP_ENDIF
|
||||
n = iand(low-1,bit_kind_size-1)+1 ! mod(low,bit_kind_size)
|
||||
ASSERT (high > 0)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(high-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(high-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
m = iand(high-1,bit_kind_size-1)+1
|
||||
|
||||
if (j==k) then
|
||||
@ -2094,10 +2236,18 @@ IRP_ENDIF
|
||||
high = max(exc(i,1), exc(i,2))
|
||||
|
||||
ASSERT (low > 0)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j = ishft(low-1,-bit_kind_shift)+1 ! Find integer in array(Nint)
|
||||
IRP_ELSE
|
||||
j = shiftr(low-1,bit_kind_shift)+1 ! Find integer in array(Nint)
|
||||
IRP_ENDIF
|
||||
n = iand(low-1,bit_kind_size-1)+1 ! mod(low,bit_kind_size)
|
||||
ASSERT (high > 0)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(high-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(high-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
m = iand(high-1,bit_kind_size-1)+1
|
||||
|
||||
if (j==k) then
|
||||
@ -2191,10 +2341,18 @@ IRP_ENDIF
|
||||
high = max(exc(1,1),exc(1,2))
|
||||
|
||||
ASSERT (low > 0)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j = ishft(low-1,-bit_kind_shift)+1 ! Find integer in array(Nint)
|
||||
IRP_ELSE
|
||||
j = shiftr(low-1,bit_kind_shift)+1 ! Find integer in array(Nint)
|
||||
IRP_ENDIF
|
||||
n = iand(low-1,bit_kind_size-1)+1 ! mod(low,bit_kind_size)
|
||||
ASSERT (high > 0)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
k = ishft(high-1,-bit_kind_shift)+1
|
||||
IRP_ELSE
|
||||
k = shiftr(high-1,bit_kind_shift)+1
|
||||
IRP_ENDIF
|
||||
m = iand(high-1,bit_kind_size-1)+1
|
||||
if (j==k) then
|
||||
nperm = popcnt(iand(det1(j), &
|
||||
|
@ -172,7 +172,11 @@ integer function get_index_in_psi_det_alpha_unique(key,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
det_search = spin_det_search_key(psi_det_alpha_unique(1,1),Nint)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
istep = ishft(iend-ibegin,-1)
|
||||
IRP_ELSE
|
||||
istep = shiftr(iend-ibegin,1)
|
||||
IRP_ENDIF
|
||||
i=ibegin+istep
|
||||
do while (istep > 0)
|
||||
!DIR$ FORCEINLINE
|
||||
@ -184,7 +188,11 @@ integer function get_index_in_psi_det_alpha_unique(key,Nint)
|
||||
else
|
||||
ibegin = i
|
||||
endif
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
istep = ishft(iend-ibegin,-1)
|
||||
IRP_ELSE
|
||||
istep = shiftr(iend-ibegin,1)
|
||||
IRP_ENDIF
|
||||
i = ibegin + istep
|
||||
end do
|
||||
|
||||
@ -252,7 +260,11 @@ integer function get_index_in_psi_det_beta_unique(key,Nint)
|
||||
!DIR$ FORCEINLINE
|
||||
det_search = spin_det_search_key(psi_det_beta_unique(1,1),Nint)
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
istep = ishft(iend-ibegin,-1)
|
||||
IRP_ELSE
|
||||
istep = shiftr(iend-ibegin,1)
|
||||
IRP_ENDIF
|
||||
i=ibegin+istep
|
||||
do while (istep > 0)
|
||||
!DIR$ FORCEINLINE
|
||||
@ -264,7 +276,11 @@ integer function get_index_in_psi_det_beta_unique(key,Nint)
|
||||
else
|
||||
ibegin = i
|
||||
endif
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
istep = ishft(iend-ibegin,-1)
|
||||
IRP_ELSE
|
||||
istep = shiftr(iend-ibegin,1)
|
||||
IRP_ENDIF
|
||||
i = ibegin + istep
|
||||
end do
|
||||
|
||||
|
@ -184,7 +184,11 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
|
||||
|
||||
q = min(j,l)
|
||||
s = max(j,l)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
q = q+ishft(s*s-s,-1)
|
||||
IRP_ELSE
|
||||
q = q+shiftr(s*s-s,1)
|
||||
IRP_ENDIF
|
||||
|
||||
do i=1,sze
|
||||
if (banned_excitation(i,k)) cycle
|
||||
@ -195,10 +199,18 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
|
||||
else
|
||||
p = min(i,k)
|
||||
r = max(i,k)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
p = p+ishft(r*r-r,-1)
|
||||
IRP_ELSE
|
||||
p = p+shiftr(r*r-r,1)
|
||||
IRP_ENDIF
|
||||
i1 = min(p,q)
|
||||
i2 = max(p,q)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
idx = i1+ishft(i2*i2-i2,-1)
|
||||
IRP_ELSE
|
||||
idx = i1+shiftr(i2*i2-i2,1)
|
||||
IRP_ENDIF
|
||||
!DIR$ FORCEINLINE
|
||||
call map_get(map,idx,tmp)
|
||||
out_val(i) = dble(tmp)
|
||||
|
@ -9,13 +9,25 @@ subroutine mo_two_e_integrals_index(i,j,k,l,i1)
|
||||
integer(key_kind) :: p,q,r,s,i2
|
||||
p = min(i,k)
|
||||
r = max(i,k)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
p = p+ishft(r*r-r,-1)
|
||||
IRP_ELSE
|
||||
p = p+shiftr(r*r-r,1)
|
||||
IRP_ENDIF
|
||||
q = min(j,l)
|
||||
s = max(j,l)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
q = q+ishft(s*s-s,-1)
|
||||
IRP_ELSE
|
||||
q = q+shiftr(s*s-s,1)
|
||||
IRP_ENDIF
|
||||
i1 = min(p,q)
|
||||
i2 = max(p,q)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i1 = i1+ishft(i2*i2-i2,-1)
|
||||
IRP_ELSE
|
||||
i1 = i1+shiftr(i2*i2-i2,1)
|
||||
IRP_ENDIF
|
||||
end
|
||||
|
||||
|
||||
@ -280,7 +292,11 @@ subroutine add_integrals_to_map(mask_ijkl)
|
||||
if (abs(c) < thr_coef) then
|
||||
cycle
|
||||
endif
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j1 = ishft((l*l-l),-1)
|
||||
IRP_ELSE
|
||||
j1 = shiftr((l*l-l),1)
|
||||
IRP_ENDIF
|
||||
do j0 = 1, n_j
|
||||
j = list_ijkl(j0,2)
|
||||
if (j > l) then
|
||||
@ -289,7 +305,11 @@ subroutine add_integrals_to_map(mask_ijkl)
|
||||
j1 += 1
|
||||
do k0 = 1, n_k
|
||||
k = list_ijkl(k0,3)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i1 = ishft((k*k-k),-1)
|
||||
IRP_ELSE
|
||||
i1 = shiftr((k*k-k),1)
|
||||
IRP_ENDIF
|
||||
if (i1<=j1) then
|
||||
continue
|
||||
else
|
||||
@ -556,7 +576,11 @@ subroutine add_integrals_to_map_three_indices(mask_ijk)
|
||||
endif
|
||||
do k0 = 1, n_k
|
||||
k = list_ijkl(k0,3)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i1 = ishft((k*k-k),-1)
|
||||
IRP_ELSE
|
||||
i1 = shiftr((k*k-k),1)
|
||||
IRP_ENDIF
|
||||
two_e_tmp_1 = 0.d0
|
||||
j0 = l0
|
||||
j = list_ijkl(j0,2)
|
||||
@ -600,7 +624,11 @@ subroutine add_integrals_to_map_three_indices(mask_ijk)
|
||||
endif
|
||||
do k0 = 1, n_k
|
||||
k = list_ijkl(k0,3)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i1 = ishft((k*k-k),-1)
|
||||
IRP_ELSE
|
||||
i1 = shiftr((k*k-k),1)
|
||||
IRP_ENDIF
|
||||
two_e_tmp_1 = 0.d0
|
||||
j0 = k0
|
||||
j = list_ijkl(k0,2)
|
||||
@ -837,7 +865,11 @@ subroutine add_integrals_to_map_no_exit_34(mask_ijkl)
|
||||
if (abs(c) < thr_coef) then
|
||||
cycle
|
||||
endif
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
j1 = ishft((l*l-l),-1)
|
||||
IRP_ELSE
|
||||
j1 = shiftr((l*l-l),1)
|
||||
IRP_ENDIF
|
||||
do j0 = 1, n_j
|
||||
j = list_ijkl(j0,2)
|
||||
if (j > l) then
|
||||
@ -846,7 +878,11 @@ subroutine add_integrals_to_map_no_exit_34(mask_ijkl)
|
||||
j1 += 1
|
||||
do k0 = 1, n_k
|
||||
k = list_ijkl(k0,3)
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
i1 = ishft((k*k-k),-1)
|
||||
IRP_ELSE
|
||||
i1 = shiftr((k*k-k),1)
|
||||
IRP_ENDIF
|
||||
two_e_tmp_1 = 0.d0
|
||||
do i0 = 1, n_i
|
||||
i = list_ijkl(i0,1)
|
||||
|
@ -423,7 +423,11 @@ double precision function F_integral(n,p)
|
||||
F_integral = sqpi * sqrt_p
|
||||
return
|
||||
endif
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
F_integral = sqpi * 0.5d0**n * sqrt_p**(n+1) * fact(n)/fact(ishft(n,-1))
|
||||
IRP_ELSE
|
||||
F_integral = sqpi * 0.5d0**n * sqrt_p**(n+1) * fact(n)/fact(shiftr(n,1))
|
||||
IRP_ENDIF
|
||||
end
|
||||
|
||||
|
||||
@ -500,7 +504,11 @@ double precision function rint_sum(n_pt_out,rho,d1)
|
||||
endif
|
||||
|
||||
do i=2,n_pt_out,2
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
n = ishft(i,-1)
|
||||
IRP_ELSE
|
||||
n = shiftr(i,1)
|
||||
IRP_ENDIF
|
||||
rint_sum = rint_sum + d1(i)*rint1(n,rho)
|
||||
enddo
|
||||
|
||||
@ -525,7 +533,11 @@ double precision function rint_sum(n_pt_out,rho,d1)
|
||||
di = di+2.d0
|
||||
enddo
|
||||
do i=42,n_pt_out,2
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
n = ishft(i,-1)
|
||||
IRP_ELSE
|
||||
n = shiftr(i,1)
|
||||
IRP_ENDIF
|
||||
rint_sum = rint_sum + d1(i)*rint_large_n(n,rho)
|
||||
enddo
|
||||
|
||||
|
@ -57,10 +57,14 @@ BEGIN_TEMPLATE
|
||||
$type :: c, tmp
|
||||
integer :: itmp
|
||||
integer :: i, j
|
||||
|
||||
|
||||
if(isize<2)return
|
||||
|
||||
IRP_IF WITHOUT_SHIFTRL
|
||||
c = x( ishft(first+last,-1) )
|
||||
IRP_ELSE
|
||||
c = x( shiftr(first+last,1) )
|
||||
IRP_ENDIF
|
||||
i = first
|
||||
j = last
|
||||
do
|
||||
|
Loading…
Reference in New Issue
Block a user