diff --git a/data/ezfio_defaults b/data/ezfio_defaults index e2a8d57d..1ddcf455 100644 --- a/data/ezfio_defaults +++ b/data/ezfio_defaults @@ -18,8 +18,8 @@ cis_dressed determinants n_states 1 n_det_max_jacobi 5000 - threshold_generators 1.0 - threshold_selectors 1.0 + threshold_generators 0.999 + threshold_selectors 0.999 read_wf False full_ci diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index f945be76..36338026 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -45,7 +45,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,iproc) & + !$OMP N_elec_in_key_hole_2,ia_ja_pairs) & !$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)""" diff --git a/src/Dets/H_apply_template.f b/src/Dets/H_apply_template.f index 84c25c69..b3984448 100644 --- a/src/Dets/H_apply_template.f +++ b/src/Dets/H_apply_template.f @@ -1,4 +1,4 @@ -subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_generator $parameters ) +subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_generator, iproc $parameters ) use omp_lib use bitmasks implicit none @@ -14,6 +14,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene integer(bit_kind),allocatable :: keys_out(:,:,:) integer(bit_kind), intent(in) :: hole_1(N_int,2), particl_1(N_int,2) integer(bit_kind), intent(in) :: hole_2(N_int,2), particl_2(N_int,2) + integer, intent(in) :: iproc integer(bit_kind), allocatable :: hole_save(:,:) integer(bit_kind), allocatable :: key(:,:),hole(:,:), particle(:,:) integer(bit_kind), allocatable :: hole_tmp(:,:), particle_tmp(:,:) @@ -28,7 +29,6 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene integer, allocatable :: ia_ja_pairs(:,:,:) integer, allocatable :: ib_jb_pairs(:,:) double precision :: diag_H_mat_elem - integer :: iproc integer(omp_lock_kind), save :: lck, ifirst=0 if (ifirst == 0) then !$ call omp_init_lock(lck) @@ -37,9 +37,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene $initialization - iproc = 0 $omp_parallel - !$ iproc = omp_get_thread_num() allocate (keys_out(N_int,2,size_max), hole_save(N_int,2), & 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), & @@ -242,7 +240,7 @@ subroutine $subroutine_diexc(key_in, hole_1,particl_1, hole_2, particl_2, i_gene $finalization end -subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator $parameters ) +subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator,iproc $parameters ) use omp_lib use bitmasks implicit none @@ -256,6 +254,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator $parameters integer ,intent(in) :: i_generator integer(bit_kind),intent(in) :: key_in(N_int,2) integer(bit_kind),intent(in) :: hole_1(N_int,2), particl_1(N_int,2) + integer, intent(in) :: iproc integer(bit_kind),allocatable :: keys_out(:,:,:) integer(bit_kind),allocatable :: hole_save(:,:) integer(bit_kind),allocatable :: key(:,:),hole(:,:), particle(:,:) @@ -272,7 +271,6 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator $parameters integer, allocatable :: ia_ja_pairs(:,:,:) logical, allocatable :: array_pairs(:,:) double precision :: diag_H_mat_elem - integer :: iproc integer(omp_lock_kind), save :: lck, ifirst=0 if (ifirst == 0) then ifirst=1 @@ -281,9 +279,7 @@ subroutine $subroutine_monoexc(key_in, hole_1,particl_1,i_generator $parameters $initialization - iproc = 0 $omp_parallel - !$ iproc = omp_get_thread_num() allocate (keys_out(N_int,2,size_max), hole_save(N_int,2), & 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), & @@ -379,6 +375,7 @@ subroutine $subroutine($params_main) integer(omp_lock_kind) :: lck integer(bit_kind), allocatable :: mask(:,:,:) integer :: ispin, k + integer :: iproc PROVIDE H_apply_buffer_allocated mo_bielec_integrals_in_map N_det_selectors psi_generators PROVIDE psi_det_sorted_bit coef_hf_selector psi_det psi_coef ref_bitmask_energy @@ -389,9 +386,10 @@ subroutine $subroutine($params_main) !$ call omp_init_lock(lck) -IRP_IF I_LIKE_BUGS !$OMP PARALLEL DEFAULT(SHARED) & - !$OMP PRIVATE(i_generator,wall_2,ispin,k,mask) + !$OMP PRIVATE(i_generator,wall_2,ispin,k,mask,iproc) + iproc = 0 + !$ iproc = omp_get_thread_num() allocate( mask(N_int,2,6) ) !$OMP DO SCHEDULE(dynamic,4) do i_generator=1,nmax @@ -428,12 +426,12 @@ IRP_IF I_LIKE_BUGS call $subroutine_diexc(psi_generators(1,1,i_generator), & mask(1,1,d_hole1), mask(1,1,d_part1), & mask(1,1,d_hole2), mask(1,1,d_part2), & - i_generator $params_post) + i_generator, iproc $params_post) endif if($do_mono_excitations)then call $subroutine_monoexc(psi_generators(1,1,i_generator), & mask(1,1,s_hole ), mask(1,1,s_part ), & - i_generator $params_post) + i_generator, iproc $params_post) endif !$ call omp_set_lock(lck) call wall_time(wall_2) @@ -450,13 +448,9 @@ IRP_IF I_LIKE_BUGS !$ 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 -IRP_ELSE - allocate( mask(N_int,2,6) ) - do i_generator=1,N_det_generators - -IRP_ENDIF if (abort_here) then exit @@ -490,12 +484,12 @@ IRP_ENDIF call $subroutine_diexc(psi_generators(1,1,i_generator), & mask(1,1,d_hole1), mask(1,1,d_part1), & mask(1,1,d_hole2), mask(1,1,d_part2), & - i_generator $params_post) + i_generator, 0 $params_post) endif if($do_mono_excitations)then call $subroutine_monoexc(psi_generators(1,1,i_generator), & mask(1,1,s_hole ), mask(1,1,s_part ), & - i_generator $params_post) + i_generator, 0 $params_post) endif call wall_time(wall_2) $printout_always 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/Generators_full/generators.irp.f b/src/Generators_full/generators.irp.f index a7d138d5..56e82935 100644 --- a/src/Generators_full/generators.irp.f +++ b/src/Generators_full/generators.irp.f @@ -1,22 +1,16 @@ use bitmasks -BEGIN_PROVIDER [ double precision, threshold_generators ] - implicit none - BEGIN_DOC - ! Percentage of the norm of the state-averaged wave function to - ! consider for the generators - END_DOC - logical :: exists - PROVIDE ezfio_filename - call ezfio_has_determinants_threshold_generators(exists) - if (exists) then - call ezfio_get_determinants_threshold_generators(threshold_generators) - else - threshold_generators = 0.99d0 - endif - call write_double(output_Dets,threshold_generators,'Threshold on generators') -END_PROVIDER - +BEGIN_SHELL [ /usr/bin/python ] +from ezfio_with_default import EZFIO_Provider +T = EZFIO_Provider() +T.set_type ( "double precision" ) +T.set_name ( "threshold_generators" ) +T.set_doc ( "Percentage of the norm of the state-averaged wave function to consider for the generators" ) +T.set_ezfio_dir ( "determinants" ) +T.set_ezfio_name( "threshold_generators" ) +T.set_output ( "output_dets" ) +print T +END_SHELL BEGIN_PROVIDER [ integer, N_det_generators ] implicit none 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) diff --git a/src/Selectors_full/selectors.irp.f b/src/Selectors_full/selectors.irp.f index db2708da..8bf7fe32 100644 --- a/src/Selectors_full/selectors.irp.f +++ b/src/Selectors_full/selectors.irp.f @@ -1,21 +1,16 @@ use bitmasks -BEGIN_PROVIDER [ double precision, threshold_selectors ] - implicit none - BEGIN_DOC - ! Percentage of the norm of the state-averaged wave function to - ! consider for the selectors - END_DOC - logical :: exists - PROVIDE ezfio_filename - call ezfio_has_determinants_threshold_selectors(exists) - if (exists) then - call ezfio_get_determinants_threshold_selectors(threshold_selectors) - else - threshold_selectors = 0.99d0 - endif - call write_double(output_Dets,threshold_selectors,'Threshold on selectors') -END_PROVIDER +BEGIN_SHELL [ /usr/bin/python ] +from ezfio_with_default import EZFIO_Provider +T = EZFIO_Provider() +T.set_type ( "double precision" ) +T.set_name ( "threshold_selectors" ) +T.set_doc ( "Percentage of the norm of the state-averaged wave function to consider for the selectors" ) +T.set_ezfio_dir ( "determinants" ) +T.set_ezfio_name( "threshold_selectors" ) +T.set_output ( "output_dets" ) +print T +END_SHELL BEGIN_PROVIDER [ integer, psi_selectors_size ] implicit none