From 786e2989d1a037c4bf17e7c1a320b0b868328e3a Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 16 Dec 2015 15:05:57 +0100 Subject: [PATCH 01/11] init microlist --- config/gfortran.cfg | 2 +- ocaml/qp_edit.ml | 38 +-- plugins/CASSCF/ezfio_interface.irp.f | 4 + plugins/Perturbation/perturbation.template.f | 43 ++- src/Determinants/ezfio_interface.irp.f | 334 +++++++++++++++++++ src/Determinants/filter_connected.irp.f | 50 +++ 6 files changed, 448 insertions(+), 23 deletions(-) create mode 100644 plugins/CASSCF/ezfio_interface.irp.f create mode 100644 src/Determinants/ezfio_interface.irp.f 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 From 424682a7a13568445f12b31b3bf64bc199a53b9c Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 16 Dec 2015 16:41:22 +0100 Subject: [PATCH 02/11] apparently working microlist --- plugins/Perturbation/perturbation.template.f | 47 ++++++++++-------- src/Determinants/filter_connected.irp.f | 52 +++++++++++++++++--- 2 files changed, 72 insertions(+), 27 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index b2a4cb53..d505efdb 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -21,7 +21,6 @@ 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(:) @@ -49,7 +48,7 @@ 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) !! deplacer apres fullmatch ?? + call create_minilist_find_previous(key_mask, psi_det_generators, miniList_gen, i_generator-1, N_minilist_gen, fullMatch, Nint) @@ -57,20 +56,21 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c deallocate( minilist, minilist_gen, idx_minilist ) return end if - + call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ?? 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 + + + if(key_mask(1,1) /= 0) then + 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 + end if do i=1,buffer_size @@ -82,17 +82,23 @@ 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) + if(key_mask(1,1) /= 0) then + 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_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) + + else + 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) 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_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, & @@ -109,7 +115,6 @@ 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/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 88d8f44a..081fb548 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -136,14 +136,54 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro 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 + integer :: i,j,k,nt,n_element(2) + integer :: list(Nint*bit_kind_size,2) + integer(bit_kind) :: key_mask_neg(Nint,2) + - N_microlist(:) = N_minilist - do i=1,mo_tot_num*2 - microlist(:,:,:,i) = minilist(:,:,:) + if(Nint /= 1) then + print *, "UNIMPLEMENTed" + stop + end if + + do i=1,Nint + key_mask_neg(i,1) = not(key_mask(i,1)) + key_mask_neg(i,2) = not(key_mask(i,2)) end do - do i=1,N_minilist - idx_microlist(i,:) = i + + N_microlist(:) = 0 + + + do i=1, N_minilist + call bitstring_to_list(iand(key_mask_neg(1,1), minilist(1,1,i)), list(:,1), n_element(1), Nint) + call bitstring_to_list(iand(key_mask_neg(1,2), minilist(1,2,i)), list(:,2), n_element(2), Nint) + + if(n_element(1) + n_element(2) > 4) then + print *, "WTF???" + stop + end if + + if(n_element(1) + n_element(2) /= 4) then + do j=1,mo_tot_num*2 + N_microlist(j) = N_microlist(j) + 1 + idx_microlist(N_microlist(j),j) = i + microlist(:,:,N_microlist(j),j) = minilist(:,:,i) + end do + else + do j=1,n_element(1) + nt = list(j,1) + N_microlist(nt) = N_microlist(nt) + 1 + idx_microlist(N_microlist(nt),nt) = i + microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i) + end do + + do j=1,n_element(2) + nt = list(j,2) + mo_tot_num + N_microlist(nt) = N_microlist(nt) + 1 + idx_microlist(N_microlist(nt),nt) = i + microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i) + end do + end if end do end subroutine From 9a515ed0b699ac0d9a122ed4c0682f38f9c236b8 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Thu, 17 Dec 2015 22:06:57 +0100 Subject: [PATCH 03/11] better microlist --- config/gfortran.cfg | 2 +- plugins/Perturbation/perturbation.template.f | 29 +++++-- src/Determinants/H_apply.template.f | 20 +++-- src/Determinants/filter_connected.irp.f | 88 ++++++++++++-------- 4 files changed, 85 insertions(+), 54 deletions(-) diff --git a/config/gfortran.cfg b/config/gfortran.cfg index 396f8a45..6e69033c 100644 --- a/config/gfortran.cfg +++ b/config/gfortran.cfg @@ -22,7 +22,7 @@ IRPF90_FLAGS : --ninja --align=32 # 0 : Deactivate # [OPTION] -MODE : DEBUG ; [ OPT | PROFILE | DEBUG ] : Chooses the section below +MODE : OPT ; [ OPT | PROFILE | DEBUG ] : Chooses the section below CACHE : 1 ; Enable cache_compile.py OPENMP : 1 ; Append OpenMP flags diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index d505efdb..37f7840e 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -56,10 +56,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c deallocate( minilist, minilist_gen, idx_minilist ) return end if - call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) !! deplacer apres fullmatch ?? - 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_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) + allocate( microlist(Nint,2,N_minilist, 0:mo_tot_num*2), & + idx_microlist(N_minilist, 0:mo_tot_num*2), & + N_microlist(0:mo_tot_num*2) ) @@ -84,19 +84,30 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(key_mask(1,1) /= 0) then - call getMobiles(buffer(1,1,i), key_mask, mobiles, Nint) + call getMobiles(buffer(:,:,i), key_mask, mobiles, Nint) +! if(popcnt(buffer(1,1,i)) + popcnt(buffer(2,1,i)) /= 16 .or. popcnt(buffer(1,2,i)) + popcnt(buffer(2,2,i)) /= 16 .or. popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) /= 30) then +! print *, "wtf?" +! print '(3(B70))', buffer(:,1,i) +! print '(3(B70))', buffer(:,2,i) +! print '(3(B70))', popcnt(key_mask(1,1)) +! print '(3(B70))', popcnt(key_mask(1,2)) +! end if if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then smallerlist = mobiles(1) else smallerlist = mobiles(2) end if + microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) + idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) +! 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_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) 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_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) + c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) - else - 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) + else + 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) end if !det_ref,det_pert,fock_diag_tmp,c_pert,e_2_pert,H_pert_diag,Nint,ndet,N_st,minilist,idx_minilist,N_minilist ; diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index 58ae8b08..d9131936 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -97,25 +97,31 @@ end subroutine subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters ) - + implicit none integer(bit_kind), intent(in) :: key_in(N_int, 2), particl_1(N_int, 2), particl_2(N_int, 2) double precision, intent(in) :: fock_diag_tmp(2,mo_tot_num+1) integer(bit_kind) :: p1_mask(N_int, 2), p2_mask(N_int, 2), key_mask(N_int, 2) - integer,intent(in) :: fh1,fh2,fs1,fs2,i_generator,iproc_in + integer,intent(in) :: fs1,fs2,i_generator,iproc_in, fh1,fh2 integer(bit_kind) :: miniList(N_int, 2, N_det) integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni $declarations + integer(bit_kind), parameter :: one = 1_8 p1_mask(:,:) = 0_bit_kind p2_mask(:,:) = 0_bit_kind - p1_mask(ishft(fh1,-bit_kind_shift) + 1, fs1) = ishft(1,iand(fh1-1,bit_kind_size-1)) - p2_mask(ishft(fh2,-bit_kind_shift) + 1, fs2) = ishft(1,iand(fh2-1,bit_kind_size-1)) + p1_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) = ishft(one,iand(fh1-1,bit_kind_size-1)) + p2_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) = ishft(one,iand(fh2-1,bit_kind_size-1)) key_mask(:,:) = key_in(:,:) - key_mask(ishft(fh1,-bit_kind_shift) + 1, fs1) -= ishft(1,iand(fh1-1,bit_kind_size-1)) - key_mask(ishft(fh2,-bit_kind_shift) + 1, fs2) -= ishft(1,iand(fh2-1,bit_kind_size-1)) - + key_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) -= ishft(one,iand(fh1-1,bit_kind_size-1)) + key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= ishft(one,iand(fh2-1,bit_kind_size-1)) + +! if(popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) + popcnt(key_mask(2,1)) + popcnt(key_mask(2,2)) /= 30) then +! print *, "wtf" +! print *, fh1, fh2, fs1, fs2 +! end if + call $subroutine_diexcOrg(key_in, key_mask, p1_mask, particl_1, p2_mask, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters ) end subroutine diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 081fb548..22a3ec92 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -104,27 +104,39 @@ subroutine getMobiles(key,key_mask, mobiles,Nint) integer,intent(out) :: mobiles(2) integer,intent(in) :: Nint - integer(bit_kind) :: mobileMask(2) + integer(bit_kind) :: mobileMask(Nint,2) + integer :: list(Nint*bit_kind_size), nel - if(Nint /= 1) then - print *, "GETMOBILES UNIMPLEMENTED" - stop - end if + do j=1,Nint + mobileMask(j,1) = xor(key(j,1), key_mask(j,1)) + mobileMask(j,2) = xor(key(j,2), key_mask(j,2)) +! print '(3(B70))', mobileMask(j,1), mobileMask(j,2) + end do +! print *, "==" - - 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)) + call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint) + if(nel == 2) then + mobiles(1) = list(1) + mobiles(2) = list(2) + else if(nel == 1) then + mobiles(1) = list(1) + call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint) + mobiles(2) = list(1) + mo_tot_num else - mobiles(1) = (trailz(mobileMask(2)) + 1) + mo_tot_num - mobiles(2) = bit_kind*8 - leadz(mobileMask(2)) + mo_tot_num + call bitstring_to_list(mobileMask(:,2), list(:), nel, Nint) + mobiles(1) = list(1) + mo_tot_num + mobiles(2) = list(2) + mo_tot_num end if +! if(mobiles(1) > 218 .or. mobiles(2) > 218 .or. mobiles(1) < 0 .or. mobiles(2) < 0) then +! print *," MOB", mobiles +! print '(3(B70))', mobileMask(:,1) +! print '(3(B70))', mobileMask(:,2) +! print '(3(B70))', key(:,1) +! print '(3(B70))', key(:,2) +! print '(3(B70))', key_mask(:,1) +! print '(3(B70))', key_mask(:,2) +! stop +! end if end subroutine @@ -133,19 +145,14 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro 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, intent(out) :: N_microlist(0:mo_tot_num*2), idx_microlist(N_minilist, 0:mo_tot_num*2) + integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, 0:mo_tot_num*2) integer :: i,j,k,nt,n_element(2) integer :: list(Nint*bit_kind_size,2) - integer(bit_kind) :: key_mask_neg(Nint,2) + integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2) - if(Nint /= 1) then - print *, "UNIMPLEMENTed" - stop - end if - do i=1,Nint key_mask_neg(i,1) = not(key_mask(i,1)) key_mask_neg(i,2) = not(key_mask(i,2)) @@ -153,22 +160,29 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro N_microlist(:) = 0 - do i=1, N_minilist - call bitstring_to_list(iand(key_mask_neg(1,1), minilist(1,1,i)), list(:,1), n_element(1), Nint) - call bitstring_to_list(iand(key_mask_neg(1,2), minilist(1,2,i)), list(:,2), n_element(2), Nint) + do j=1,Nint + mobileMask(j,1) = iand(key_mask_neg(j,1), minilist(j,1,i)) + mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i)) + end do - if(n_element(1) + n_element(2) > 4) then - print *, "WTF???" - stop - end if + call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint) + call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint) + +! if(n_element(1) + n_element(2) > 4) then +! print *, "WTF???" +! stop +! end if if(n_element(1) + n_element(2) /= 4) then - do j=1,mo_tot_num*2 - N_microlist(j) = N_microlist(j) + 1 - idx_microlist(N_microlist(j),j) = i - microlist(:,:,N_microlist(j),j) = minilist(:,:,i) - end do + N_microlist(0) = N_microlist(0) + 1 + idx_microlist(N_microlist(0),0) = i + microlist(:,:,N_microlist(0),0) = minilist(:,:,i) + !do j=1,mo_tot_num*2 +! N_microlist(j) = N_microlist(j) + 1 +! idx_microlist(N_microlist(j),j) = i +! microlist(:,:,N_microlist(j),j) = minilist(:,:,i) + !end do else do j=1,n_element(1) nt = list(j,1) From 3fd6e3c83b761b66f46a9e7f25d90fdf8f5d0c7b Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 18 Dec 2015 12:07:49 +0100 Subject: [PATCH 04/11] optimized --- plugins/CASSCF/ezfio_interface.irp.f | 4 - plugins/Perturbation/perturbation.template.f | 10 +- scripts/generate_h_apply.py | 6 +- src/Determinants/ezfio_interface.irp.f | 334 ------------------- 4 files changed, 10 insertions(+), 344 deletions(-) delete mode 100644 plugins/CASSCF/ezfio_interface.irp.f delete mode 100644 src/Determinants/ezfio_interface.irp.f diff --git a/plugins/CASSCF/ezfio_interface.irp.f b/plugins/CASSCF/ezfio_interface.irp.f deleted file mode 100644 index b086268f..00000000 --- a/plugins/CASSCF/ezfio_interface.irp.f +++ /dev/null @@ -1,4 +0,0 @@ -! 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 37f7840e..1c7f4dc4 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -98,9 +98,13 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c else smallerlist = mobiles(2) end if - microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) - idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) -! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & + + if(N_microlist(smallerlist) > 0) then + microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) + idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) + end if + !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size + ! 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_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) 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_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index e1c915bc..6194f5bc 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -99,7 +99,7 @@ class H_apply(object): deallocate(H_jj,iorder) """ - s["size_max"] = "256" + s["size_max"] = "2048" s["copy_buffer"] = """call copy_H_apply_buffer_to_wf if (s2_eig) then call make_s2_eigenfunction @@ -198,7 +198,7 @@ class H_apply(object): !$ call omp_unset_lock(lck) deallocate (e_2_pert_buffer, coef_pert_buffer) """ - self.data["size_max"] = "256" + self.data["size_max"] = "2048" self.data["initialization"] = """ PROVIDE psi_selectors_coef psi_selectors E_corr_per_selectors psi_det_sorted_bit """ @@ -265,7 +265,7 @@ class H_apply(object): double precision, intent(inout) :: select_max_out""" self.data["params_post"] += ", select_max(min(i_generator,size(select_max,1)))" - self.data["size_max"] = "256" + self.data["size_max"] = "2048" self.data["copy_buffer"] = """ call copy_H_apply_buffer_to_wf if (s2_eig) then diff --git a/src/Determinants/ezfio_interface.irp.f b/src/Determinants/ezfio_interface.irp.f deleted file mode 100644 index b68043b0..00000000 --- a/src/Determinants/ezfio_interface.irp.f +++ /dev/null @@ -1,334 +0,0 @@ -! 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 From 97bc25183fe82c489df3e6fb73bfd514bb6a3892 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 18 Dec 2015 13:40:03 +0100 Subject: [PATCH 05/11] bug in idx_microlist --- plugins/Perturbation/perturbation.template.f | 4 ++-- src/Determinants/filter_connected.irp.f | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 1c7f4dc4..02d7ecdd 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -65,7 +65,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(key_mask(1,1) /= 0) then call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) - do i=1,mo_tot_num*2 + do i=0,mo_tot_num*2 do k=1,N_microlist(i) idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) end do @@ -104,7 +104,7 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) end if !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size - ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & +! 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_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) 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_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 22a3ec92..3bfa0cae 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -178,11 +178,11 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro N_microlist(0) = N_microlist(0) + 1 idx_microlist(N_microlist(0),0) = i microlist(:,:,N_microlist(0),0) = minilist(:,:,i) - !do j=1,mo_tot_num*2 +! do j=1,mo_tot_num*2 ! N_microlist(j) = N_microlist(j) + 1 ! idx_microlist(N_microlist(j),j) = i ! microlist(:,:,N_microlist(j),j) = minilist(:,:,i) - !end do +! end do else do j=1,n_element(1) nt = list(j,1) From 0ffefd2f75a8defc402c1d0ca3007841caa97a1e Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 18 Dec 2015 14:29:45 +0100 Subject: [PATCH 06/11] microlist for is_connected_to --- plugins/Perturbation/perturbation.template.f | 42 ++++++++++++-------- 1 file changed, 25 insertions(+), 17 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 02d7ecdd..20e22513 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -35,7 +35,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c integer, allocatable :: idx_microlist(:,:), N_microlist(:) integer :: mobiles(2), smallerlist - + + integer(bit_kind), allocatable :: microlist_gen(:,:,:,:) + integer, allocatable :: idx_microlist_gen(:,:), N_microlist_gen(:) + allocate( minilist(Nint,2,N_det_selectors), & minilist_gen(Nint,2,N_det_generators), & idx_minilist(N_det_selectors)) @@ -61,10 +64,13 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c idx_microlist(N_minilist, 0:mo_tot_num*2), & N_microlist(0:mo_tot_num*2) ) - + allocate( microlist_gen(Nint,2,N_minilist_gen, 0:mo_tot_num*2), & + idx_microlist_gen(N_minilist_gen, 0:mo_tot_num*2), & + N_microlist_gen(0:mo_tot_num*2) ) if(key_mask(1,1) /= 0) then call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) + call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,Nint) do i=0,mo_tot_num*2 do k=1,N_microlist(i) idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) @@ -74,31 +80,29 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c do i=1,buffer_size - if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then - cycle - end if - if (is_in_wavefunction(buffer(1,1,i),Nint)) then cycle endif - - - if(key_mask(1,1) /= 0) then - call getMobiles(buffer(:,:,i), key_mask, mobiles, Nint) -! if(popcnt(buffer(1,1,i)) + popcnt(buffer(2,1,i)) /= 16 .or. popcnt(buffer(1,2,i)) + popcnt(buffer(2,2,i)) /= 16 .or. popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) /= 30) then -! print *, "wtf?" -! print '(3(B70))', buffer(:,1,i) -! print '(3(B70))', buffer(:,2,i) -! print '(3(B70))', popcnt(key_mask(1,1)) -! print '(3(B70))', popcnt(key_mask(1,2)) -! end if + if(key_mask(1,1) /= 0) then + call getMobiles(buffer(:,:,i), key_mask, mobiles, Nint) if(N_microlist(mobiles(1)) < N_microlist(mobiles(2))) then smallerlist = mobiles(1) else smallerlist = mobiles(2) end if + if(N_microlist(smallerlist) > 0) then + if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,smallerlist), Nint, N_microlist_gen(smallerlist))) then + cycle + end if + end if + + if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,0), Nint, N_microlist_gen(0))) then + cycle + end if + + if(N_microlist(smallerlist) > 0) then microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) @@ -110,6 +114,10 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) else + if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then + cycle + 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) end if From e207c1d51af394c3159d7354822dbf242fa59704 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 18 Dec 2015 16:19:09 +0100 Subject: [PATCH 07/11] subroutine merdge --- plugins/Perturbation/perturbation.template.f | 6 +++--- src/Determinants/filter_connected.irp.f | 16 ++++++++++++++++ 2 files changed, 19 insertions(+), 3 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 20e22513..1e064133 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -104,8 +104,9 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(N_microlist(smallerlist) > 0) then - microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) - idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) +! microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) +! idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) + call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) end if !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & @@ -141,7 +142,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c end - subroutine perturb_buffer_by_mono_$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 diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 3bfa0cae..060e1547 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -199,9 +199,25 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro end do end if end do +! +! do j=1,mo_tot_num*2 +! idx_microlist(N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = idx_microlist(1:N_microlist(0),0) +! microlist(:,:,N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = microlist(:,:,1:N_microlist(0),0) +! N_microlist(j) += N_microlist(0) +! end do end subroutine +subroutine merdge(mic, idx_mic, N_mic, mic0, idx_mic0, N_mic0, Nint) + use bitmasks + integer(bit_kind) :: mic(Nint,2,N_mic), mic0(Nint,2,*) + integer :: idx_mic(N_mic), idx_mic0(N_mic0), N_mic, N_mic0 + + mic0(:,:,N_mic0+1:N_mic0+N_mic) = mic(:,:,:) + idx_mic0(N_mic0+1:N_mic0+N_mic) = idx_mic(:) +end subroutine + + subroutine filter_connected_i_H_psi0(key1,key2,Nint,sze,idx) use bitmasks BEGIN_DOC From d48ff4c00ee4ff66d3772c85d6a50ee868680049 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Wed, 30 Dec 2015 11:35:06 +0100 Subject: [PATCH 08/11] removed merdge - buffer size = 8192 --- plugins/Perturbation/perturbation.template.f | 6 +++--- scripts/generate_h_apply.py | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 1e064133..7fdd3435 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -104,9 +104,9 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(N_microlist(smallerlist) > 0) then -! microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) -! idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) - call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) + microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) + idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) +! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) end if !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size ! call pt2_$PERT(psi_det_generators(1,1,i_generator),buffer(1,1,i), fock_diag_tmp, & diff --git a/scripts/generate_h_apply.py b/scripts/generate_h_apply.py index 6194f5bc..02524c3d 100755 --- a/scripts/generate_h_apply.py +++ b/scripts/generate_h_apply.py @@ -99,7 +99,7 @@ class H_apply(object): deallocate(H_jj,iorder) """ - s["size_max"] = "2048" + s["size_max"] = "8192" s["copy_buffer"] = """call copy_H_apply_buffer_to_wf if (s2_eig) then call make_s2_eigenfunction @@ -198,7 +198,7 @@ class H_apply(object): !$ call omp_unset_lock(lck) deallocate (e_2_pert_buffer, coef_pert_buffer) """ - self.data["size_max"] = "2048" + self.data["size_max"] = "8192" self.data["initialization"] = """ PROVIDE psi_selectors_coef psi_selectors E_corr_per_selectors psi_det_sorted_bit """ @@ -265,7 +265,7 @@ class H_apply(object): double precision, intent(inout) :: select_max_out""" self.data["params_post"] += ", select_max(min(i_generator,size(select_max,1)))" - self.data["size_max"] = "2048" + self.data["size_max"] = "8192" self.data["copy_buffer"] = """ call copy_H_apply_buffer_to_wf if (s2_eig) then From 16135a724812f75d169284c6cb800c0860794be0 Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Fri, 1 Jan 2016 11:47:17 +0100 Subject: [PATCH 09/11] reduced RAM requirement --- plugins/Perturbation/perturbation.template.f | 69 +++++++++++------ src/Determinants/filter_connected.irp.f | 80 ++++++++++---------- 2 files changed, 88 insertions(+), 61 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 7fdd3435..e490ce07 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -31,13 +31,13 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c logical :: fullMatch logical, external :: is_connected_to - integer(bit_kind), allocatable :: microlist(:,:,:,:) - integer, allocatable :: idx_microlist(:,:), N_microlist(:) + integer(bit_kind), allocatable :: microlist(:,:,:), microlist_zero(:,:,:) + integer, allocatable :: idx_microlist(:), N_microlist(:), ptr_microlist(:), idx_microlist_zero(:) integer :: mobiles(2), smallerlist - integer(bit_kind), allocatable :: microlist_gen(:,:,:,:) - integer, allocatable :: idx_microlist_gen(:,:), N_microlist_gen(:) + integer(bit_kind), allocatable :: microlist_gen(:,:,:) + integer, allocatable :: idx_microlist_gen(:), N_microlist_gen(:), ptr_microlist_gen(:) allocate( minilist(Nint,2,N_det_selectors), & minilist_gen(Nint,2,N_det_generators), & @@ -60,22 +60,43 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c return end if call create_minilist(key_mask, psi_selectors, minilist, idx_miniList, N_det_selectors, N_minilist, Nint) - allocate( microlist(Nint,2,N_minilist, 0:mo_tot_num*2), & - idx_microlist(N_minilist, 0:mo_tot_num*2), & + allocate( microlist(Nint,2,N_minilist*4), & + idx_microlist(N_minilist*4), & + ptr_microlist(0:mo_tot_num*2+1), & N_microlist(0:mo_tot_num*2) ) - allocate( microlist_gen(Nint,2,N_minilist_gen, 0:mo_tot_num*2), & - idx_microlist_gen(N_minilist_gen, 0:mo_tot_num*2), & + allocate( microlist_gen(Nint,2,N_minilist_gen*4), & + idx_microlist_gen(N_minilist_gen*4 ), & + ptr_microlist_gen(0:mo_tot_num*2+1), & N_microlist_gen(0:mo_tot_num*2) ) if(key_mask(1,1) /= 0) then - call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist,Nint) - call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,Nint) +! ptr_microlist(0) = 1 +! ptr_microlist_gen(0) = 1 +! do i=1,mo_tot_num*2+1 +! ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1) +! ptr_microlist_gen(i) = ptr_microlist_gen(i-1) + N_microlist_gen(i-1) +! end do + + call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) + call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,ptr_microlist_gen,Nint) + + allocate(microlist_zero(Nint,2,N_minilist)) + allocate(idx_microlist_zero(N_minilist)) + + do i=0,mo_tot_num*2 - do k=1,N_microlist(i) - idx_microlist(k,i) = idx_minilist(idx_microlist(k,i)) + do k=ptr_microlist(i),ptr_microlist(i+1)-1 + idx_microlist(k) = idx_minilist(idx_microlist(k)) end do end do + + + if(N_microlist(0) > 0) then + microlist_zero(:,:,1:N_microlist(0)) = microlist(:,:,1:N_microlist(0)) + idx_microlist_zero(1:N_microlist(0)) = idx_microlist(1:N_microlist(0)) + end if + end if do i=1,buffer_size @@ -92,28 +113,30 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c smallerlist = mobiles(2) end if - if(N_microlist(smallerlist) > 0) then - if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,smallerlist), Nint, N_microlist_gen(smallerlist))) then + if(N_microlist_gen(smallerlist) > 0) then + if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,ptr_microlist_gen(smallerlist):ptr_microlist_gen(smallerlist+1)-1), Nint, N_microlist_gen(smallerlist))) then + cycle + end if + end if + if(N_microlist_gen(0) > 0) then + if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,1:ptr_microlist_gen(1)-1), Nint, N_microlist_gen(0))) then cycle end if end if - if(is_connected_to(buffer(1,1,i), microlist_gen(:,:,:,0), Nint, N_microlist_gen(0))) then - cycle - end if - - if(N_microlist(smallerlist) > 0) then - microlist(:,:,N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = microlist(:,:,1:N_microlist(smallerlist),smallerlist) - idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist),0) = idx_microlist(1:N_microlist(smallerlist),smallerlist) + microlist_zero(:,:,ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = microlist(:,:,ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1) + idx_microlist_zero(ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = idx_microlist(ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1) + !idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist)) = idx_microlist(1:N_microlist(smallerlist)) ! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) end if !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size ! 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_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) +! 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_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) 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_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) - + c_pert,e_2_pert,H_pert_diag,Nint,N_microlist(smallerlist)+N_microlist(0),n_st,microlist_zero(:,:,:),idx_microlist_zero(:),N_microlist(smallerlist)+N_microlist(0)) else if(is_connected_to(buffer(1,1,i), miniList_gen, Nint, N_minilist_gen)) then cycle diff --git a/src/Determinants/filter_connected.irp.f b/src/Determinants/filter_connected.irp.f index 060e1547..8635d921 100644 --- a/src/Determinants/filter_connected.irp.f +++ b/src/Determinants/filter_connected.irp.f @@ -110,9 +110,7 @@ subroutine getMobiles(key,key_mask, mobiles,Nint) do j=1,Nint mobileMask(j,1) = xor(key(j,1), key_mask(j,1)) mobileMask(j,2) = xor(key(j,2), key_mask(j,2)) -! print '(3(B70))', mobileMask(j,1), mobileMask(j,2) end do -! print *, "==" call bitstring_to_list(mobileMask(:,1), list(:), nel, Nint) if(nel == 2) then @@ -127,29 +125,19 @@ subroutine getMobiles(key,key_mask, mobiles,Nint) mobiles(1) = list(1) + mo_tot_num mobiles(2) = list(2) + mo_tot_num end if -! if(mobiles(1) > 218 .or. mobiles(2) > 218 .or. mobiles(1) < 0 .or. mobiles(2) < 0) then -! print *," MOB", mobiles -! print '(3(B70))', mobileMask(:,1) -! print '(3(B70))', mobileMask(:,2) -! print '(3(B70))', key(:,1) -! print '(3(B70))', key(:,2) -! print '(3(B70))', key_mask(:,1) -! print '(3(B70))', key_mask(:,2) -! stop -! end if end subroutine -subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, Nint) +subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_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(0:mo_tot_num*2), idx_microlist(N_minilist, 0:mo_tot_num*2) - integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist, 0:mo_tot_num*2) + integer, intent(out) :: N_microlist(0:mo_tot_num*2), ptr_microlist(0:mo_tot_num*2+1), idx_microlist(N_minilist*4) + integer(bit_kind), intent(out) :: microlist(Nint,2,N_minilist*4) integer :: i,j,k,nt,n_element(2) - integer :: list(Nint*bit_kind_size,2) + integer :: list(Nint*bit_kind_size,2), cur_microlist(0:mo_tot_num*2+1) integer(bit_kind) :: key_mask_neg(Nint,2), mobileMask(Nint,2) @@ -169,42 +157,58 @@ subroutine create_microlist(minilist, N_minilist, key_mask, microlist, idx_micro call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint) call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint) -! if(n_element(1) + n_element(2) > 4) then -! print *, "WTF???" -! stop -! end if - if(n_element(1) + n_element(2) /= 4) then N_microlist(0) = N_microlist(0) + 1 - idx_microlist(N_microlist(0),0) = i - microlist(:,:,N_microlist(0),0) = minilist(:,:,i) -! do j=1,mo_tot_num*2 -! N_microlist(j) = N_microlist(j) + 1 -! idx_microlist(N_microlist(j),j) = i -! microlist(:,:,N_microlist(j),j) = minilist(:,:,i) -! end do else do j=1,n_element(1) nt = list(j,1) N_microlist(nt) = N_microlist(nt) + 1 - idx_microlist(N_microlist(nt),nt) = i - microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i) end do do j=1,n_element(2) nt = list(j,2) + mo_tot_num N_microlist(nt) = N_microlist(nt) + 1 - idx_microlist(N_microlist(nt),nt) = i - microlist(:,:,N_microlist(nt),nt) = minilist(:,:,i) end do end if end do -! -! do j=1,mo_tot_num*2 -! idx_microlist(N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = idx_microlist(1:N_microlist(0),0) -! microlist(:,:,N_microlist(j)+1:N_microlist(j)+N_microlist(0),j) = microlist(:,:,1:N_microlist(0),0) -! N_microlist(j) += N_microlist(0) -! end do + + ptr_microlist(0) = 1 + do i=1,mo_tot_num*2+1 + ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1) + end do + + cur_microlist(:) = ptr_microlist(:) + + do i=1, N_minilist + do j=1,Nint + mobileMask(j,1) = iand(key_mask_neg(j,1), minilist(j,1,i)) + mobileMask(j,2) = iand(key_mask_neg(j,2), minilist(j,2,i)) + end do + + call bitstring_to_list(mobileMask(:,1), list(:,1), n_element(1), Nint) + call bitstring_to_list(mobileMask(:,2), list(:,2), n_element(2), Nint) + + + if(n_element(1) + n_element(2) /= 4) then + idx_microlist(cur_microlist(0)) = i + microlist(:,:,cur_microlist(0)) = minilist(:,:,i) + cur_microlist(0) = cur_microlist(0) + 1 + else + do j=1,n_element(1) + nt = list(j,1) + idx_microlist(cur_microlist(nt)) = i + microlist(:,:,cur_microlist(nt)) = minilist(:,:,i) + cur_microlist(nt) = cur_microlist(nt) + 1 + end do + + do j=1,n_element(2) + nt = list(j,2) + mo_tot_num + idx_microlist(cur_microlist(nt)) = i + microlist(:,:,cur_microlist(nt)) = minilist(:,:,i) + cur_microlist(nt) = cur_microlist(nt) + 1 + end do + end if + end do end subroutine From aa6d4c23a519202982a2ab7452e328b5c50ffbea Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Sun, 3 Jan 2016 10:07:03 +0100 Subject: [PATCH 10/11] cleaning --- plugins/Perturbation/perturbation.template.f | 14 -------------- src/Determinants/H_apply.template.f | 6 +----- 2 files changed, 1 insertion(+), 19 deletions(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index e490ce07..2298a10f 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -71,12 +71,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c N_microlist_gen(0:mo_tot_num*2) ) if(key_mask(1,1) /= 0) then -! ptr_microlist(0) = 1 -! ptr_microlist_gen(0) = 1 -! do i=1,mo_tot_num*2+1 -! ptr_microlist(i) = ptr_microlist(i-1) + N_microlist(i-1) -! ptr_microlist_gen(i) = ptr_microlist_gen(i-1) + N_microlist_gen(i-1) -! end do call create_microlist(minilist, N_minilist, key_mask, microlist, idx_microlist, N_microlist, ptr_microlist, Nint) call create_microlist(minilist_gen, N_minilist_gen, key_mask, microlist_gen, idx_microlist_gen, N_microlist_gen,ptr_microlist_gen,Nint) @@ -127,14 +121,8 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c if(N_microlist(smallerlist) > 0) then microlist_zero(:,:,ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = microlist(:,:,ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1) idx_microlist_zero(ptr_microlist(1):ptr_microlist(1)+N_microlist(smallerlist)-1) = idx_microlist(ptr_microlist(smallerlist):ptr_microlist(smallerlist+1)-1) - !idx_microlist(N_microlist(0)+1:N_microlist(0)+N_microlist(smallerlist)) = idx_microlist(1:N_microlist(smallerlist)) ! call merdge(microlist(:,:,:,smallerlist), idx_microlist(:,smallerlist), N_microlist(smallerlist), microlist(:,:,:,0), idx_microlist(:,0), N_microlist(0)) end if - !if (N_minilist > 23 .and. N_minilist < 500) print *, "***************", N_det_selectors, N_minilist, N_microlist(0), N_microlist(smallerlist), buffer_size -! 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_microlist(smallerlist),n_st,microlist(:,:,:,smallerList),idx_microlist(:,smallerlist),N_microlist(smallerlist)) -! 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_microlist(smallerlist)+N_microlist(0),n_st,microlist(:,:,:,0),idx_microlist(:,0),N_microlist(smallerlist)+N_microlist(0)) 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_microlist(smallerlist)+N_microlist(0),n_st,microlist_zero(:,:,:),idx_microlist_zero(:),N_microlist(smallerlist)+N_microlist(0)) else @@ -146,8 +134,6 @@ subroutine perturb_buffer_$PERT(i_generator,buffer,buffer_size,e_2_pert_buffer,c c_pert,e_2_pert,H_pert_diag,Nint,N_minilist,n_st,minilist,idx_minilist,N_minilist) end if - !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) diff --git a/src/Determinants/H_apply.template.f b/src/Determinants/H_apply.template.f index d9131936..7a92ca20 100644 --- a/src/Determinants/H_apply.template.f +++ b/src/Determinants/H_apply.template.f @@ -105,7 +105,7 @@ subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, integer(bit_kind) :: miniList(N_int, 2, N_det) integer :: n_minilist, n_alpha, n_beta, deg(2), i, ni $declarations - integer(bit_kind), parameter :: one = 1_8 + integer(bit_kind), parameter :: one = 1_bit_kind p1_mask(:,:) = 0_bit_kind p2_mask(:,:) = 0_bit_kind @@ -117,10 +117,6 @@ subroutine $subroutine_diexcP(key_in, fs1, fh1, particl_1, fs2, fh2, particl_2, key_mask(ishft(fh1-1,-bit_kind_shift) + 1, fs1) -= ishft(one,iand(fh1-1,bit_kind_size-1)) key_mask(ishft(fh2-1,-bit_kind_shift) + 1, fs2) -= ishft(one,iand(fh2-1,bit_kind_size-1)) -! if(popcnt(key_mask(1,1)) + popcnt(key_mask(1,2)) + popcnt(key_mask(2,1)) + popcnt(key_mask(2,2)) /= 30) then -! print *, "wtf" -! print *, fh1, fh2, fs1, fs2 -! end if call $subroutine_diexcOrg(key_in, key_mask, p1_mask, particl_1, p2_mask, particl_2, fock_diag_tmp, i_generator, iproc_in $parameters ) end subroutine From 389ad54e5080194861382b818f12bc712a2079de Mon Sep 17 00:00:00 2001 From: Yann Garniron Date: Sun, 3 Jan 2016 10:14:43 +0100 Subject: [PATCH 11/11] forgot some deallocates --- plugins/Perturbation/perturbation.template.f | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/plugins/Perturbation/perturbation.template.f b/plugins/Perturbation/perturbation.template.f index 2298a10f..d4e46396 100644 --- a/plugins/Perturbation/perturbation.template.f +++ b/plugins/Perturbation/perturbation.template.f @@ -147,7 +147,8 @@ 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 ) + deallocate( microlist, idx_microlist, N_microlist,ptr_microlist ) + deallocate( microlist_gen, idx_microlist_gen,N_microlist_gen,ptr_microlist_gen ) end