diff --git a/src/Dets/H_apply_template.f b/src/Dets/H_apply_template.f index 73059635..b3984448 100644 --- a/src/Dets/H_apply_template.f +++ b/src/Dets/H_apply_template.f @@ -447,8 +447,8 @@ subroutine $subroutine($params_main) !$OMP END PARALLEL !$ call omp_destroy_lock(lck) + allocate( mask(N_int,2,6) ) ! do i_generator=1,N_det_generators - do i_generator=nmax+1,N_det_generators diff --git a/src/Dets/connected_to_ref.irp.f b/src/Dets/connected_to_ref.irp.f index 6d7dcab1..2f01a8e0 100644 --- a/src/Dets/connected_to_ref.irp.f +++ b/src/Dets/connected_to_ref.irp.f @@ -1,3 +1,18 @@ +integer*8 function det_search_key(det,Nint) + use bitmasks + implicit none + BEGIN_DOC +! Return an integer*8 corresponding to a determinant index for searching + END_DOC + integer, intent(in) :: Nint + integer(bit_kind), intent(in) :: det(Nint,2) + integer :: i + det_search_key = iand(det(1,1),det(1,2)) + do i=2,Nint + det_search_key = ieor(det_search_key,iand(det(i,1),det(i,2))) + enddo +end + logical function is_in_wavefunction(key,Nint,Ndet) implicit none @@ -12,12 +27,15 @@ logical function is_in_wavefunction(key,Nint,Ndet) ibegin = 1 iend = N_det+1 + !DIR$ FORCEINLINE det_ref = det_search_key(key,Nint) + !DIR$ FORCEINLINE det_search = det_search_key(psi_det_sorted_bit(1,1,1),Nint) istep = ishft(iend-ibegin,-1) i=ibegin+istep do while (istep > 0) + !DIR$ FORCEINLINE det_search = det_search_key(psi_det_sorted_bit(1,1,i),Nint) if ( det_search > det_ref ) then iend = i @@ -30,6 +48,7 @@ logical function is_in_wavefunction(key,Nint,Ndet) i = ibegin + istep end do + !DIR$ FORCEINLINE do while (det_search_key(psi_det_sorted_bit(1,1,i),Nint) == det_ref) i = i-1 if (i == 0) then @@ -41,6 +60,7 @@ logical function is_in_wavefunction(key,Nint,Ndet) return endif + !DIR$ FORCEINLINE do while (det_search_key(psi_det_sorted_bit(1,1,i),Nint) == det_ref) if ( (key(1,1) /= psi_det_sorted_bit(1,1,i)).or. & (key(1,2) /= psi_det_sorted_bit(1,2,i)) ) then @@ -116,7 +136,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet) N_past = max(1,N_past_in) if (Nint == 1) then - do i=1,N_past-1 + do i=N_past-1,1,-1 degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + & popcnt(xor( key(1,2), keys(1,2,i))) if (degree_x2 > 4) then @@ -132,7 +152,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet) else if (Nint==2) then - do i=1,N_past-1 + do i=N_past-1,1,-1 degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + & popcnt(xor( key(1,2), keys(1,2,i))) + & popcnt(xor( key(2,1), keys(2,1,i))) + & @@ -149,7 +169,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet) else if (Nint==3) then - do i=1,N_past-1 + do i=N_past-1,1,-1 degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + & popcnt(xor( key(1,2), keys(1,2,i))) + & popcnt(xor( key(2,1), keys(2,1,i))) + & @@ -168,7 +188,7 @@ integer function connected_to_ref(key,keys,Nint,N_past_in,Ndet) else - do i=1,N_past-1 + do i=N_past-1,1,-1 degree_x2 = popcnt(xor( key(1,1), keys(1,1,i))) + & popcnt(xor( key(1,2), keys(1,2,i))) !DEC$ LOOP COUNT MIN(3) diff --git a/src/Dets/determinants.irp.f b/src/Dets/determinants.irp.f index 913b6a7d..f7ec2dfc 100644 --- a/src/Dets/determinants.irp.f +++ b/src/Dets/determinants.irp.f @@ -292,21 +292,6 @@ END_PROVIDER END_PROVIDER -integer*8 function det_search_key(det,Nint) - use bitmasks - implicit none - BEGIN_DOC -! Return an integer*8 corresponding to a determinant index for searching - END_DOC - integer, intent(in) :: Nint - integer(bit_kind), intent(in) :: det(Nint,2) - integer :: i - det_search_key = iand(det(1,1),det(1,2)) - do i=2,Nint - det_search_key = ieor(det_search_key,iand(det(i,1),det(i,2))) - enddo -end - subroutine save_wavefunction implicit none use bitmasks diff --git a/src/Full_CI/README.rst b/src/Full_CI/README.rst index f63f5a06..38b30dea 100644 --- a/src/Full_CI/README.rst +++ b/src/Full_CI/README.rst @@ -10,6 +10,9 @@ Documentation .. Do not edit this section. It was auto-generated from the .. NEEDED_MODULES file. +`full_ci `_ + Undocumented + Needed Modules diff --git a/src/Full_CI/full_ci.irp.f b/src/Full_CI/full_ci.irp.f index 51c20b87..a389e616 100644 --- a/src/Full_CI/full_ci.irp.f +++ b/src/Full_CI/full_ci.irp.f @@ -1,4 +1,4 @@ -program cisd +program full_ci implicit none integer :: i,k diff --git a/src/Perturbation/perturbation_template.f b/src/Perturbation/perturbation_template.f index ac9c018d..a450edff 100644 --- a/src/Perturbation/perturbation_template.f +++ b/src/Perturbation/perturbation_template.f @@ -25,15 +25,16 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c ASSERT (N_st > 0) do i = 1,buffer_size - if (is_in_wavefunction(buffer(1,1,i),Nint,N_det)) then - cycle - endif c_ref = connected_to_ref(buffer(1,1,i),psi_generators,Nint,i_generator,N_det) if (c_ref /= 0) then cycle endif + if (is_in_wavefunction(buffer(1,1,i),Nint,N_det)) then + cycle + endif + call pt2_$PERT(buffer(1,1,i), & c_pert,e_2_pert,H_pert_diag,Nint,N_det_selectors,n_st)