Merge branch 'master' of github.com:LCPQ/quantum_package

data/ezfio_defaults

@@ -18,8 +18,8 @@ cis_dressed
 determinants
   n_states                   1
   n_det_max_jacobi           5000
-  threshold_generators       1.0
+  threshold_generators       0.999
-  threshold_selectors        1.0
+  threshold_selectors        0.999
   read_wf                    False
 
 full_ci

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)"""

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

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)

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

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 <http://github.com/LCPQ/quantum_package/tree/master/src/Full_CI/full_ci.irp.f#L1>`_
+  Undocumented
+
 
 
 Needed Modules

src/Full_CI/full_ci.irp.f

@@ -1,4 +1,4 @@
-program cisd
+program full_ci
   implicit none
   integer                        :: i,k
 

src/Generators_full/generators.irp.f

@@ -1,22 +1,16 @@
 use bitmasks
 
-BEGIN_PROVIDER [ double precision, threshold_generators ]
+BEGIN_SHELL [ /usr/bin/python ]
- implicit none
+from ezfio_with_default import EZFIO_Provider
- BEGIN_DOC
+T = EZFIO_Provider()
- ! Percentage of the norm of the state-averaged wave function to
+T.set_type      ( "double precision" )
- ! consider for the generators
+T.set_name      ( "threshold_generators" )
- END_DOC
+T.set_doc       ( "Percentage of the norm of the state-averaged wave function to consider for the generators" )
- logical                        :: exists
+T.set_ezfio_dir ( "determinants" )
- PROVIDE ezfio_filename
+T.set_ezfio_name( "threshold_generators" )
- call ezfio_has_determinants_threshold_generators(exists)
+T.set_output    ( "output_dets" )
- if (exists) then
+print T
-   call ezfio_get_determinants_threshold_generators(threshold_generators)
+END_SHELL
- else
-   threshold_generators = 0.99d0
- endif
- call write_double(output_Dets,threshold_generators,'Threshold on generators')
-END_PROVIDER
-
 
 BEGIN_PROVIDER [ integer, N_det_generators ]
  implicit none

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)
 

src/Selectors_full/selectors.irp.f

@@ -1,21 +1,16 @@
 use bitmasks
 
-BEGIN_PROVIDER [ double precision, threshold_selectors ]
+BEGIN_SHELL [ /usr/bin/python ]
- implicit none
+from ezfio_with_default import EZFIO_Provider
- BEGIN_DOC
+T = EZFIO_Provider()
- ! Percentage of the norm of the state-averaged wave function to
+T.set_type      ( "double precision" )
- ! consider for the selectors
+T.set_name      ( "threshold_selectors" )
- END_DOC
+T.set_doc       ( "Percentage of the norm of the state-averaged wave function to consider for the selectors" )
- logical                        :: exists
+T.set_ezfio_dir ( "determinants" )
- PROVIDE ezfio_filename
+T.set_ezfio_name( "threshold_selectors" )
- call ezfio_has_determinants_threshold_selectors(exists)
+T.set_output    ( "output_dets" )
- if (exists) then
+print T
-   call ezfio_get_determinants_threshold_selectors(threshold_selectors)
+END_SHELL
- else
-   threshold_selectors = 0.99d0
- endif
- call write_double(output_Dets,threshold_selectors,'Threshold on selectors')
-END_PROVIDER
 
 BEGIN_PROVIDER [ integer, psi_selectors_size ]
  implicit none