Guarded shiftl with IRP_IF

src/ao_two_e_ints/map_integrals.irp.f

@@ -69,22 +69,19 @@ subroutine two_e_integrals_index_reverse(i,j,k,l,i1)
   integer(key_kind), intent(in)  :: i1
   integer(key_kind)              :: i2,i3
   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
+  i2   = ceiling(0.5d0*(dsqrt(dble(ishft(i1,3)+1))-1.d0))
+  l(1) = ceiling(0.5d0*(dsqrt(dble(ishft(i2,3)+1))-1.d0))
   i3   = i1 - ishft(i2*i2-i2,-1)
-IRP_ELSE
+  k(1) = ceiling(0.5d0*(dsqrt(dble(ishft(i3,3)+1))-1.d0))
-  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
+  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))
+  i3   = i1 - shiftr(i2*i2-i2,1)
+  k(1) = ceiling(0.5d0*(dsqrt(dble(shiftl(i3,3)+1))-1.d0))
+  j(1) = int(i2 - shiftr(l(1)*l(1)-l(1),1),4)
   i(1) = int(i3 - shiftr(k(1)*k(1)-k(1),1),4)
 IRP_ENDIF
 
@@ -334,9 +331,15 @@ BEGIN_PROVIDER [ double precision, ao_integrals_cache, (0:64*64*64*64) ]
           !DIR$ FORCEINLINE
           call map_get(ao_integrals_map,idx,integral)
           ii = l-ao_integrals_cache_min
+IRP_IF WITHOUT_SHIFTRL
+          ii = ior( ishft(ii,6), k-ao_integrals_cache_min)
+          ii = ior( ishft(ii,6), j-ao_integrals_cache_min)
+          ii = ior( ishft(ii,6), i-ao_integrals_cache_min)
+IRP_ELSE
           ii = ior( shiftl(ii,6), k-ao_integrals_cache_min)
           ii = ior( shiftl(ii,6), j-ao_integrals_cache_min)
           ii = ior( shiftl(ii,6), i-ao_integrals_cache_min)
+IRP_ENDIF
           ao_integrals_cache(ii) = integral
         enddo
       enddo
@@ -374,9 +377,15 @@ double precision function get_ao_two_e_integral(i,j,k,l,map) result(result)
       call map_get(map,idx,tmp)
     else
       ii = l-ao_integrals_cache_min
+IRP_IF WITHOUT_SHIFTRL
+      ii = ior( ishft(ii,6), k-ao_integrals_cache_min)
+      ii = ior( ishft(ii,6), j-ao_integrals_cache_min)
+      ii = ior( ishft(ii,6), i-ao_integrals_cache_min)
+IRP_ELSE
       ii = ior( shiftl(ii,6), k-ao_integrals_cache_min)
       ii = ior( shiftl(ii,6), j-ao_integrals_cache_min)
       ii = ior( shiftl(ii,6), i-ao_integrals_cache_min)
+IRP_ENDIF
       tmp = ao_integrals_cache(ii)
     endif
   endif
@@ -422,9 +431,15 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ]
          endif
 
          ii = l-ao_integrals_cache_min
+IRP_IF WITHOUT_SHIFTRL
+         ii = ior( ishft(ii,6), k-ao_integrals_cache_min)
+         ii = ior( ishft(ii,6), j-ao_integrals_cache_min)
+         ii = ior( ishft(ii,6), i-ao_integrals_cache_min)
+IRP_ELSE
          ii = ior( shiftl(ii,6), k-ao_integrals_cache_min)
          ii = ior( shiftl(ii,6), j-ao_integrals_cache_min)
          ii = ior( shiftl(ii,6), i-ao_integrals_cache_min)
+IRP_ENDIF
          ao_integrals_cache_periodic(ii) = integral
        enddo
      enddo
@@ -480,9 +495,15 @@ complex*16 function get_ao_two_e_integral_periodic(i,j,k,l,map) result(result)
          endif
     else
       ii = l-ao_integrals_cache_min
+IRP_IF WITHOUT_SHIFTRL
+      ii = ior( ishft(ii,6), k-ao_integrals_cache_min)
+      ii = ior( ishft(ii,6), j-ao_integrals_cache_min)
+      ii = ior( ishft(ii,6), i-ao_integrals_cache_min)
+IRP_ELSE
       ii = ior( shiftl(ii,6), k-ao_integrals_cache_min)
       ii = ior( shiftl(ii,6), j-ao_integrals_cache_min)
       ii = ior( shiftl(ii,6), i-ao_integrals_cache_min)
+IRP_ENDIF
       tmp = ao_integrals_cache_periodic(ii)
     endif
     result = tmp

src/ao_two_e_ints/two_e_integrals.irp.f

@@ -624,7 +624,11 @@ double precision function ERI(alpha,beta,delta,gama,a_x,b_x,c_x,d_x,a_y,b_y,c_y,
   p = alpha + beta
   q = delta + gama
   ASSERT (p+q >= 0.d0)
+IRP_IF WITHOUT_SHIFTRL
+  n_pt =  ishft( nx+ny+nz,1 )
+IRP_ELSE
   n_pt =  shiftl( nx+ny+nz,1 )
+IRP_ENDIF
 
   coeff = pi_5_2 / (p * q * dsqrt(p+q))
   if (n_pt == 0) then
@@ -784,7 +788,11 @@ integer function n_pt_sup(a_x,b_x,c_x,d_x,a_y,b_y,c_y,d_y,a_z,b_z,c_z,d_z)
   ! $I_x(a_x,b_x,c_x,d_x) \, I_y(a_y,b_y,c_y,d_y) \, I_z(a_z,b_z,c_z,d_z)$
   END_DOC
   integer                        :: a_x,b_x,c_x,d_x,a_y,b_y,c_y,d_y,a_z,b_z,c_z,d_z
+IRP_IF WITHOUT_SHIFTRL
+  n_pt_sup =  ishft( a_x+b_x+c_x+d_x + a_y+b_y+c_y+d_y + a_z+b_z+c_z+d_z,1 )
+IRP_ELSE
   n_pt_sup =  shiftl( a_x+b_x+c_x+d_x + a_y+b_y+c_y+d_y + a_z+b_z+c_z+d_z,1 )
+IRP_ENDIF
 end
 
 

src/bitmask/bitmask_cas_routines.irp.f

@@ -339,10 +339,11 @@ logical function is_i_in_virtual(i)
  key= 0_bit_kind
 IRP_IF WITHOUT_SHIFTRL
  k = ishft(i-1,-bit_kind_shift)+1
+ j = i-ishft(k-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
+IRP_ENDIF
  key(k) = ibset(key(k),j)
  accu = 0
  do k = 1, N_int

src/bitmask/bitmasks_routines.irp.f

@@ -87,10 +87,11 @@ subroutine list_to_bitstring( string, list, n_elements, Nint)
   do i=1,n_elements
 IRP_IF WITHOUT_SHIFTRL
     iint = ishft(list(i)-1,-bit_kind_shift) + 1
+    ipos = list(i)-ishft((iint-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
+IRP_ENDIF
     string(iint) = ibset( string(iint), ipos )
   enddo
 
@@ -123,7 +124,11 @@ subroutine bitstring_to_str( output, string, Nint )
         output(ibuf:ibuf) = '-'
       endif
       ibuf = ibuf+1
+IRP_IF WITHOUT_SHIFTRL
+      itemp = ishft(itemp,1)
+IRP_ELSE
       itemp = shiftl(itemp,1)
+IRP_ENDIF
     enddo
   enddo
   output(ibuf:ibuf) = '|'
@@ -157,7 +162,11 @@ subroutine configuration_to_str( output, string, Nint )
         output(ibuf:ibuf) = '0'
       endif
       ibuf = ibuf+1
+IRP_IF WITHOUT_SHIFTRL
+      itemp = ishft(itemp,1)
+IRP_ELSE
       itemp = shiftl(itemp,1)
+IRP_ENDIF
     enddo
   enddo
   output(ibuf:ibuf) = '|'

src/bitmask/find_hole.irp.f

@@ -12,10 +12,11 @@ logical function is_the_hole_in_det(key_in,ispin,i_hole)
  enddo
 IRP_IF WITHOUT_SHIFTRL
  k = ishft(i_hole-1,-bit_kind_shift)+1
+ j = i_hole-ishft(k-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
+IRP_ENDIF
  itest(k) = ibset(itest(k),j)
  j = 0
  do i = 1, N_int
@@ -44,10 +45,11 @@ logical function is_the_particl_in_det(key_in,ispin,i_particl)
  enddo
 IRP_IF WITHOUT_SHIFTRL
  k = ishft(i_particl-1,-bit_kind_shift)+1
+ j = i_particl-ishft(k-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
+IRP_ENDIF
  itest(k) = ibset(itest(k),j)
  j = 0
  do i = 1, N_int

src/bitmask/modify_bitmasks.irp.f

@@ -23,10 +23,11 @@ subroutine modify_bitmasks_for_hole(i_hole)
 
 IRP_IF WITHOUT_SHIFTRL
  k = ishft(i_hole-1,-bit_kind_shift)+1
+ j = i_hole-ishft(k-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
+IRP_ENDIF
  do l = 1, 3
    i = index_holes_bitmask(l)
    do ispin=1,2
@@ -48,10 +49,11 @@ subroutine modify_bitmasks_for_hole_in_out(i_hole)
 
 IRP_IF WITHOUT_SHIFTRL
  k = ishft(i_hole-1,-bit_kind_shift)+1
+ j = i_hole-ishft(k-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
+IRP_ENDIF
  do l = 1, 3
    i = index_holes_bitmask(l)
    do ispin=1,2
@@ -83,10 +85,11 @@ subroutine modify_bitmasks_for_particl(i_part)
 
 IRP_IF WITHOUT_SHIFTRL
  k = ishft(i_part-1,-bit_kind_shift)+1
+ j = i_part-ishft(k-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
+IRP_ENDIF
  do l = 1, 3
    i = index_particl_bitmask(l)
    do ispin=1,2

src/cipsi/selection.irp.f

@@ -12,6 +12,20 @@ subroutine get_mask_phase(det1, pm, Nint)
   tmp1 = 0_8
   tmp2 = 0_8
   do i=1,Nint
+IRP_IF WITHOUT_SHIFTRL
+    pm(i,1) = ieor(pm(i,1), ishft(pm(i,1), 1))
+    pm(i,2) = ieor(pm(i,2), ishft(pm(i,2), 1))
+    pm(i,1) = ieor(pm(i,1), ishft(pm(i,1), 2))
+    pm(i,2) = ieor(pm(i,2), ishft(pm(i,2), 2))
+    pm(i,1) = ieor(pm(i,1), ishft(pm(i,1), 4))
+    pm(i,2) = ieor(pm(i,2), ishft(pm(i,2), 4))
+    pm(i,1) = ieor(pm(i,1), ishft(pm(i,1), 8))
+    pm(i,2) = ieor(pm(i,2), ishft(pm(i,2), 8))
+    pm(i,1) = ieor(pm(i,1), ishft(pm(i,1), 16))
+    pm(i,2) = ieor(pm(i,2), ishft(pm(i,2), 16))
+    pm(i,1) = ieor(pm(i,1), ishft(pm(i,1), 32))
+    pm(i,2) = ieor(pm(i,2), ishft(pm(i,2), 32))
+IRP_ELSE
     pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 1))
     pm(i,2) = ieor(pm(i,2), shiftl(pm(i,2), 1))
     pm(i,1) = ieor(pm(i,1), shiftl(pm(i,1), 2))
@@ -24,6 +38,7 @@ subroutine get_mask_phase(det1, pm, Nint)
     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))
+IRP_ENDIF
     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)

src/csf/configurations.irp.f

@@ -107,7 +107,11 @@ IRP_ENDIF
     n_alpha_in_single = n_alpha_in_single - popcnt( o(i,2) )
   enddo
 
+IRP_IF WITHOUT_SHIFTRL
+  v = ishft(1,n_alpha_in_single) - 1
+IRP_ELSE
   v = shiftl(1,n_alpha_in_single) - 1
+IRP_ENDIF
 
   ! Initialize first determinant
   d(:,1,1) = o(:,2)
@@ -123,7 +127,11 @@ IRP_ENDIF
 
   sze = int(binom_int(n,n_alpha_in_single),4)
 
+IRP_IF WITHOUT_SHIFTRL
+  if ( (ishft(n_alpha_in_single,1) == n).and.n>0 ) then
+IRP_ELSE
   if ( (shiftl(n_alpha_in_single,1) == n).and.n>0 ) then
+IRP_ENDIF
 
     ! Time reversal symmetry
     d(:,1,2) = d(:,2,1)
@@ -265,7 +273,11 @@ IRP_ENDIF
     n_alpha_in_single = n_alpha_in_single - popcnt( o(i,2) )
   enddo
 
+IRP_IF WITHOUT_SHIFTRL
+  v = ishft(1,n_alpha_in_single) - 1
+IRP_ELSE
   v = shiftl(1,n_alpha_in_single) - 1
+IRP_ENDIF
 
   ! Initialize first determinant
   d(:,1,1) = o(:,2)
@@ -281,7 +293,11 @@ IRP_ENDIF
 
   sze = int(binom_int(n,n_alpha_in_single),4)
 
+IRP_IF WITHOUT_SHIFTRL
+  if ( (ishft(n_alpha_in_single,1) == n).and.n>0 ) then
+IRP_ELSE
   if ( (shiftl(n_alpha_in_single,1) == n).and.n>0 ) then
+IRP_ENDIF
 
     ! Time reversal symmetry
     d(:,1,sze) = d(:,2,1)

src/csf/connected_to_ref.irp.f

@@ -28,7 +28,11 @@ IRP_ENDIF
     n_open_shells = n_open_shells + popcnt(cfg(i,1))
   enddo
   mask = n_open_shells
+IRP_IF WITHOUT_SHIFTRL
+  mask = ishft(mask,56)
+IRP_ELSE
   mask = shiftl(mask,56)
+IRP_ENDIF
   configuration_search_key = ior (mask,configuration_search_key)
 
 end

src/csf/create_excitations.irp.f

@@ -21,10 +21,11 @@ subroutine do_single_excitation_cfg(key_in,key_out,i_hole,i_particle,ok)
   ! hole
 IRP_IF WITHOUT_SHIFTRL
   k = ishft(i_hole-1,-bit_kind_shift)+1
+  j = i_hole-ishft(k-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
+IRP_ENDIF
   mask = ibset(0_bit_kind,j)
 
   ! Check if the position j is singly occupied
@@ -52,10 +53,11 @@ IRP_ENDIF
   ! particle
 IRP_IF WITHOUT_SHIFTRL
   k = ishft(i_particle-1,-bit_kind_shift)+1
+  j = i_particle-ishft(k-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
+IRP_ENDIF
   mask = ibset(0_bit_kind,j)
 
   ! Check if the position j is singly occupied
@@ -119,10 +121,11 @@ subroutine do_single_excitation_cfg_with_type(key_in,key_out,i_hole,i_particle,e
   ! hole
 IRP_IF WITHOUT_SHIFTRL
   k = ishft(i_hole-1,-bit_kind_shift)+1
+  j = i_hole-ishft(k-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
+IRP_ENDIF
   mask = ibset(0_bit_kind,j)
 
   ! Check if the position j is singly occupied
@@ -152,10 +155,11 @@ IRP_ENDIF
   ! particle
 IRP_IF WITHOUT_SHIFTRL
   k = ishft(i_particle-1,-bit_kind_shift)+1
+  j = i_particle-ishft(k-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
+IRP_ENDIF
   mask = ibset(0_bit_kind,j)
 
   ! Check if the position j is singly occupied

src/csf/sigma_vector.irp.f

@@ -106,7 +106,11 @@ IRP_ENDIF
       detb(k) = ibclr(detb(k),ipos)
 
       ! Create a mask will all MOs higher than the beta electron
+IRP_IF WITHOUT_SHIFTRL
+      mask = not(ishft(1_bit_kind,ipos + 1) - 1_bit_kind)
+IRP_ELSE
       mask = not(shiftl(1_bit_kind,ipos + 1) - 1_bit_kind)
+IRP_ENDIF
 
       ! Apply the mask to the alpha string to count how many electrons to cross
       nperm = popcnt( iand(mask, deta(k)) )

src/determinants/create_excitations.irp.f

@@ -20,10 +20,11 @@ subroutine do_single_excitation(key_in,i_hole,i_particle,ispin,i_ok)
   ! hole
 IRP_IF WITHOUT_SHIFTRL
   k = ishft(i_hole-1,-bit_kind_shift)+1
+  j = i_hole-ishft(k-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
+IRP_ENDIF
   mask = ibset(0_bit_kind,j)
 ! check whether position j is occupied
   if (iand(key_in(k,ispin),mask) /= 0_bit_kind) then
@@ -36,10 +37,11 @@ IRP_ENDIF
   ! particle
 IRP_IF WITHOUT_SHIFTRL
   k = ishft(i_particle-1,-bit_kind_shift)+1
+  j = i_particle-ishft(k-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
+IRP_ENDIF
   mask = ibset(0_bit_kind,j)
   if (iand(key_in(k,ispin),mask) == 0_bit_kind) then
    key_in(k,ispin) = ibset(key_in(k,ispin),j)
@@ -102,10 +104,11 @@ logical function is_spin_flip_possible(key_in,i_flip,ispin)
   key_tmp = 0_bit_kind
 IRP_IF WITHOUT_SHIFTRL
   k = ishft(i_flip-1,-bit_kind_shift)+1
+  j = i_flip-ishft(k-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
+IRP_ENDIF
   key_tmp(k,1) = ibset(key_tmp(k,1),j)
   integer                        :: other_spin(2)
   other_spin(1) = 2

src/determinants/determinants.irp.f

@@ -802,39 +802,46 @@ subroutine apply_excitation(det, exc, res, ok, Nint)
 
 IRP_IF WITHOUT_SHIFTRL
   ii = ishft(h1-1,-bit_kind_shift) + 1
+  pos = h1-1-ishft(ii-1,bit_kind_shift)
 IRP_ELSE
   ii = shiftr(h1-1,bit_kind_shift) + 1
-IRP_ENDIF
   pos = h1-1-shiftl(ii-1,bit_kind_shift)
+IRP_ENDIF
   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
+  pos = p1-1-ishft(ii-1,bit_kind_shift)
+  if(iand(det(ii, s1),ishft(1_bit_kind, pos)) /= 0_8) return
 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
+IRP_ENDIF
   res(ii, s1) = ibset(res(ii, s1), pos)
 
   if(degree == 2) then
 IRP_IF WITHOUT_SHIFTRL
     ii = ishft(h2-1,-bit_kind_shift) + 1
+    pos = h2-1-ishft(ii-1,bit_kind_shift)
+    if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return
 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
+IRP_ENDIF
     res(ii, s2) = ibclr(res(ii, s2), pos)
 
 IRP_IF WITHOUT_SHIFTRL
     ii = ishft(p2-1,-bit_kind_shift) + 1
+    pos = p2-1-ishft(ii-1,bit_kind_shift)
+    if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return
 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
+IRP_ENDIF
     res(ii, s2) = ibset(res(ii, s2), pos)
   endif
   ok = .true.
@@ -857,21 +864,25 @@ subroutine apply_particles(det, s1, p1, s2, p2, res, ok, Nint)
   if(p1 /= 0) then
 IRP_IF WITHOUT_SHIFTRL
     ii =ishft(p1-1,-bit_kind_shift) + 1
+    pos = p1-1-ishft(ii-1,bit_kind_shift)
+    if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return
 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
+IRP_ENDIF
     res(ii, s1) = ibset(res(ii, s1), pos)
   end if
 
 IRP_IF WITHOUT_SHIFTRL
   ii = ishft(p2-1,-bit_kind_shift) + 1
+  pos = p2-1-ishft(ii-1,bit_kind_shift)
+  if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return
 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
+IRP_ENDIF
   res(ii, s2) = ibset(res(ii, s2), pos)
 
   ok = .true.
@@ -894,21 +905,25 @@ subroutine apply_holes(det, s1, h1, s2, h2, res, ok, Nint)
   if(h1 /= 0) then
 IRP_IF WITHOUT_SHIFTRL
     ii = ishft(h1-1,-bit_kind_shift) + 1
+    pos = h1-1-ishft(ii-1,bit_kind_shift)
+    if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return
 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
+IRP_ENDIF
     res(ii, s1) = ibclr(res(ii, s1), pos)
   end if
 
 IRP_IF WITHOUT_SHIFTRL
   ii = ishft(h2-1,-bit_kind_shift) + 1
+  pos = h2-1-ishft(ii-1,bit_kind_shift)
+  if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return
 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
+IRP_ENDIF
   res(ii, s2) = ibclr(res(ii, s2), pos)
 
   ok = .true.
@@ -929,11 +944,13 @@ subroutine apply_particle(det, s1, p1, res, ok, Nint)
 
 IRP_IF WITHOUT_SHIFTRL
   ii = ishft(p1-1,-bit_kind_shift) + 1
+  pos = p1-1-ishft(ii-1,bit_kind_shift)
+  if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return
 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
+IRP_ENDIF
   res(ii, s1) = ibset(res(ii, s1), pos)
 
   ok = .true.
@@ -955,11 +972,13 @@ subroutine apply_hole(det, s1, h1, res, ok, Nint)
 
 IRP_IF WITHOUT_SHIFTRL
   ii = ishft(h1-1,-bit_kind_shift) + 1
+  pos = h1-1-ishft(ii-1,bit_kind_shift)
+  if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return
 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
+IRP_ENDIF
   res(ii, s1) = ibclr(res(ii, s1), pos)
 
   ok = .true.

src/determinants/h_apply.template.f

@@ -100,8 +100,8 @@ subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2,
     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))
+  p1_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) = ishft(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))
+  p2_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) = ishft(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))
@@ -113,8 +113,8 @@ IRP_ENDIF
   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(fh1-1,-bit_kind_shift) + 1, fs1) -= ishft(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))
+  key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= ishft(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))
@@ -240,20 +240,22 @@ 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
+      j = i_a-ishft(k-1,bit_kind_shift)-1
+      hole(k,ispin) = ibclr(hole(k,ispin),j)
+      k_a = ishft(j_a-1,-bit_kind_shift)+1
+      l_a = j_a-ishft(k_a-1,bit_kind_shift)-1
+      hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a)
 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)
+IRP_ENDIF
 
       !!!! Second couple hole particle
       do j = 1, N_int
@@ -298,21 +300,25 @@ IRP_ENDIF
           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
+          j = i_b-ishft(k-1,bit_kind_shift)-1
+          hole(k,other_spin) = ibclr(hole(k,other_spin),j)
+          key = hole
+          k = ishft(j_b-1,-bit_kind_shift)+1
+          l = j_b-ishft(k-1,bit_kind_shift)-1
+          key(k,other_spin) = ibset(key(k,other_spin),l)
 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)
+IRP_ENDIF
+
           $filter2h2p_double
           $filter_only_1h1p_double
           $filter_only_1h2p_double
@@ -362,21 +368,25 @@ IRP_ENDIF
         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
+        j = i_b-ishft(k-1,bit_kind_shift)-1
+        hole(k,ispin) = ibclr(hole(k,ispin),j)
+        key = hole
+        k = ishft(j_b-1,-bit_kind_shift)+1
+        l = j_b-ishft(k-1,bit_kind_shift)-1
+        key(k,ispin) = ibset(key(k,ispin),l)
 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)
+IRP_ENDIF
+
         $filter2h2p_double
         $filter_only_1h1p_double
         $filter_only_1h2p_double
@@ -524,18 +534,20 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,fock_diag_tmp,i_generato
       hole = key_in
 IRP_IF WITHOUT_SHIFTRL
       k = ishft(i_a-1,-bit_kind_shift)+1
+      j = i_a-ishft(k-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
+IRP_ENDIF
   $filterhole
       hole(k,ispin) = ibclr(hole(k,ispin),j)
 IRP_IF WITHOUT_SHIFTRL
       k_a = ishft(j_a-1,-bit_kind_shift)+1
+      l_a = j_a-ishft(k_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
+IRP_ENDIF
   $filterparticle
       hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a)
       $only_2p_single

src/determinants/slater_rules.irp.f

@@ -43,7 +43,11 @@ subroutine get_excitation_degree(key1,key2,degree,Nint)
 
     case default
       integer :: lmax
+IRP_IF WITHOUT_SHIFTRL
+      lmax = ishft(Nint,1)
+IRP_ELSE
       lmax = shiftl(Nint,1)
+IRP_ENDIF
       do l=1,lmax
         xorvec(l) = xor( key1(l), key2(l))
       enddo
@@ -262,16 +266,31 @@ IRP_ENDIF
         n = iand(low,bit_kind_size-1)
 
         if (j==k) then
+IRP_IF WITHOUT_SHIFTRL
+          nperm = nperm + popcnt(iand(det1(j,ispin),           &
+              iand( ishft(1_bit_kind,m)-1_bit_kind,            &
+                    not(ishft(1_bit_kind,n))+1_bit_kind)) )
+IRP_ELSE
           nperm = nperm + popcnt(iand(det1(j,ispin),           &
               iand( shiftl(1_bit_kind,m)-1_bit_kind,            &
                     not(shiftl(1_bit_kind,n))+1_bit_kind)) )
+IRP_ENDIF
         else
+IRP_IF WITHOUT_SHIFTRL
+          nperm = nperm + popcnt(                                    &
+               iand(det1(j,ispin),                                   &
+                    iand(not(0_bit_kind),                            &
+                         (not(ishft(1_bit_kind,n)) + 1_bit_kind) ))) &
+               + popcnt(iand(det1(k,ispin),                          &
+                             (ishft(1_bit_kind,m) - 1_bit_kind ) ))
+IRP_ELSE
           nperm = nperm + popcnt(                                    &
                iand(det1(j,ispin),                                   &
                     iand(not(0_bit_kind),                            &
                          (not(shiftl(1_bit_kind,n)) + 1_bit_kind) ))) &
                + popcnt(iand(det1(k,ispin),                          &
                              (shiftl(1_bit_kind,m) - 1_bit_kind ) ))
+IRP_ENDIF
 
           do i=j+1,k-1
             nperm = nperm + popcnt(det1(i,ispin))
@@ -299,16 +318,31 @@ IRP_ENDIF
           n = iand(low,bit_kind_size-1)
 
           if (j==k) then
+IRP_IF WITHOUT_SHIFTRL
+            nperm = nperm + popcnt(iand(det1(j,ispin),           &
+               iand( ishft(1_bit_kind,m)-1_bit_kind,             &
+                     not(ishft(1_bit_kind,n))+1_bit_kind)) )
+IRP_ELSE
             nperm = nperm + popcnt(iand(det1(j,ispin),           &
                iand( shiftl(1_bit_kind,m)-1_bit_kind,            &
                      not(shiftl(1_bit_kind,n))+1_bit_kind)) )
+IRP_ENDIF
           else
+IRP_IF WITHOUT_SHIFTRL
+            nperm = nperm + popcnt(                                    &
+                 iand(det1(j,ispin),                                   &
+                      iand(not(0_bit_kind),                            &
+                           (not(ishft(1_bit_kind,n)) + 1_bit_kind) ))) &
+                 + popcnt(iand(det1(k,ispin),                          &
+                          (ishft(1_bit_kind,m) - 1_bit_kind ) ))
+IRP_ELSE
             nperm = nperm + popcnt(                                    &
                  iand(det1(j,ispin),                                   &
                       iand(not(0_bit_kind),                            &
                            (not(shiftl(1_bit_kind,n)) + 1_bit_kind) )))&
                  + popcnt(iand(det1(k,ispin),                          &
                           (shiftl(1_bit_kind,m) - 1_bit_kind ) ))
+IRP_ENDIF
 
             do i=j+1,k-1
               nperm = nperm + popcnt(det1(i,ispin))
@@ -344,12 +378,21 @@ subroutine get_phasemask_bit(det1, pm, Nint)
   do ispin=1,2
   tmp = 0_8
   do i=1,Nint
+IRP_IF WITHOUT_SHIFTRL
+    pm(i,ispin) = xor(det1(i,ispin), ishft(det1(i,ispin), 1))
+    pm(i,ispin) = xor(pm(i,ispin), ishft(pm(i,ispin), 2))
+    pm(i,ispin) = xor(pm(i,ispin), ishft(pm(i,ispin), 4))
+    pm(i,ispin) = xor(pm(i,ispin), ishft(pm(i,ispin), 8))
+    pm(i,ispin) = xor(pm(i,ispin), ishft(pm(i,ispin), 16))
+    pm(i,ispin) = xor(pm(i,ispin), ishft(pm(i,ispin), 32))
+IRP_ELSE
     pm(i,ispin) = xor(det1(i,ispin), shiftl(det1(i,ispin), 1))
     pm(i,ispin) = xor(pm(i,ispin), shiftl(pm(i,ispin), 2))
     pm(i,ispin) = xor(pm(i,ispin), shiftl(pm(i,ispin), 4))
     pm(i,ispin) = xor(pm(i,ispin), shiftl(pm(i,ispin), 8))
     pm(i,ispin) = xor(pm(i,ispin), shiftl(pm(i,ispin), 16))
     pm(i,ispin) = xor(pm(i,ispin), shiftl(pm(i,ispin), 32))
+IRP_ENDIF
     pm(i,ispin) = xor(pm(i,ispin), tmp)
     if(iand(popcnt(det1(i,ispin)), 1) == 1) tmp = not(tmp)
   end do
@@ -434,16 +477,31 @@ IRP_ENDIF
       n = iand(low,bit_kind_size-1)
 
       if (j==k) then
+IRP_IF WITHOUT_SHIFTRL
+        nperm = nperm + popcnt(iand(det1(j,ispin),           &
+           iand( ishft(1_bit_kind,m)-1_bit_kind,            &
+                  not(ishft(1_bit_kind,n))+1_bit_kind)) )
+IRP_ELSE
         nperm = nperm + popcnt(iand(det1(j,ispin),           &
             iand( shiftl(1_bit_kind,m)-1_bit_kind,           &
                   not(shiftl(1_bit_kind,n))+1_bit_kind)) )
+IRP_ENDIF
       else
+IRP_IF WITHOUT_SHIFTRL
+        nperm = nperm + popcnt(                                    &
+             iand(det1(j,ispin),                                   &
+                  iand(not(0_bit_kind),                            &
+                       (not(ishft(1_bit_kind,n)) + 1_bit_kind) ))) &
+             + popcnt(iand(det1(k,ispin),                          &
+                           (ishft(1_bit_kind,m) - 1_bit_kind ) ))
+IRP_ELSE
         nperm = nperm + popcnt(                                    &
              iand(det1(j,ispin),                                   &
                   iand(not(0_bit_kind),                            &
                        (not(shiftl(1_bit_kind,n)) + 1_bit_kind) ))) &
              + popcnt(iand(det1(k,ispin),                          &
                            (shiftl(1_bit_kind,m) - 1_bit_kind ) ))
+IRP_ENDIF
 
         do i=j+1,k-1
           nperm = nperm + popcnt(det1(i,ispin))
@@ -1887,7 +1945,11 @@ IRP_ELSE
   k = shiftr(iorb-1,bit_kind_shift)+1
 IRP_ENDIF
   ASSERT (k>0)
+IRP_IF WITHOUT_SHIFTRL
+  l = iorb - ishft(k-1,bit_kind_shift)-1
+IRP_ELSE
   l = iorb - shiftl(k-1,bit_kind_shift)-1
+IRP_ENDIF
   key(k,ispin) = ibclr(key(k,ispin),l)
   other_spin = iand(ispin,1)+1
 
@@ -1952,7 +2014,11 @@ IRP_ELSE
   k = shiftr(iorb-1,bit_kind_shift)+1
 IRP_ENDIF
   ASSERT (k >0)
+IRP_IF WITHOUT_SHIFTRL
+  l = iorb - ishft(k-1,bit_kind_shift)-1
+IRP_ELSE
   l = iorb - shiftl(k-1,bit_kind_shift)-1
+IRP_ENDIF
   ASSERT (l >= 0)
   key(k,ispin) = ibset(key(k,ispin),l)
   other_spin = iand(ispin,1)+1

src/mo_two_e_ints/map_integrals.irp.f

@@ -73,9 +73,15 @@ BEGIN_PROVIDER [ double precision, mo_integrals_cache, (0_8:128_8*128_8*128_8*12
          !DIR$ FORCEINLINE
          call map_get(mo_integrals_map,idx,integral)
          ii = l-mo_integrals_cache_min_8
+IRP_IF WITHOUT_SHIFTRL
+         ii = ior( ishft(ii,7), k-mo_integrals_cache_min_8)
+         ii = ior( ishft(ii,7), j-mo_integrals_cache_min_8)
+         ii = ior( ishft(ii,7), i-mo_integrals_cache_min_8)
+IRP_ELSE
          ii = ior( shiftl(ii,7), k-mo_integrals_cache_min_8)
          ii = ior( shiftl(ii,7), j-mo_integrals_cache_min_8)
          ii = ior( shiftl(ii,7), i-mo_integrals_cache_min_8)
+IRP_ENDIF
          mo_integrals_cache(ii) = integral
        enddo
      enddo
@@ -121,9 +127,15 @@ double precision function get_two_e_integral(i,j,k,l,map)
     get_two_e_integral = dble(tmp)
   else
     ii_8 = int(l,8)-mo_integrals_cache_min_8
+IRP_IF WITHOUT_SHIFTRL
+    ii_8 = ior( ishft(ii_8,7), int(k,8)-mo_integrals_cache_min_8)
+    ii_8 = ior( ishft(ii_8,7), int(j,8)-mo_integrals_cache_min_8)
+    ii_8 = ior( ishft(ii_8,7), int(i,8)-mo_integrals_cache_min_8)
+IRP_ELSE
     ii_8 = ior( shiftl(ii_8,7), int(k,8)-mo_integrals_cache_min_8)
     ii_8 = ior( shiftl(ii_8,7), int(j,8)-mo_integrals_cache_min_8)
     ii_8 = ior( shiftl(ii_8,7), int(i,8)-mo_integrals_cache_min_8)
+IRP_ENDIF
     get_two_e_integral = mo_integrals_cache(ii_8)
   endif
 end
@@ -179,8 +191,13 @@ subroutine get_mo_two_e_integrals(j,k,l,sze,out_val,map)
   ii0 = ior(ii0, j-mo_integrals_cache_min)
 
   ii0_8 = int(l,8)-mo_integrals_cache_min_8
+IRP_IF WITHOUT_SHIFTRL
+  ii0_8 = ior( ishft(ii0_8,7), int(k,8)-mo_integrals_cache_min_8)
+  ii0_8 = ior( ishft(ii0_8,7), int(j,8)-mo_integrals_cache_min_8)
+IRP_ELSE
   ii0_8 = ior( shiftl(ii0_8,7), int(k,8)-mo_integrals_cache_min_8)
   ii0_8 = ior( shiftl(ii0_8,7), int(j,8)-mo_integrals_cache_min_8)
+IRP_ENDIF
 
   q = min(j,l)
   s = max(j,l)
@@ -194,7 +211,11 @@ IRP_ENDIF
     if (banned_excitation(i,k)) cycle
     ii = ior(ii0, i-mo_integrals_cache_min)
     if (iand(ii, -128) == 0) then
+IRP_IF WITHOUT_SHIFTRL
+      ii_8 = ior( ishft(ii0_8,7), int(i,8)-mo_integrals_cache_min_8)
+IRP_ELSE
       ii_8 = ior( shiftl(ii0_8,7), int(i,8)-mo_integrals_cache_min_8)
+IRP_ENDIF
       out_val(i) = mo_integrals_cache(ii_8)
     else
       p = min(i,k)

src/utils/integration.irp.f

@@ -614,7 +614,7 @@ double precision function rint1(n,rho)
   rho_tmp = 1.d0
   do k=1,20
     rho_tmp = -rho_tmp*rho
-    diff=rho_tmp*fact_inv(k)*inv_int(shiftl(k+n,1)+1)
+    diff=rho_tmp*fact_inv(k)*inv_int(ishft(k+n,1)+1)
     rint1=rint1+diff
     if (dabs(diff) > eps) then
       cycle

src/utils/sort.irp.f

@@ -140,7 +140,11 @@ IRP_ENDIF
       endif
     endif
     i=l
+IRP_IF WITHOUT_SHIFTRL
+    j = ishft(l,1)
+IRP_ELSE
     j = shiftl(l,1)
+IRP_ENDIF
     do while (j<k)
       if ( x(j) < x(j+1) ) then
         j=j+1
@@ -149,7 +153,11 @@ IRP_ENDIF
         x(i) = x(j)
         iorder(i) = iorder(j)
         i = j
+IRP_IF WITHOUT_SHIFTRL
+        j = ishft(j,1)
+IRP_ELSE
         j = shiftl(j,1)
+IRP_ENDIF
       else
         j = k+1
       endif
@@ -159,7 +167,11 @@ IRP_ENDIF
         x(i) = x(j)
         iorder(i) = iorder(j)
         i = j
+IRP_IF WITHOUT_SHIFTRL
+        j = ishft(j,1)
+IRP_ELSE
         j = shiftl(j,1)
+IRP_ENDIF
       else
         j = k+1
       endif
@@ -205,7 +217,11 @@ IRP_ENDIF
       endif
     endif
     i=l
+IRP_IF WITHOUT_SHIFTRL
+    j = ishft(l,1)
+IRP_ELSE
     j = shiftl(l,1)
+IRP_ENDIF
     do while (j<k)
       if ( x(j) < x(j+1) ) then
         j=j+1
@@ -214,7 +230,11 @@ IRP_ENDIF
         x(i) = x(j)
         iorder(i) = iorder(j)
         i = j
+IRP_IF WITHOUT_SHIFTRL
+        j = ishft(j,1)
+IRP_ELSE
         j = shiftl(j,1)
+IRP_ENDIF
       else
         j = k+1
       endif
@@ -224,7 +244,11 @@ IRP_ENDIF
         x(i) = x(j)
         iorder(i) = iorder(j)
         i = j
+IRP_IF WITHOUT_SHIFTRL
+        j = ishft(j,1)
+IRP_ELSE
         j = shiftl(j,1)
+IRP_ENDIF
       else
         j = k+1
       endif