diff --git a/config/gfortran.cfg b/config/gfortran.cfg index b713aaf0..396f8a45 100644 --- a/config/gfortran.cfg +++ b/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 diff --git a/ocaml/qp_edit.ml b/ocaml/qp_edit.ml index f6a2ac9c..409387b2 100644 --- a/ocaml/qp_edit.ml +++ b/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 ; diff --git a/plugins/CASSCF/ezfio_interface.irp.f b/plugins/CASSCF/ezfio_interface.irp.f new file mode 100644 index 00000000..b086268f --- /dev/null +++ b/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 + diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 33bd10dd..b2a4cb53 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/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 diff --git a/src/Determinants/ezfio_interface.irp.f b/src/Determinants/ezfio_interface.irp.f new file mode 100644 index 00000000..b68043b0 --- /dev/null +++ b/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 diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 1bf76dc4..88d8f44a 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/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