diff --git a/src/ao_two_e_ints/map_integrals.irp.f b/src/ao_two_e_ints/map_integrals.irp.f index 4f171596..b993ea2f 100644 --- a/src/ao_two_e_ints/map_integrals.irp.f +++ b/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 - 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 + k(1) = ceiling(0.5d0*(dsqrt(dble(ishft(i3,3)+1))-1.d0)) 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 @@ -166,7 +163,7 @@ subroutine ao_idx2_sq(i,j,ij) ij=i*i endif end - + subroutine idx2_tri_int(i,j,ij) implicit none integer, intent(in) :: i,j @@ -176,7 +173,7 @@ subroutine idx2_tri_int(i,j,ij) q = min(i,j) ij = q+ishft(p*p-p,-1) end - + subroutine ao_idx2_tri_key(i,j,ij) use map_module implicit none @@ -187,8 +184,8 @@ subroutine ao_idx2_tri_key(i,j,ij) q = min(i,j) ij = q+ishft(p*p-p,-1) end - -subroutine two_e_integrals_index_2fold(i,j,k,l,i1) + +subroutine two_e_integrals_index_2fold(i,j,k,l,i1) use map_module implicit none integer, intent(in) :: i,j,k,l @@ -200,7 +197,7 @@ subroutine two_e_integrals_index_2fold(i,j,k,l,i1) call ao_idx2_tri_key(ik,jl,i1) end -subroutine ao_idx2_sq_rev(i,k,ik) +subroutine ao_idx2_sq_rev(i,k,ik) BEGIN_DOC ! reverse square compound index END_DOC @@ -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 @@ -420,11 +429,17 @@ BEGIN_PROVIDER [ complex*16, ao_integrals_cache_periodic, (0:64*64*64*64) ] tmp_im = 0.d0 integral = dcmplx(tmp_re,tmp_im) 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 @@ -495,7 +516,7 @@ subroutine get_ao_two_e_integrals(j,k,l,sze,out_val) BEGIN_DOC ! Gets multiple AO bi-electronic integral from the AO map . ! All i are retrieved for j,k,l fixed. - ! physicist convention : + ! physicist convention : END_DOC implicit none integer, intent(in) :: j,k,l, sze @@ -524,7 +545,7 @@ subroutine get_ao_two_e_integrals_periodic(j,k,l,sze,out_val) BEGIN_DOC ! Gets multiple AO bi-electronic integral from the AO map . ! All i are retrieved for j,k,l fixed. - ! physicist convention : + ! physicist convention : END_DOC implicit none integer, intent(in) :: j,k,l, sze diff --git a/src/ao_two_e_ints/two_e_integrals.irp.f b/src/ao_two_e_ints/two_e_integrals.irp.f index 602f81f5..aa2c4bd6 100644 --- a/src/ao_two_e_ints/two_e_integrals.irp.f +++ b/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 diff --git a/src/bitmask/bitmask_cas_routines.irp.f b/src/bitmask/bitmask_cas_routines.irp.f index b1ba0233..99e52403 100644 --- a/src/bitmask/bitmask_cas_routines.irp.f +++ b/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 diff --git a/src/bitmask/bitmasks_routines.irp.f b/src/bitmask/bitmasks_routines.irp.f index 8ac82b38..e76b8906 100644 --- a/src/bitmask/bitmasks_routines.irp.f +++ b/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) = '|' diff --git a/src/bitmask/find_hole.irp.f b/src/bitmask/find_hole.irp.f index 5b0f8112..97549de0 100644 --- a/src/bitmask/find_hole.irp.f +++ b/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 diff --git a/src/bitmask/modify_bitmasks.irp.f b/src/bitmask/modify_bitmasks.irp.f index 7d685a99..ab722437 100644 --- a/src/bitmask/modify_bitmasks.irp.f +++ b/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 diff --git a/src/cipsi/selection.irp.f b/src/cipsi/selection.irp.f index 62df93ee..14128434 100644 --- a/src/cipsi/selection.irp.f +++ b/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) diff --git a/src/csf/configurations.irp.f b/src/csf/configurations.irp.f index b63084a1..fc2727db 100644 --- a/src/csf/configurations.irp.f +++ b/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) diff --git a/src/csf/connected_to_ref.irp.f b/src/csf/connected_to_ref.irp.f index cdc4c1d9..d970c7a9 100644 --- a/src/csf/connected_to_ref.irp.f +++ b/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 diff --git a/src/csf/create_excitations.irp.f b/src/csf/create_excitations.irp.f index 79b13bdf..6ccf9563 100644 --- a/src/csf/create_excitations.irp.f +++ b/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 diff --git a/src/csf/sigma_vector.irp.f b/src/csf/sigma_vector.irp.f index 8d61f175..d94da669 100644 --- a/src/csf/sigma_vector.irp.f +++ b/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)) ) diff --git a/src/determinants/create_excitations.irp.f b/src/determinants/create_excitations.irp.f index e62d80c2..2b6d879a 100644 --- a/src/determinants/create_excitations.irp.f +++ b/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 diff --git a/src/determinants/determinants.irp.f b/src/determinants/determinants.irp.f index 1b7af56c..9985703a 100644 --- a/src/determinants/determinants.irp.f +++ b/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. diff --git a/src/determinants/h_apply.template.f b/src/determinants/h_apply.template.f index bfe89cbd..7de2b63f 100644 --- a/src/determinants/h_apply.template.f +++ b/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)) - p2_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) = shiftl(one,iand(fh2-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) = 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(fh2-1,-bit_kind_shift) + 1, fs2) -= shiftl(one,iand(fh2-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) -= 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 diff --git a/src/determinants/slater_rules.irp.f b/src/determinants/slater_rules.irp.f index 46a7efa6..cd5e1f8d 100644 --- a/src/determinants/slater_rules.irp.f +++ b/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( shiftl(1_bit_kind,m)-1_bit_kind, & - not(shiftl(1_bit_kind,n))+1_bit_kind)) ) + 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(shiftl(1_bit_kind,n)) + 1_bit_kind) ))) & + (not(ishft(1_bit_kind,n)) + 1_bit_kind) ))) & + popcnt(iand(det1(k,ispin), & - (shiftl(1_bit_kind,m) - 1_bit_kind ) )) + (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( shiftl(1_bit_kind,m)-1_bit_kind, & + 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 diff --git a/src/mo_two_e_ints/map_integrals.irp.f b/src/mo_two_e_ints/map_integrals.irp.f index 73dd417f..54a2fab4 100644 --- a/src/mo_two_e_ints/map_integrals.irp.f +++ b/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) diff --git a/src/utils/integration.irp.f b/src/utils/integration.irp.f index a16c4e88..7f53fd93 100644 --- a/src/utils/integration.irp.f +++ b/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 diff --git a/src/utils/sort.irp.f b/src/utils/sort.irp.f index 1ac96cae..96e0f2b5 100644 --- a/src/utils/sort.irp.f +++ b/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