From 132c74e60b797ae3c18fd375055aeefd4469efae Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 19 Nov 2015 14:38:41 +0100 Subject: [PATCH] minilist simple pour epstein 2x2 --- config/gfortran.cfg | 2 +- plugins/MRCC_Utils/mrcc_dress.irp.f | 92 ++++++++++---------- plugins/Perturbation/epstein_nesbet.irp.f | 10 ++- plugins/Perturbation/perturbation.template.f | 50 ++++++++--- scripts/generate_h_apply.py | 2 +- src/Determinants/slater_rules.irp.f | 71 +++++++++++++-- 6 files changed, 156 insertions(+), 71 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index c1032aa1..192e6d49 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -10,7 +10,7 @@ # # [COMMON] -FC : gfortran -g -ffree-line-length-none -I . +FC : gfortran -g -ffree-line-length-none -mavx -I . LAPACK_LIB : -llapack -lblas IRPF90 : irpf90 IRPF90_FLAGS : --ninja --align=32 diff --git a/plugins/MRCC_Utils/mrcc_dress.irp.f b/plugins/MRCC_Utils/mrcc_dress.irp.f index a5f9e068..b5e14565 100644 --- a/plugins/MRCC_Utils/mrcc_dress.irp.f +++ b/plugins/MRCC_Utils/mrcc_dress.irp.f @@ -14,52 +14,52 @@ BEGIN_PROVIDER [ integer(omp_lock_kind), psi_ref_lock, (psi_det_size) ] END_PROVIDER -subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullList, N_miniList, Nint) - use bitmasks - implicit none - - integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList) - integer, intent(in) :: N_fullList - integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList) - integer,intent(out) :: idx_miniList(N_fullList), N_miniList - integer, intent(in) :: Nint - integer(bit_kind) :: key_mask(Nint, 2) - integer :: ni, i, n_a, n_b, e_a, e_b - - - n_a = 0 - n_b = 0 - do ni=1,nint - n_a = n_a + popcnt(key_mask(ni,1)) - n_b = n_b + popcnt(key_mask(ni,2)) - end do - - if(n_a == 0) then - N_miniList = N_fullList - miniList(:,:,:) = fullList(:,:,:) - do i=1,N_fullList - idx_miniList(i) = i - end do - return - end if - - N_miniList = 0 - - do i=1,N_fullList - e_a = n_a - e_b = n_b - do ni=1,nint - e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1))) - e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2))) - end do - - if(e_a + e_b <= 2) then - N_miniList = N_miniList + 1 - miniList(:,:,N_miniList) = fullList(:,:,i) - idx_miniList(N_miniList) = i - end if - end do -end subroutine +! subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullList, N_miniList, Nint) +! use bitmasks +! implicit none +! +! integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList) +! integer, intent(in) :: N_fullList +! integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList) +! integer,intent(out) :: idx_miniList(N_fullList), N_miniList +! integer, intent(in) :: Nint +! integer(bit_kind) :: key_mask(Nint, 2) +! integer :: ni, i, n_a, n_b, e_a, e_b +! +! +! n_a = 0 +! n_b = 0 +! do ni=1,nint +! n_a = n_a + popcnt(key_mask(ni,1)) +! n_b = n_b + popcnt(key_mask(ni,2)) +! end do +! +! if(n_a == 0) then +! N_miniList = N_fullList +! miniList(:,:,:) = fullList(:,:,:) +! do i=1,N_fullList +! idx_miniList(i) = i +! end do +! return +! end if +! +! N_miniList = 0 +! +! do i=1,N_fullList +! e_a = n_a +! e_b = n_b +! do ni=1,nint +! e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1))) +! e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2))) +! end do +! +! if(e_a + e_b <= 2) then +! N_miniList = N_miniList + 1 +! miniList(:,:,N_miniList) = fullList(:,:,i) +! idx_miniList(N_miniList) = i +! end if +! end do +! end subroutine subroutine mrcc_dress(delta_ij_, delta_ii_, Ndet_ref, Ndet_non_ref,i_generator,n_selected,det_buffer,Nint,iproc,key_mask) diff --git a/plugins/Perturbation/epstein_nesbet.irp.f b/plugins/Perturbation/epstein_nesbet.irp.f index 62cb0cd6..f7b45183 100644 --- a/plugins/Perturbation/epstein_nesbet.irp.f +++ b/plugins/Perturbation/epstein_nesbet.irp.f @@ -42,11 +42,11 @@ subroutine pt2_epstein_nesbet(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_s end -subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st) +subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist) use bitmasks implicit none - integer, intent(in) :: Nint,ndet,N_st - integer(bit_kind), intent(in) :: det_pert(Nint,2) + integer, intent(in) :: Nint,ndet,N_st, idx_minilist(0:N_det_selectors), N_minilist + integer(bit_kind), intent(in) :: det_pert(Nint,2), minilist(Nint,2,N_det_selectors) double precision , intent(out) :: c_pert(N_st),e_2_pert(N_st),H_pert_diag(N_st) double precision :: i_H_psi_array(N_st) @@ -67,7 +67,9 @@ subroutine pt2_epstein_nesbet_2x2(det_pert,c_pert,e_2_pert,H_pert_diag,Nint,ndet ASSERT (Nint > 0) PROVIDE CI_electronic_energy - call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) + !call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) + call i_H_psi(det_pert,minilist,idx_minilist,N_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) + h = diag_H_mat_elem(det_pert,Nint) do i =1,N_st if (i_H_psi_array(i) /= 0.d0) then diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index a5ab12e7..8ac1c51e 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -2,7 +2,7 @@ BEGIN_SHELL [ /usr/bin/env python ] import perturbation END_SHELL -subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint) +subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert,sum_norm_pert,sum_H_pert_diag,N_st,Nint,key_mask) implicit none BEGIN_DOC ! Applly pertubration ``$PERT`` to the buffer of determinants generated in the H_apply @@ -11,25 +11,51 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c integer, intent(in) :: Nint, N_st, buffer_size, i_generator integer(bit_kind), intent(in) :: buffer(Nint,2,buffer_size) + integer(bit_kind),intent(in) :: key_mask(Nint,2) double precision, intent(inout) :: sum_norm_pert(N_st),sum_e_2_pert(N_st) double precision, intent(inout) :: coef_pert_buffer(N_st,buffer_size),e_2_pert_buffer(N_st,buffer_size),sum_H_pert_diag(N_st) double precision :: c_pert(N_st), e_2_pert(N_st), H_pert_diag(N_st) - integer :: i,k, c_ref + integer :: i,k, c_ref, ni, ex integer, external :: connected_to_ref logical, external :: is_in_wavefunction + integer(bit_kind) :: minilist(Nint,2,N_det_selectors) + integer :: idx_minilist(N_det_selectors), N_minilist + + integer(bit_kind) :: minilist_gen(Nint,2,N_det_generators) + integer :: idx_minilist_gen(N_det_generators), N_minilist_gen + + + call create_minilist(key_mask, psi_selectors, miniList, idx_miniList, N_det_selectors, N_minilist, Nint) + call create_minilist(key_mask, psi_det_generators, miniList_gen, idx_miniList_gen, N_det_generators, N_minilist_gen, Nint) + + ASSERT (Nint > 0) ASSERT (Nint == N_int) ASSERT (buffer_size >= 0) ASSERT (minval(sum_norm_pert) >= 0.d0) ASSERT (N_st > 0) - do i = 1,buffer_size - - c_ref = connected_to_ref(buffer(1,1,i),psi_det_generators,Nint,i_generator,N_det_generators) - - if (c_ref /= 0) then - cycle - endif + + buffer_loop : do i = 1,buffer_size + + do k=1,N_minilist_gen + if(idx_minilist_gen(k) >= i_generator) then + exit + end if + ex = 0 + do ni=1,Nint + ex += popcnt(xor(minilist_gen(ni,1,k), buffer(ni,1,i))) + popcnt(xor(minilist_gen(ni,2,k), buffer(ni,2,i))) + end do + if(ex <= 4) then + cycle buffer_loop + end if + end do + +! c_ref = connected_to_ref(buffer(1,1,i),psi_det_generators,Nint,i_generator,N_det_generators) +! +! if (c_ref /= 0) then +! cycle +! endif if (is_in_wavefunction(buffer(1,1,i),Nint)) then cycle @@ -37,8 +63,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c integer :: degree call get_excitation_degree(HF_bitmask,buffer(1,1,i),degree,N_int) +! call pt2_$PERT(buffer(1,1,i), & +! c_pert,e_2_pert,H_pert_diag,Nint,N_det_selectors,n_st,minilist,idx_minilist) call pt2_$PERT(buffer(1,1,i), & - c_pert,e_2_pert,H_pert_diag,Nint,N_det_selectors,n_st) + c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) !!!!!!!!!!!!!!!!! MAUVAISE SIGNATURE PR LES AUTRES PT2_* !!!!! do k = 1,N_st e_2_pert_buffer(k,i) = e_2_pert(k) @@ -48,7 +76,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c sum_H_pert_diag(k) += H_pert_diag(k) enddo - enddo + enddo buffer_loop end diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index b22797f9..4e95e0f1 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -205,7 +205,7 @@ class H_apply(object): """ self.data["keys_work"] = """ call perturb_buffer_%s(i_generator,keys_out,key_idx,e_2_pert_buffer,coef_pert_buffer,sum_e_2_pert, & - sum_norm_pert,sum_H_pert_diag,N_st,N_int) + sum_norm_pert,sum_H_pert_diag,N_st,N_int,key_mask) """%(pert,) self.data["finalization"] = """ """ diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index cf3b8c1e..87846068 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -763,17 +763,65 @@ subroutine i_H_j_verbose(key_i,key_j,Nint,hij,hmono,hdouble) end - -subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array) +subroutine create_minilist(key_mask, fullList, miniList, idx_miniList, N_fullList, N_miniList, Nint) use bitmasks implicit none - integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate + + integer(bit_kind), intent(in) :: fullList(Nint, 2, N_fullList) + integer, intent(in) :: N_fullList + integer(bit_kind),intent(out) :: miniList(Nint, 2, N_fullList) + integer,intent(out) :: idx_miniList(N_fullList), N_miniList + integer, intent(in) :: Nint + integer(bit_kind) :: key_mask(Nint, 2) + integer :: ni, i, n_a, n_b, e_a, e_b + + + n_a = 0 + n_b = 0 + do ni=1,nint + n_a = n_a + popcnt(key_mask(ni,1)) + n_b = n_b + popcnt(key_mask(ni,2)) + end do + + if(n_a == 0) then + N_miniList = N_fullList + miniList(:,:,:) = fullList(:,:,:) + do i=1,N_fullList + idx_miniList(i) = i + end do + return + end if + + N_miniList = 0 + + do i=1,N_fullList + e_a = n_a + e_b = n_b + do ni=1,nint + e_a -= popcnt(iand(fullList(ni, 1, i), key_mask(ni, 1))) + e_b -= popcnt(iand(fullList(ni, 2, i), key_mask(ni, 2))) + end do + + if(e_a + e_b <= 2) then + N_miniList = N_miniList + 1 + miniList(:,:,N_miniList) = fullList(:,:,i) + idx_miniList(N_miniList) = i + end if + end do +end subroutine + +!call i_H_psi(det_pert,psi_selectors,psi_selectors_coef,Nint,N_det_selectors,psi_selectors_size,N_st,i_H_psi_array) + call i_H_psi(det_pert,minilist,idx_minilist,psi_selectors_coef,Nint,N_minilist,psi_selectors_size,N_st,i_H_psi_array) +subroutine i_H_psi(key,keys,idx_key,N_minilist,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array) + use bitmasks + implicit none + integer, intent(in) :: Nint, Ndet,Ndet_max,Nstate,idx_key(Ndet), N_minilist integer(bit_kind), intent(in) :: keys(Nint,2,Ndet) integer(bit_kind), intent(in) :: key(Nint,2) double precision, intent(in) :: coef(Ndet_max,Nstate) double precision, intent(out) :: i_H_psi_array(Nstate) - integer :: i, ii,j + integer :: i, ii,j, i_in_key, i_in_coef double precision :: phase integer :: exc(0:2,2,2) double precision :: hij @@ -789,13 +837,20 @@ subroutine i_H_psi(key,keys,coef,Nint,Ndet,Ndet_max,Nstate,i_H_psi_array) ASSERT (Ndet_max >= Ndet) i_H_psi_array = 0.d0 - call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx) + !call filter_connected_i_H_psi0(keys,key,Nint,Ndet,idx) + call filter_connected_i_H_psi0(keys,key,Nint,N_minilist,idx) do ii=1,idx(0) - i = idx(ii) + !i = idx_key(idx(ii)) + i_in_key = idx(ii) + i_in_coef = idx_key(idx(ii)) !DEC$ FORCEINLINE - call i_H_j(keys(1,1,i),key,Nint,hij) +! ! call i_H_j(keys(1,1,i),key,Nint,hij) +! ! do j = 1, Nstate +! ! i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij +! ! enddo + call i_H_j(keys(1,1,i_in_key),key,Nint,hij) do j = 1, Nstate - i_H_psi_array(j) = i_H_psi_array(j) + coef(i,j)*hij + i_H_psi_array(j) = i_H_psi_array(j) + coef(i_in_coef,j)*hij enddo enddo end