From 3f001ce4cff27a915353617296a924c337af4424 Mon Sep 17 00:00:00 2001 From: Manu Date: Fri, 20 Mar 2015 10:58:24 +0100 Subject: [PATCH] corrected DDCI --- scripts/generate_h_apply.py | 39 ++++++++++--------------------------- src/Dets/H_apply_template.f | 18 +++++------------ src/NEEDED_MODULES | 2 +- 3 files changed, 16 insertions(+), 43 deletions(-) diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 35f9223f..8bde1d11 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -13,8 +13,6 @@ initialization declarations decls_main keys_work -do_double_excitations -check_double_excitation copy_buffer finalization generate_psi_guess @@ -25,8 +23,7 @@ deinit_thread skip init_main filter_integrals -filterhole -filterparticle +filter2h2p """.split() class H_apply(object): @@ -119,24 +116,13 @@ class H_apply(object): buffer = buffer.replace('$'+key, value) return buffer - def unset_double_excitations(self): - self["do_double_excitations"] = ".False." - self["check_double_excitation"] = """ - check_double_excitation = .False. - """ - def set_filter_holes(self): - self["filterhole"] = """ - if(iand(ibset(0_bit_kind,j),hole(k,other_spin)).eq.0_bit_kind ) then - cycle - endif - """ - def set_filter_particl(self): - self["filterparticle"] = """ - if(iand(ibset(0_bit_kind,j_a),hole(k_a,other_spin)).eq.0_bit_kind ) then - cycle - endif + def set_filter_2h_2p(self): + self["filter2h2p"] = """ +! ! DIR$ FORCEINLINE + if(is_a_two_holes_two_particles(key))cycle """ + def set_perturbation(self,pert): if self.perturbation is not None: raise @@ -179,14 +165,9 @@ class H_apply(object): PROVIDE CI_electronic_energy psi_selectors_coef psi_selectors E_corr_per_selectors psi_det_sorted_bit """ self.data["keys_work"] = """ - if(check_double_excitation)then - 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) - else - call perturb_buffer_by_mono_%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) - endif - """%(pert,pert) + 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) + """%(pert,) self.data["finalization"] = """ """ self.data["copy_buffer"] = "" @@ -252,7 +233,7 @@ class H_apply(object): if (s2_eig) then call make_s2_eigenfunction endif -! SOFT_TOUCH psi_det psi_coef N_det +! SOFT_TOUCH psi_det psi_coef N_det selection_criterion_min = min(selection_criterion_min, maxval(select_max))*0.1d0 selection_criterion = selection_criterion_min call write_double(output_Dets,selection_criterion,'Selection criterion') diff --git a/src/Dets/H_apply_template.f b/src/Dets/H_apply_template.f index 6402751f..557a6325 100644 --- a/src/Dets/H_apply_template.f +++ b/src/Dets/H_apply_template.f @@ -26,6 +26,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene integer :: N_elec_in_key_hole_2(2),N_elec_in_key_part_2(2) double precision :: mo_bielec_integral + logical :: is_a_two_holes_two_particles integer, allocatable :: ia_ja_pairs(:,:,:) integer, allocatable :: ib_jb_pairs(:,:) double precision :: diag_H_mat_elem @@ -35,11 +36,6 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene ifirst=1 endif - logical :: check_double_excitation - check_double_excitation = .True. - - - $initialization $omp_parallel @@ -167,6 +163,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene 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) + $filter2h2p key_idx += 1 do k=1,N_int keys_out(k,1,key_idx) = key(k,1) @@ -215,6 +212,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene 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) + $filter2h2p key_idx += 1 do k=1,N_int keys_out(k,1,key_idx) = key(k,1) @@ -272,17 +270,12 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc $param integer :: kk,pp,other_spin,key_idx integer :: N_elec_in_key_hole_1(2),N_elec_in_key_part_1(2) integer :: N_elec_in_key_hole_2(2),N_elec_in_key_part_2(2) + logical :: is_a_two_holes_two_particles integer, allocatable :: ia_ja_pairs(:,:,:) logical, allocatable :: array_pairs(:,:) double precision :: diag_H_mat_elem integer(omp_lock_kind), save :: lck, ifirst=0 - - logical :: check_double_excitation - check_double_excitation = .True. - $check_double_excitation - - if (ifirst == 0) then ifirst=1 !$ call omp_init_lock(lck) @@ -340,12 +333,11 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc $param hole = key_in k = ishft(i_a-1,-bit_kind_shift)+1 j = i_a-ishft(k-1,bit_kind_shift)-1 - $filterhole 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 - $filterparticle hole(k_a,ispin) = ibset(hole(k_a,ispin),l_a) + $filter2h2p key_idx += 1 do k=1,N_int keys_out(k,1,key_idx) = hole(k,1) diff --git a/src/NEEDED_MODULES b/src/NEEDED_MODULES index 830bb3d8..84057d07 100644 --- a/src/NEEDED_MODULES +++ b/src/NEEDED_MODULES @@ -1 +1 @@ -AOs BiInts Bitmask Dets Electrons Ezfio_files Full_CI Generators_full Hartree_Fock MOGuess MonoInts MOs Nuclei Output Selectors_full Utils Molden FCIdump Generators_CAS CAS_SD_selected +AOs BiInts Bitmask Dets Electrons Ezfio_files Full_CI Generators_full Hartree_Fock MOGuess MonoInts MOs Nuclei Output Selectors_full Utils Molden FCIdump Generators_CAS CAS_SD_selected DDCI_selected