init microlist

config/gfortran.cfg

@@ -10,7 +10,7 @@
 #
 #
 [COMMON]
-FC           : gfortran -g -ffree-line-length-none -I . -static-libgcc 
+FC           : gfortran -mavx -g -ffree-line-length-none -I . -static-libgcc 
 LAPACK_LIB   : -llapack -lblas
 IRPF90       : irpf90
 IRPF90_FLAGS : --ninja --align=32

ocaml/qp_edit.ml

@@ -18,11 +18,11 @@ type keyword =
 | Mo_basis
 | Nuclei
 | Determinants
-| Hartree_fock
 | Integrals_bielec
-| Perturbation
-| Properties
 | Pseudo
+| Perturbation
+| Hartree_fock
+| Properties
 ;;
 
 
@@ -33,11 +33,11 @@ let keyword_to_string = function
 | Mo_basis              -> "MO basis"
 | Nuclei                -> "Molecule"
 | Determinants -> "Determinants"
-| Hartree_fock -> "Hartree_fock"
 | Integrals_bielec -> "Integrals_bielec"
-| Perturbation -> "Perturbation"
-| Properties -> "Properties"
 | Pseudo -> "Pseudo"
+| Perturbation -> "Perturbation"
+| Hartree_fock -> "Hartree_fock"
+| Properties -> "Properties"
 ;;
 
 
@@ -88,16 +88,16 @@ let get s =
            f Determinants_by_hand.(read, to_rst)
          | Determinants ->
            f Determinants.(read, to_rst)
-         | Hartree_fock ->
-           f Hartree_fock.(read, to_rst)
          | Integrals_bielec ->
            f Integrals_bielec.(read, to_rst)
-         | Perturbation ->
-           f Perturbation.(read, to_rst)
-         | Properties ->
-           f Properties.(read, to_rst)
          | Pseudo ->
            f Pseudo.(read, to_rst)
+         | Perturbation ->
+           f Perturbation.(read, to_rst)
+         | Hartree_fock ->
+           f Hartree_fock.(read, to_rst)
+         | Properties ->
+           f Properties.(read, to_rst)
       end
     with
     | Sys_error msg -> (Printf.eprintf "Info: %s\n%!" msg ; "")
@@ -136,11 +136,11 @@ let set str s =
       let open Input in
         match s with
         | Determinants -> write Determinants.(of_rst, write) s
-        | Hartree_fock -> write Hartree_fock.(of_rst, write) s
         | Integrals_bielec -> write Integrals_bielec.(of_rst, write) s
-        | Perturbation -> write Perturbation.(of_rst, write) s
-        | Properties -> write Properties.(of_rst, write) s
         | Pseudo -> write Pseudo.(of_rst, write) s
+        | Perturbation -> write Perturbation.(of_rst, write) s
+        | Hartree_fock -> write Hartree_fock.(of_rst, write) s
+        | Properties -> write Properties.(of_rst, write) s
         | Electrons        -> write Electrons.(of_rst, write) s
         | Determinants_by_hand     -> write Determinants_by_hand.(of_rst, write) s
         | Nuclei           -> write Nuclei.(of_rst, write) s
@@ -189,11 +189,11 @@ let run check_only ezfio_filename =
       Ao_basis;
       Electrons ;
       Determinants ; 
-      Hartree_fock ; 
       Integrals_bielec ; 
-      Perturbation ; 
-      Properties ; 
       Pseudo ; 
+      Perturbation ; 
+      Hartree_fock ; 
+      Properties ; 
       Mo_basis;
       Determinants_by_hand ;
   ]
@@ -212,7 +212,7 @@ let run check_only ezfio_filename =
   match check_only with
   | true  -> ()
   | false -> 
-    Printf.sprintf "%s %s ; tput sgr0 2> /dev/null" editor temp_filename 
+    Printf.sprintf "%s %s" editor temp_filename 
     |> Sys.command_exn 
   ;
 

plugins/CASSCF/ezfio_interface.irp.f

@@ -0,0 +1,4 @@
+! DO NOT MODIFY BY HAND
+! Created by $QP_ROOT/scripts/ezfio_interface.py
+! from file /home/garniron/quantum_package/src/CASSCF/EZFIO.cfg
+

plugins/Perturbation/perturbation.template.f

@@ -2,6 +2,8 @@ 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,key_mask,fock_diag_tmp)
   implicit none
   BEGIN_DOC
@@ -19,6 +21,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
   integer                        :: i,k, c_ref, ni, ex
   integer, external              :: connected_to_ref
   logical, external              :: is_in_wavefunction
+  external :: commoner
   
   integer(bit_kind), allocatable :: minilist(:,:,:)
   integer, allocatable           :: idx_minilist(:)
@@ -28,10 +31,16 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
   integer :: N_minilist_gen
   logical :: fullMatch
   logical, external :: is_connected_to
+  
+  integer(bit_kind), allocatable :: microlist(:,:,:,:)
+  integer, allocatable           :: idx_microlist(:,:), N_microlist(:)
+  integer :: mobiles(2), smallerlist
+  
 
   allocate( minilist(Nint,2,N_det_selectors),                        &
       minilist_gen(Nint,2,N_det_generators),                         &
-      idx_minilist(N_det_selectors) )
+      idx_minilist(N_det_selectors))
+      
   
 
   ASSERT (Nint > 0)
@@ -40,14 +49,28 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
   ASSERT (minval(sum_norm_pert) >= 0.d0)
   ASSERT (N_st > 0)
   
-  call create_minilist(key_mask, psi_selectors, miniList, idx_miniList, N_det_selectors, N_minilist, Nint)
+  call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ??
   call create_minilist_find_previous(key_mask, psi_det_generators, miniList_gen, i_generator-1, N_minilist_gen, fullMatch, Nint)
   
+  
   if(fullMatch) then
     deallocate( minilist, minilist_gen, idx_minilist )
     return
   end if
   
+  allocate(   microlist(Nint,2,N_minilist, mo_tot_num*2),               &
+       idx_microlist(N_minilist, mo_tot_num*2),                  &
+       N_microlist(mo_tot_num*2) )
+      
+  call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint)
+  
+  
+  do i=1,mo_tot_num*2
+  do k=1,N_microlist(i)
+    idx_microlist(k,i) = idx_minilist(idx_microlist(k,i))
+  end do
+  end do
+  
   
   do i=1,buffer_size
     
@@ -59,8 +82,21 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
       cycle
     endif
     
+    ! create_microlist
+    call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint)
+    
+    if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then
+      smallerlist = mobiles(1)
+    else
+      smallerlist = mobiles(2)
+    end if
+    
     call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp,        &
-         c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) 
+          c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) 
+    !det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ;
+    
+!     call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp,        &
+!          c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) 
 
     do k = 1,N_st
       e_2_pert_buffer(k,i)   = e_2_pert(k)
@@ -72,6 +108,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c
     
   enddo 
   deallocate( minilist, minilist_gen, idx_minilist )
+  deallocate( microlist, idx_microlist, N_microlist )
   
 end
 

src/Determinants/ezfio_interface.irp.f

@@ -0,0 +1,334 @@
+! DO NOT MODIFY BY HAND
+! Created by $QP_ROOT/scripts/ezfio_interface.py
+! from file /home/garniron/quantum_package/src/Determinants/EZFIO.cfg
+
+
+BEGIN_PROVIDER [ double precision, threshold_selectors  ]
+  implicit none
+  BEGIN_DOC
+! Thresholds on selectors (fraction of the norm)
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_threshold_selectors(has)
+  if (has) then
+    call ezfio_get_determinants_threshold_selectors(threshold_selectors)
+  else
+    print *, 'determinants/threshold_selectors not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_double(output_determinants, threshold_selectors, &
+     'threshold_selectors')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, expected_s2  ]
+  implicit none
+  BEGIN_DOC
+! Expected value of S^2
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_expected_s2(has)
+  if (has) then
+    call ezfio_get_determinants_expected_s2(expected_s2)
+  else
+    print *, 'determinants/expected_s2 not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_double(output_determinants, expected_s2, &
+     'expected_s2')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_det_max  ]
+  implicit none
+  BEGIN_DOC
+! Max number of determinants in the wave function
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_n_det_max(has)
+  if (has) then
+    call ezfio_get_determinants_n_det_max(n_det_max)
+  else
+    print *, 'determinants/n_det_max not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_int(output_determinants, n_det_max, &
+     'n_det_max')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_states  ]
+  implicit none
+  BEGIN_DOC
+! Number of states to consider
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_n_states(has)
+  if (has) then
+    call ezfio_get_determinants_n_states(n_states)
+  else
+    print *, 'determinants/n_states not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_int(output_determinants, n_states, &
+     'n_states')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_det_max_jacobi  ]
+  implicit none
+  BEGIN_DOC
+! Maximum number of determinants diagonalized by Jacobi
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_n_det_max_jacobi(has)
+  if (has) then
+    call ezfio_get_determinants_n_det_max_jacobi(n_det_max_jacobi)
+  else
+    print *, 'determinants/n_det_max_jacobi not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_int(output_determinants, n_det_max_jacobi, &
+     'n_det_max_jacobi')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ logical, read_wf  ]
+  implicit none
+  BEGIN_DOC
+! If true, read the wave function from the EZFIO file
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_read_wf(has)
+  if (has) then
+    call ezfio_get_determinants_read_wf(read_wf)
+  else
+    print *, 'determinants/read_wf not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_bool(output_determinants, read_wf, &
+     'read_wf')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, det_coef , (n_det) ]
+  implicit none
+  BEGIN_DOC
+! det_coef
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_det_coef(has)
+  if (has) then
+    call ezfio_get_determinants_det_coef(det_coef)
+  else
+    print *, 'determinants/det_coef not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_double(output_determinants, det_coef, &
+     'det_coef')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, target_energy  ]
+  implicit none
+  BEGIN_DOC
+! Energy that should be obtained when truncating the wave function (optional)
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_target_energy(has)
+  if (has) then
+    call ezfio_get_determinants_target_energy(target_energy)
+  else
+    print *, 'determinants/target_energy not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_double(output_determinants, target_energy, &
+     'target_energy')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ logical, only_single_double_dm  ]
+  implicit none
+  BEGIN_DOC
+! If true, The One body DM is calculated with ignoring the Double<->Doubles extra diag elements
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_only_single_double_dm(has)
+  if (has) then
+    call ezfio_get_determinants_only_single_double_dm(only_single_double_dm)
+  else
+    print *, 'determinants/only_single_double_dm not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_bool(output_determinants, only_single_double_dm, &
+     'only_single_double_dm')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, threshold_davidson  ]
+  implicit none
+  BEGIN_DOC
+! Thresholds of Davidson's algorithm
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_threshold_davidson(has)
+  if (has) then
+    call ezfio_get_determinants_threshold_davidson(threshold_davidson)
+  else
+    print *, 'determinants/threshold_davidson not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_double(output_determinants, threshold_davidson, &
+     'threshold_davidson')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_states_diag  ]
+  implicit none
+  BEGIN_DOC
+! n_states_diag
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_n_states_diag(has)
+  if (has) then
+    call ezfio_get_determinants_n_states_diag(n_states_diag)
+  else
+    print *, 'determinants/n_states_diag not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_int(output_determinants, n_states_diag, &
+     'n_states_diag')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, det_occ , (elec_alpha_num,n_det,2) ]
+  implicit none
+  BEGIN_DOC
+! det_occ
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_det_occ(has)
+  if (has) then
+    call ezfio_get_determinants_det_occ(det_occ)
+  else
+    print *, 'determinants/det_occ not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_int(output_determinants, det_occ, &
+     'det_occ')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ logical, s2_eig  ]
+  implicit none
+  BEGIN_DOC
+! Force the wave function to be an eigenfunction of S^2
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_s2_eig(has)
+  if (has) then
+    call ezfio_get_determinants_s2_eig(s2_eig)
+  else
+    print *, 'determinants/s2_eig not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_bool(output_determinants, s2_eig, &
+     's2_eig')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ double precision, threshold_generators  ]
+  implicit none
+  BEGIN_DOC
+! Thresholds on generators (fraction of the norm)
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_threshold_generators(has)
+  if (has) then
+    call ezfio_get_determinants_threshold_generators(threshold_generators)
+  else
+    print *, 'determinants/threshold_generators not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_double(output_determinants, threshold_generators, &
+     'threshold_generators')
+
+END_PROVIDER
+
+BEGIN_PROVIDER [ integer, n_det_max_property  ]
+  implicit none
+  BEGIN_DOC
+! Max number of determinants in the wave function when you select for a given property
+  END_DOC
+
+  logical                        :: has
+  PROVIDE ezfio_filename
+  call ezfio_has_determinants_n_det_max_property(has)
+  if (has) then
+    call ezfio_get_determinants_n_det_max_property(n_det_max_property)
+  else
+    print *, 'determinants/n_det_max_property not found in EZFIO file'
+    stop 1
+  endif
+
+  call write_time(output_determinants)
+  call write_int(output_determinants, n_det_max_property, &
+     'n_det_max_property')
+
+END_PROVIDER

src/Determinants/filter_connected.irp.f

@@ -98,6 +98,56 @@ subroutine filter_connected(key1,key2,Nint,sze,idx)
 end
 
 
+subroutine getMobiles(key,key_mask, mobiles,Nint)
+  use bitmasks
+  integer(bit_kind),intent(in) :: key(Nint,2), key_mask(Nint,2)
+  integer,intent(out) :: mobiles(2)
+  integer,intent(in) :: Nint
+  
+  integer(bit_kind) :: mobileMask(2)
+  
+  if(Nint /= 1) then
+    print *, "GETMOBILES UNIMPLEMENTED"
+    stop
+  end if
+  
+  
+  mobileMask(1) = xor(key(1,1), key_mask(1,1))
+  mobileMask(2) = xor(key(1,2), key_mask(1,2))
+  
+  if(mobileMask(1) /= 0 .and. mobileMask(2) /= 0) then
+    mobiles(1) = trailz(mobileMask(1)) + 1
+    mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num
+  else if(mobileMask(1) /= 0) then
+    mobiles(1) = trailz(mobileMask(1)) + 1
+    mobiles(2) = bit_kind*8 - leadz(mobileMask(1))
+  else
+    mobiles(1) = (trailz(mobileMask(2)) + 1) + mo_tot_num
+    mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num
+  end if
+end subroutine
+  
+
+subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, Nint)
+  use bitmasks
+  integer, intent(in) :: Nint, N_minilist
+  integer(bit_kind), intent(in) :: minilist(Nint,2,N_minilist), key_mask(Nint,2)
+  
+  integer, intent(out) :: N_microlist(mo_tot_num*2), idx_microlist(N_minilist, mo_tot_num*2)
+  integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, mo_tot_num*2)
+  
+  integer :: i,j,k
+  
+  N_microlist(:) = N_minilist
+  do i=1,mo_tot_num*2
+    microlist(:,:,:,i) = minilist(:,:,:)
+  end do
+  do i=1,N_minilist
+    idx_microlist(i,:) = i
+  end do
+end subroutine
+  
+  
 subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx)
   use bitmasks
   BEGIN_DOC