From 69250d7a2eede9ece4dda80683be488d98127ec1 Mon Sep 17 00:00:00 2001 From: Manu Date: Wed, 15 Jul 2015 14:01:06 +0200 Subject: [PATCH] Minor modiffs --- scripts/generate_h_apply.py | 18 ++++- src/Determinants/H_apply.template.f | 14 ++-- src/Determinants/create_excitations.irp.f | 11 +++ src/Determinants/determinants.irp.f | 88 +++++++++++++++++++++++ 4 files changed, 126 insertions(+), 5 deletions(-) diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 9f878d7d..6604ae0a 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -28,6 +28,7 @@ filterhole filterparticle do_double_excitations check_double_excitation +filter_vvvv_excitation """.split() class H_apply(object): @@ -50,7 +51,7 @@ class H_apply(object): !$OMP accu,i_a,hole_tmp,particle_tmp,occ_particle_tmp, & !$OMP occ_hole_tmp,key_idx,i_b,j_b,key,N_elec_in_key_part_1,& !$OMP N_elec_in_key_hole_1,N_elec_in_key_part_2, & - !$OMP N_elec_in_key_hole_2,ia_ja_pairs) & + !$OMP N_elec_in_key_hole_2,ia_ja_pairs,key_union_hole_part) & !$OMP SHARED(key_in,N_int,elec_num_tab,mo_tot_num, & !$OMP hole_1, particl_1, hole_2, particl_2, & !$OMP elec_alpha_num,i_generator) FIRSTPRIVATE(iproc)""" @@ -125,6 +126,21 @@ class H_apply(object): self["check_double_excitation"] = """ check_double_excitation = .False. """ + + def filter_vvvv_excitation(self): + self["filter_vvvv_excitation"] = """ + key_union_hole_part = 0_bit_kind + call set_bite_to_integer(i_a,key_union_hole_part,N_int) + call set_bite_to_integer(j_a,key_union_hole_part,N_int) + call set_bite_to_integer(i_b,key_union_hole_part,N_int) + call set_bite_to_integer(j_b,key_union_hole_part,N_int) + do jtest_vvvv = 1, N_int + if(iand(key_union_hole_part(jtest_vvvv),virt_bitmask(jtest_vvvv,1).ne.key_union_hole_part(jtest_vvvv)))then + b_cycle = .False. + endif + enddo + if(b_cycle) cycle + """ def set_filter_holes(self): self["filterhole"] = """ if(iand(ibset(0_bit_kind,j),hole(k,other_spin)).eq.0_bit_kind )cycle diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index a9a282ae..3a05ee0d 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -18,6 +18,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene integer(bit_kind), allocatable :: hole_save(:,:) integer(bit_kind), allocatable :: key(:,:),hole(:,:), particle(:,:) integer(bit_kind), allocatable :: hole_tmp(:,:), particle_tmp(:,:) + integer(bit_kind), allocatable :: key_union_hole_part(:) integer :: ii,i,jj,j,k,ispin,l integer, allocatable :: occ_particle(:,:), occ_hole(:,:) integer, allocatable :: occ_particle_tmp(:,:), occ_hole_tmp(:,:) @@ -31,6 +32,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene integer, allocatable :: ib_jb_pairs(:,:) double precision :: diag_H_mat_elem integer :: iproc + integer :: jtest_vvvv integer(omp_lock_kind), save :: lck, ifirst=0 if (ifirst == 0) then !$ call omp_init_lock(lck) @@ -38,6 +40,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene endif logical :: check_double_excitation + logical :: b_cycle check_double_excitation = .True. iproc = iproc_in @@ -50,7 +53,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene key(N_int,2),hole(N_int,2), particle(N_int,2), hole_tmp(N_int,2),& particle_tmp(N_int,2), occ_particle(N_int*bit_kind_size,2), & occ_hole(N_int*bit_kind_size,2), occ_particle_tmp(N_int*bit_kind_size,2),& - occ_hole_tmp(N_int*bit_kind_size,2)) + occ_hole_tmp(N_int*bit_kind_size,2),key_union_hole_part(N_int)) $init_thread @@ -151,6 +154,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene ASSERT (j_b > 0) ASSERT (j_b <= mo_tot_num) if (array_pairs(i_b,j_b)) then + $filter_vvvv_excitation i+= 1 ib_jb_pairs(1,i) = i_b ib_jb_pairs(2,i) = j_b @@ -200,6 +204,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene ASSERT (j_b <= mo_tot_num) if (j_b <= j_a) cycle if (array_pairs(i_b,j_b)) then + $filter_vvvv_excitation i+= 1 ib_jb_pairs(1,i) = i_b ib_jb_pairs(2,i) = j_b @@ -245,7 +250,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene key,hole, particle, hole_tmp,& particle_tmp, occ_particle, & occ_hole, occ_particle_tmp,& - occ_hole_tmp,array_pairs) + occ_hole_tmp,array_pairs,key_union_hole_part) $omp_end_parallel $finalization end @@ -278,6 +283,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc_in $pa 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(bit_kind), allocatable :: key_union_hole_part(:) integer, allocatable :: ia_ja_pairs(:,:,:) logical, allocatable :: array_pairs(:,:) @@ -305,7 +311,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc_in $pa key(N_int,2),hole(N_int,2), particle(N_int,2), hole_tmp(N_int,2),& particle_tmp(N_int,2), occ_particle(N_int*bit_kind_size,2), & occ_hole(N_int*bit_kind_size,2), occ_particle_tmp(N_int*bit_kind_size,2),& - occ_hole_tmp(N_int*bit_kind_size,2)) + occ_hole_tmp(N_int*bit_kind_size,2),key_union_hole_part(N_int)) $init_thread !!!! First couple hole particle do j = 1, N_int @@ -376,7 +382,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc_in $pa key,hole, particle, hole_tmp,& particle_tmp, occ_particle, & occ_hole, occ_particle_tmp,& - occ_hole_tmp) + occ_hole_tmp,key_union_hole_part) $omp_end_parallel $finalization diff --git a/src/Determinants/create_excitations.irp.f b/src/Determinants/create_excitations.irp.f index a33525c7..a2acc8df 100644 --- a/src/Determinants/create_excitations.irp.f +++ b/src/Determinants/create_excitations.irp.f @@ -34,3 +34,14 @@ subroutine do_mono_excitation(key_in,i_hole,i_particle,ispin,i_ok) i_ok = -1 endif end + +subroutine set_bite_to_integer(i_physical,key,Nint) + use bitmasks + implicit none + integer, intent(in) :: i_physical,Nint + integer(bit_kind), intent(inout) :: key(Nint) + integer :: k,j,i + k = ishft(i_physical-1,-bit_kind_shift)+1 + j = i_physical-ishft(k-1,bit_kind_shift)-1 + key(k) = ibset(key(k),j) +end diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index 8cc545f5..1900289e 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -731,3 +731,91 @@ end +subroutine save_wavefunction_specified(ndet,nstates,psidet,psicoef,ndetsave,index_det_save) + implicit none + BEGIN_DOC +! Save the wave function into the EZFIO file + END_DOC + use bitmasks + integer, intent(in) :: ndet,nstates + integer(bit_kind), intent(in) :: psidet(N_int,2,ndet) + double precision, intent(in) :: psicoef(ndet,nstates) + integer, intent(in) :: index_det_save(ndet) + integer, intent(in) :: ndetsave + integer*8, allocatable :: psi_det_save(:,:,:) + double precision, allocatable :: psi_coef_save(:,:) + integer*8 :: det_8(100) + integer(bit_kind) :: det_bk((100*8)/bit_kind) + integer :: N_int2 + equivalence (det_8, det_bk) + + integer :: i,k + + PROVIDE progress_bar + call start_progress(7,'Saving wfunction',0.d0) + + progress_bar(1) = 1 + progress_value = dble(progress_bar(1)) + call ezfio_set_determinants_N_int(N_int) + progress_bar(1) = 2 + progress_value = dble(progress_bar(1)) + call ezfio_set_determinants_bit_kind(bit_kind) + progress_bar(1) = 3 + progress_value = dble(progress_bar(1)) + call ezfio_set_determinants_N_det(ndetsave) + progress_bar(1) = 4 + progress_value = dble(progress_bar(1)) + call ezfio_set_determinants_n_states(nstates) + progress_bar(1) = 5 + progress_value = dble(progress_bar(1)) + call ezfio_set_determinants_mo_label(mo_label) + + progress_bar(1) = 6 + progress_value = dble(progress_bar(1)) + + N_int2 = (N_int*bit_kind)/8 + allocate (psi_det_save(N_int2,2,ndetsave)) + do i=1,ndetsave + do k=1,N_int + det_bk(k) = psidet(k,1,index_det_save(i)) + enddo + do k=1,N_int2 + psi_det_save(k,1,i) = det_8(k) + enddo + do k=1,N_int + det_bk(k) = psidet(k,2,index_det_save(i)) + enddo + do k=1,N_int2 + psi_det_save(k,2,i) = det_8(k) + enddo + enddo + call ezfio_set_determinants_psi_det(psi_det_save) + deallocate (psi_det_save) + + progress_bar(1) = 7 + progress_value = dble(progress_bar(1)) + allocate (psi_coef_save(ndetsave,nstates)) + double precision :: accu_norm(nstates) + accu_norm = 0.d0 + do k=1,nstates + do i=1,ndetsave + accu_norm(k) = accu_norm(k) + psicoef(index_det_save(i),k) * psicoef(index_det_save(i),k) + psi_coef_save(i,k) = psicoef(index_det_save(i),k) + enddo + enddo + do k = 1, nstates + accu_norm(k) = 1.d0/dsqrt(accu_norm(k)) + enddo + do k=1,nstates + do i=1,ndetsave + psi_coef_save(i,k) = psi_coef_save(i,k) * accu_norm(k) + enddo + enddo + + call ezfio_set_determinants_psi_coef(psi_coef_save) + call write_int(output_determinants,ndet,'Saved determinants') + call stop_progress + deallocate (psi_coef_save) +end + +