From 31efb20a187e8089db88590d6bc6036801b92721 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 12 Jul 2017 23:23:46 +0200 Subject: [PATCH 01/10] Fixed mmap --- src/Utils/fortran_mmap.c | 9 +++++++++ src/Utils/map_functions.irp.f | 20 +++++++------------- src/Utils/mmap.f90 | 27 +++++++++++++++++++++++++-- 3 files changed, 41 insertions(+), 15 deletions(-) diff --git a/src/Utils/fortran_mmap.c b/src/Utils/fortran_mmap.c index eee8337e..41ad93ec 100644 --- a/src/Utils/fortran_mmap.c +++ b/src/Utils/fortran_mmap.c @@ -70,3 +70,12 @@ void munmap_fortran(size_t bytes, int fd, void* map) } close(fd); } + + +void msync_fortran(size_t bytes, int fd, void* map) +{ + if (msync(map, bytes, MS_SYNC) == -1) { + perror("Error syncing the mmap file"); + } +} + diff --git a/src/Utils/map_functions.irp.f b/src/Utils/map_functions.irp.f index 54797679..de7f66d7 100644 --- a/src/Utils/map_functions.irp.f +++ b/src/Utils/map_functions.irp.f @@ -52,18 +52,14 @@ subroutine map_save_to_disk(filename,map) map % consolidated_idx (map % map_size + 2_8) = k map % consolidated = .True. + integer*8 :: n_elements + n_elements = int(map % n_elements,8) - call munmap( (/ map % map_size + 2_8 /), 8, fd(1), c_pointer(1)) - call mmap(trim(filename)//'_consolidated_idx', (/ map % map_size + 2_8 /), 8, fd(1), .True., c_pointer(1)) - call c_f_pointer(c_pointer(1),map % consolidated_idx, (/ map % map_size +2_8/)) - - call munmap( (/ map % n_elements /), cache_key_kind, fd(2), c_pointer(2)) - call mmap(trim(filename)//'_consolidated_key', (/ map % n_elements /), cache_key_kind, fd(2), .True., c_pointer(2)) - call c_f_pointer(c_pointer(2),map % consolidated_key, (/ map % n_elements /)) - - call munmap( (/ map % n_elements /), integral_kind, fd(3), c_pointer(3)) - call mmap(trim(filename)//'_consolidated_value', (/ map % n_elements /), integral_kind, fd(3), .True., c_pointer(3)) - call c_f_pointer(c_pointer(3),map % consolidated_value, (/ map % n_elements /)) + print *, 'Writing data to disk...' + call msync ( (/ map % map_size + 2_8 /), 8, fd(1), c_pointer(1)) + call msync ( (/ n_elements /), cache_key_kind, fd(2), c_pointer(2)) + call msync ( (/ n_elements /), integral_kind , fd(3), c_pointer(3)) + print *, 'Done' end @@ -79,8 +75,6 @@ subroutine map_load_from_disk(filename,map) integer*8 :: i,k,l integer*4 :: j,n_elements - - if (map % consolidated) then stop 'map already consolidated' endif diff --git a/src/Utils/mmap.f90 b/src/Utils/mmap.f90 index 58def0ae..5a833881 100644 --- a/src/Utils/mmap.f90 +++ b/src/Utils/mmap.f90 @@ -15,7 +15,14 @@ module mmap_module integer(c_int), intent(in), value :: read_only end function - subroutine c_munmap(length, fd, map) bind(c,name='munmap_fortran') + subroutine c_munmap_fortran(length, fd, map) bind(c,name='munmap_fortran') + use iso_c_binding + integer(c_size_t), intent(in), value :: length + integer(c_int), intent(in), value :: fd + type(c_ptr), intent(in), value :: map + end subroutine + + subroutine c_msync_fortran(length, fd, map) bind(c,name='msync_fortran') use iso_c_binding integer(c_size_t), intent(in), value :: length integer(c_int), intent(in), value :: fd @@ -61,7 +68,23 @@ module mmap_module length = PRODUCT( shape(:) ) * bytes fd_ = fd - call c_munmap( length, fd_, map) + call c_munmap_fortran( length, fd_, map) + end subroutine + + subroutine msync(shape, bytes, fd, map) + use iso_c_binding + implicit none + integer*8, intent(in) :: shape(:) ! Shape of the array to map + integer, intent(in) :: bytes ! Number of bytes per element + integer, intent(in) :: fd ! File descriptor + type(c_ptr), intent(in) :: map ! C pointer + + integer(c_size_t) :: length + integer(c_int) :: fd_ + + length = PRODUCT( shape(:) ) * bytes + fd_ = fd + call c_msync_fortran( length, fd_, map) end subroutine end module mmap_module From 64343b63a400228c2b2de5069c2a2e733219d670 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 12 Jul 2017 23:44:37 +0200 Subject: [PATCH 02/10] Truncated wf a la QMC=Chem --- plugins/QmcChem/truncate_wf_spin.irp.f | 104 ++++++++++++++++++++++++ src/Determinants/spindeterminants.irp.f | 33 ++++++++ 2 files changed, 137 insertions(+) create mode 100644 plugins/QmcChem/truncate_wf_spin.irp.f diff --git a/plugins/QmcChem/truncate_wf_spin.irp.f b/plugins/QmcChem/truncate_wf_spin.irp.f new file mode 100644 index 00000000..b4d6e500 --- /dev/null +++ b/plugins/QmcChem/truncate_wf_spin.irp.f @@ -0,0 +1,104 @@ +program e_curve + use bitmasks + implicit none + integer :: i,j,k, kk, nab, m, l + double precision :: norm, E, hij, num, ci, cj + integer, allocatable :: iorder(:) + double precision , allocatable :: norm_sort(:) + double precision :: e_0(N_states) + if (.not.read_wf) then + stop 'Please set read_wf to true' + endif + + PROVIDE mo_bielec_integrals_in_map H_apply_buffer_allocated + + nab = n_det_alpha_unique+n_det_beta_unique + allocate ( norm_sort(0:nab), iorder(0:nab) ) + + double precision :: thresh + integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:) + double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) + double precision, allocatable :: u_0(:,:), v_0(:,:) + allocate(u_t(N_states,N_det),v_t(N_states,N_det),s_t(N_states,N_det)) + allocate(u_0(N_states,N_det),v_0(N_states,N_det)) + + print *, 'Threshold?' + read(*,*) thresh + + norm_sort(0) = 0.d0 + iorder(0) = 0 + do i=1,n_det_alpha_unique + norm_sort(i) = det_alpha_norm(i) + iorder(i) = i + enddo + + do i=1,n_det_beta_unique + norm_sort(i+n_det_alpha_unique) = det_beta_norm(i) + iorder(i+n_det_alpha_unique) = -i + enddo + + call dsort(norm_sort(1),iorder(1),nab) + + + PROVIDE psi_bilinear_matrix_values nuclear_repulsion + print *, '' + do j=0,nab + i = iorder(j) + if (i<0) then + do k=1,n_det + if (psi_bilinear_matrix_columns(k) == -i) then + psi_bilinear_matrix_values(k,1) = 0.d0 + endif + enddo + else + do k=1,n_det + if (psi_bilinear_matrix_rows(k) == i) then + psi_bilinear_matrix_values(k,1) = 0.d0 + endif + enddo + endif + if (thresh > norm_sort(j)) then + cycle + endif + + u_0 = psi_bilinear_matrix_values(1:N_det,1:N_states) + v_t = 0.d0 + s_t = 0.d0 + call dtranspose( & + u_0, & + size(u_0, 1), & + u_t, & + size(u_t, 1), & + N_det, N_states) + call H_S2_u_0_nstates_openmp_work(v_t,s_t,u_t,N_states,N_det,1,N_det,0,1) + call dtranspose( & + v_t, & + size(v_t, 1), & + v_0, & + size(v_0, 1), & + N_states, N_det) + + double precision, external :: u_dot_u, u_dot_v + do i=1,N_states + e_0(i) = u_dot_v(v_t(1,i),u_0(1,i),N_det)/u_dot_u(u_0(1,i),N_det) + enddo + + m = 0 + do k=1,n_det + if (psi_bilinear_matrix_values(k,1) /= 0.d0) then + m = m+1 + endif + enddo + + E = E_0(1) + nuclear_repulsion + norm = u_dot_u(u_0(1,1),N_det) + print *, 'Number of determinants:', m + print *, 'Energy', E + exit + enddo + call wf_of_psi_bilinear_matrix() + call save_wavefunction + + deallocate (iorder, norm_sort) +end + diff --git a/src/Determinants/spindeterminants.irp.f b/src/Determinants/spindeterminants.irp.f index 10edf710..a1ad04fe 100644 --- a/src/Determinants/spindeterminants.irp.f +++ b/src/Determinants/spindeterminants.irp.f @@ -1204,3 +1204,36 @@ N_int;; END_TEMPLATE +subroutine wf_of_psi_bilinear_matrix(truncate) + use bitmasks + implicit none + BEGIN_DOC +! Generate a wave function containing all possible products +! of alpha and beta determinants + END_DOC + logical, intent(in) :: truncate + integer :: i,j,k + integer(bit_kind) :: tmp_det(N_int,2) + integer :: idx + integer, external :: get_index_in_psi_det_sorted_bit + double precision :: norm(N_states) + PROVIDE psi_bilinear_matrix + + do k=1,N_det + i = psi_bilinear_matrix_rows(k) + j = psi_bilinear_matrix_columns(k) + psi_det(1:N_int,1,k) = psi_det_alpha_unique(1:N_int,i) + psi_det(1:N_int,2,k) = psi_det_beta_unique (1:N_int,j) + enddo + psi_coef(1:N_det,1:N_states) = psi_bilinear_matrix_values(1:N_det,1:N_states) + TOUCH psi_det psi_coef + + psi_det = psi_det_sorted + psi_coef = psi_coef_sorted + do while (sum( dabs(psi_coef(N_det,1:N_states)) ) == 0.d0) + N_det -= 1 + enddo + SOFT_TOUCH psi_det psi_coef N_det + +end + From 2c8b68fadaee11f0aa89861f781b645e5ee76a84 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 12 Jul 2017 23:47:44 +0200 Subject: [PATCH 03/10] Merged QmcChem and qmcpack modules --- plugins/{QmcChem => QMC}/NEEDED_CHILDREN_MODULES | 0 plugins/{QmcChem => QMC}/README.rst | 0 plugins/{QmcChem => QMC}/dressed_dmc.irp.f | 0 plugins/{QmcChem => QMC}/pot_ao_pseudo_ints.irp.f | 0 plugins/{QmcChem => QMC}/pseudo.irp.f | 0 plugins/{QmcChem => QMC}/qmc_create_wf.irp.f | 0 plugins/{QmcChem => QMC}/qmc_e_curve.irp.f | 0 .../{qmcpack => QMC}/qp_convert_qmcpack_to_ezfio.py | 0 plugins/{QmcChem => QMC}/save_for_qmcchem.irp.f | 0 plugins/{qmcpack => QMC}/save_for_qmcpack.irp.f | 0 plugins/{QmcChem => QMC}/target_pt2_qmc.irp.f | 0 plugins/{QmcChem => QMC}/tree_dependency.png | Bin plugins/{QmcChem => QMC}/truncate_wf_spin.irp.f | 0 13 files changed, 0 insertions(+), 0 deletions(-) rename plugins/{QmcChem => QMC}/NEEDED_CHILDREN_MODULES (100%) rename plugins/{QmcChem => QMC}/README.rst (100%) rename plugins/{QmcChem => QMC}/dressed_dmc.irp.f (100%) rename plugins/{QmcChem => QMC}/pot_ao_pseudo_ints.irp.f (100%) rename plugins/{QmcChem => QMC}/pseudo.irp.f (100%) rename plugins/{QmcChem => QMC}/qmc_create_wf.irp.f (100%) rename plugins/{QmcChem => QMC}/qmc_e_curve.irp.f (100%) rename plugins/{qmcpack => QMC}/qp_convert_qmcpack_to_ezfio.py (100%) rename plugins/{QmcChem => QMC}/save_for_qmcchem.irp.f (100%) rename plugins/{qmcpack => QMC}/save_for_qmcpack.irp.f (100%) rename plugins/{QmcChem => QMC}/target_pt2_qmc.irp.f (100%) rename plugins/{QmcChem => QMC}/tree_dependency.png (100%) rename plugins/{QmcChem => QMC}/truncate_wf_spin.irp.f (100%) diff --git a/plugins/QmcChem/NEEDED_CHILDREN_MODULES b/plugins/QMC/NEEDED_CHILDREN_MODULES similarity index 100% rename from plugins/QmcChem/NEEDED_CHILDREN_MODULES rename to plugins/QMC/NEEDED_CHILDREN_MODULES diff --git a/plugins/QmcChem/README.rst b/plugins/QMC/README.rst similarity index 100% rename from plugins/QmcChem/README.rst rename to plugins/QMC/README.rst diff --git a/plugins/QmcChem/dressed_dmc.irp.f b/plugins/QMC/dressed_dmc.irp.f similarity index 100% rename from plugins/QmcChem/dressed_dmc.irp.f rename to plugins/QMC/dressed_dmc.irp.f diff --git a/plugins/QmcChem/pot_ao_pseudo_ints.irp.f b/plugins/QMC/pot_ao_pseudo_ints.irp.f similarity index 100% rename from plugins/QmcChem/pot_ao_pseudo_ints.irp.f rename to plugins/QMC/pot_ao_pseudo_ints.irp.f diff --git a/plugins/QmcChem/pseudo.irp.f b/plugins/QMC/pseudo.irp.f similarity index 100% rename from plugins/QmcChem/pseudo.irp.f rename to plugins/QMC/pseudo.irp.f diff --git a/plugins/QmcChem/qmc_create_wf.irp.f b/plugins/QMC/qmc_create_wf.irp.f similarity index 100% rename from plugins/QmcChem/qmc_create_wf.irp.f rename to plugins/QMC/qmc_create_wf.irp.f diff --git a/plugins/QmcChem/qmc_e_curve.irp.f b/plugins/QMC/qmc_e_curve.irp.f similarity index 100% rename from plugins/QmcChem/qmc_e_curve.irp.f rename to plugins/QMC/qmc_e_curve.irp.f diff --git a/plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py b/plugins/QMC/qp_convert_qmcpack_to_ezfio.py similarity index 100% rename from plugins/qmcpack/qp_convert_qmcpack_to_ezfio.py rename to plugins/QMC/qp_convert_qmcpack_to_ezfio.py diff --git a/plugins/QmcChem/save_for_qmcchem.irp.f b/plugins/QMC/save_for_qmcchem.irp.f similarity index 100% rename from plugins/QmcChem/save_for_qmcchem.irp.f rename to plugins/QMC/save_for_qmcchem.irp.f diff --git a/plugins/qmcpack/save_for_qmcpack.irp.f b/plugins/QMC/save_for_qmcpack.irp.f similarity index 100% rename from plugins/qmcpack/save_for_qmcpack.irp.f rename to plugins/QMC/save_for_qmcpack.irp.f diff --git a/plugins/QmcChem/target_pt2_qmc.irp.f b/plugins/QMC/target_pt2_qmc.irp.f similarity index 100% rename from plugins/QmcChem/target_pt2_qmc.irp.f rename to plugins/QMC/target_pt2_qmc.irp.f diff --git a/plugins/QmcChem/tree_dependency.png b/plugins/QMC/tree_dependency.png similarity index 100% rename from plugins/QmcChem/tree_dependency.png rename to plugins/QMC/tree_dependency.png diff --git a/plugins/QmcChem/truncate_wf_spin.irp.f b/plugins/QMC/truncate_wf_spin.irp.f similarity index 100% rename from plugins/QmcChem/truncate_wf_spin.irp.f rename to plugins/QMC/truncate_wf_spin.irp.f From 67da0834f5de519f51184755cd0430d3bd6e913e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 14 Jul 2017 03:12:46 +0200 Subject: [PATCH 04/10] Correct annoying QMC bug --- plugins/QMC/NEEDED_CHILDREN_MODULES | 2 +- plugins/QMC/save_for_qmcchem.irp.f | 8 ++++---- plugins/QMC/truncate_wf_spin.irp.f | 2 +- src/Determinants/slater_rules.irp.f | 10 +++++++++- 4 files changed, 15 insertions(+), 7 deletions(-) diff --git a/plugins/QMC/NEEDED_CHILDREN_MODULES b/plugins/QMC/NEEDED_CHILDREN_MODULES index 34de8ddb..9a2f60c0 100644 --- a/plugins/QMC/NEEDED_CHILDREN_MODULES +++ b/plugins/QMC/NEEDED_CHILDREN_MODULES @@ -1 +1 @@ -Determinants Davidson +Determinants Davidson Full_CI_ZMQ diff --git a/plugins/QMC/save_for_qmcchem.irp.f b/plugins/QMC/save_for_qmcchem.irp.f index a281a184..771bf618 100644 --- a/plugins/QMC/save_for_qmcchem.irp.f +++ b/plugins/QMC/save_for_qmcchem.irp.f @@ -24,13 +24,13 @@ program save_for_qmc ) iunit = 13 open(unit=iunit,file=trim(ezfio_filename)//'/simulation/e_ref',action='write') - call ezfio_has_full_ci_energy_pt2(exists) + call ezfio_has_full_ci_zmq_energy_pt2(exists) if (exists) then - call ezfio_get_full_ci_energy_pt2(e_ref) + call ezfio_get_full_ci_zmq_energy_pt2(e_ref) else - call ezfio_has_full_ci_energy(exists) + call ezfio_has_full_ci_zmq_energy(exists) if (exists) then - call ezfio_get_full_ci_energy(e_ref) + call ezfio_get_full_ci_zmq_energy(e_ref) else call ezfio_has_hartree_fock_energy(exists) if (exists) then diff --git a/plugins/QMC/truncate_wf_spin.irp.f b/plugins/QMC/truncate_wf_spin.irp.f index b4d6e500..e8cde79e 100644 --- a/plugins/QMC/truncate_wf_spin.irp.f +++ b/plugins/QMC/truncate_wf_spin.irp.f @@ -20,7 +20,7 @@ program e_curve double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) double precision, allocatable :: u_0(:,:), v_0(:,:) allocate(u_t(N_states,N_det),v_t(N_states,N_det),s_t(N_states,N_det)) - allocate(u_0(N_states,N_det),v_0(N_states,N_det)) + allocate(u_0(N_det,N_states),v_0(N_det,N_states)) print *, 'Threshold?' read(*,*) thresh diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 51572462..80dbbad4 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -245,12 +245,16 @@ subroutine get_double_excitation(det1,det2,exc,phase,Nint) if (j==k) then nperm = nperm + popcnt(iand(det1(j,ispin), & iand( ibset(0_bit_kind,m-1)-1_bit_kind, & - ibclr(-1_bit_kind,n)+1_bit_kind ) )) + ibclr(-1_bit_kind,n)+1_bit_kind ) )) +! TODO iand( not(ishft(1_bit_kind,n+1))+1_bit_kind, & +! ishft(1_bit_kind,m)-1_bit_kind))) else nperm = nperm + popcnt(iand(det1(k,ispin), & ibset(0_bit_kind,m-1)-1_bit_kind)) +! TODO ishft(1_bit_kind,m)-1_bit_kind)) if (n < bit_kind_size) then nperm = nperm + popcnt(iand(det1(j,ispin), ibclr(-1_bit_kind,n) +1_bit_kind)) +! TODO ishft(1_bit_kind,m)-1_bit_kind)) endif do i=j+1,k-1 nperm = nperm + popcnt(det1(i,ispin)) @@ -365,8 +369,12 @@ subroutine get_mono_excitation(det1,det2,exc,phase,Nint) if (j==k) then nperm = popcnt(iand(det1(j,ispin), & iand(ibset(0_bit_kind,m-1)-1_bit_kind,ibclr(-1_bit_kind,n)+1_bit_kind))) +!TODO iand( not(ishft(1_bit_kind,n+1))+1_bit_kind, & +! ishft(1_bit_kind,m)-1_bit_kind))) else nperm = nperm + popcnt(iand(det1(k,ispin),ibset(0_bit_kind,m-1)-1_bit_kind)) +!TODO nperm = popcnt(iand(det1(k,ispin), ishft(1_bit_kind,m)-1_bit_kind)) + & +! popcnt(iand(det1(j,ispin), not(ishft(1_bit_kind,n+1))+1_bit_kind)) if (n < bit_kind_size) then nperm = nperm + popcnt(iand(det1(j,ispin),ibclr(-1_bit_kind,n)+1_bit_kind)) endif From 85862811ad398ad5e51337e75a12332df694870f Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 14 Jul 2017 01:24:51 +0000 Subject: [PATCH 05/10] Truncation in QMC and 4-idx --- plugins/QMC/EZFIO.cfg | 6 ++++++ plugins/QMC/truncate_wf_spin.irp.f | 12 ++++++++---- src/Integrals_Bielec/four_idx_transform.irp.f | 12 ++++++++++++ 3 files changed, 26 insertions(+), 4 deletions(-) create mode 100644 plugins/QMC/EZFIO.cfg create mode 100644 src/Integrals_Bielec/four_idx_transform.irp.f diff --git a/plugins/QMC/EZFIO.cfg b/plugins/QMC/EZFIO.cfg new file mode 100644 index 00000000..8960a0fa --- /dev/null +++ b/plugins/QMC/EZFIO.cfg @@ -0,0 +1,6 @@ +[ci_threshold] +type: Threshold +doc: Threshold on the CI coefficients as in QMCChem +interface: ezfio,provider,ocaml +default: 1.e-8 + diff --git a/plugins/QMC/truncate_wf_spin.irp.f b/plugins/QMC/truncate_wf_spin.irp.f index e8cde79e..12de19ca 100644 --- a/plugins/QMC/truncate_wf_spin.irp.f +++ b/plugins/QMC/truncate_wf_spin.irp.f @@ -15,15 +15,13 @@ program e_curve nab = n_det_alpha_unique+n_det_beta_unique allocate ( norm_sort(0:nab), iorder(0:nab) ) - double precision :: thresh integer(bit_kind), allocatable :: det_i(:,:), det_j(:,:) double precision, allocatable :: u_t(:,:), v_t(:,:), s_t(:,:) double precision, allocatable :: u_0(:,:), v_0(:,:) allocate(u_t(N_states,N_det),v_t(N_states,N_det),s_t(N_states,N_det)) allocate(u_0(N_det,N_states),v_0(N_det,N_states)) - print *, 'Threshold?' - read(*,*) thresh + read(*,*) ci_threshold norm_sort(0) = 0.d0 iorder(0) = 0 @@ -45,19 +43,23 @@ program e_curve do j=0,nab i = iorder(j) if (i<0) then + !$OMP PARALLEL DO PRIVATE(k) do k=1,n_det if (psi_bilinear_matrix_columns(k) == -i) then psi_bilinear_matrix_values(k,1) = 0.d0 endif enddo + !$OMP END PARALLEL DO else + !$OMP PARALLEL DO PRIVATE(k) do k=1,n_det if (psi_bilinear_matrix_rows(k) == i) then psi_bilinear_matrix_values(k,1) = 0.d0 endif enddo + !$OMP END PARALLEL DO endif - if (thresh > norm_sort(j)) then + if (ci_threshold > norm_sort(j)) then cycle endif @@ -70,7 +72,9 @@ program e_curve u_t, & size(u_t, 1), & N_det, N_states) + print *, 'Computing H|Psi> ...' call H_S2_u_0_nstates_openmp_work(v_t,s_t,u_t,N_states,N_det,1,N_det,0,1) + print *, 'Done' call dtranspose( & v_t, & size(v_t, 1), & diff --git a/src/Integrals_Bielec/four_idx_transform.irp.f b/src/Integrals_Bielec/four_idx_transform.irp.f new file mode 100644 index 00000000..a98ce2aa --- /dev/null +++ b/src/Integrals_Bielec/four_idx_transform.irp.f @@ -0,0 +1,12 @@ +program four_idx + implicit none + BEGIN_DOC +! 4-index transformation from AO to MO integrals + END_DOC + + disk_access_mo_integrals = 'Write' + SOFT_TOUCH disk_access_mo_integrals + if (.true.) then + PROVIDE mo_bielec_integrals_in_map + endif +end From ca1cdbe79ab1fb0d8ecacc11f1a71380ed898ad6 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 14 Jul 2017 14:13:01 +0000 Subject: [PATCH 06/10] Fixed save_for_qmcpack --- plugins/QMC/save_for_qmcpack.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/QMC/save_for_qmcpack.irp.f b/plugins/QMC/save_for_qmcpack.irp.f index 186ca616..51ed866d 100644 --- a/plugins/QMC/save_for_qmcpack.irp.f +++ b/plugins/QMC/save_for_qmcpack.irp.f @@ -21,6 +21,6 @@ program qmcpack enddo call save_mos call system('rm '//trim(ezfio_filename)//'/mo_basis/ao_md5') - call system('$QP_ROOT/src/qmcpack/qp_convert_qmcpack_to_ezfio.py '//trim(ezfio_filename)) + call system('$QP_ROOT/src/QMC/qp_convert_qmcpack_to_ezfio.py '//trim(ezfio_filename)) end From c46f4c5014710f1a9f938c42128aa7ba8a420c7b Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 14 Jul 2017 14:15:34 +0000 Subject: [PATCH 07/10] Fixed truncate --- plugins/QMC/truncate_wf_spin.irp.f | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/plugins/QMC/truncate_wf_spin.irp.f b/plugins/QMC/truncate_wf_spin.irp.f index 12de19ca..c9f863f1 100644 --- a/plugins/QMC/truncate_wf_spin.irp.f +++ b/plugins/QMC/truncate_wf_spin.irp.f @@ -1,4 +1,10 @@ -program e_curve +program truncate + read_wf = .True. + SOFT_TOUCH read_wf + call run +end + +subroutine run use bitmasks implicit none integer :: i,j,k, kk, nab, m, l @@ -6,9 +12,6 @@ program e_curve integer, allocatable :: iorder(:) double precision , allocatable :: norm_sort(:) double precision :: e_0(N_states) - if (.not.read_wf) then - stop 'Please set read_wf to true' - endif PROVIDE mo_bielec_integrals_in_map H_apply_buffer_allocated @@ -21,8 +24,6 @@ program e_curve allocate(u_t(N_states,N_det),v_t(N_states,N_det),s_t(N_states,N_det)) allocate(u_0(N_det,N_states),v_0(N_det,N_states)) - read(*,*) ci_threshold - norm_sort(0) = 0.d0 iorder(0) = 0 do i=1,n_det_alpha_unique From 5906cb5ac3a222fae61ba2a3f23131da813dbf6d Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 14 Jul 2017 19:31:57 +0000 Subject: [PATCH 08/10] Fixed truncate_wf_spin --- plugins/QMC/truncate_wf_spin.irp.f | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/plugins/QMC/truncate_wf_spin.irp.f b/plugins/QMC/truncate_wf_spin.irp.f index c9f863f1..5a5fe125 100644 --- a/plugins/QMC/truncate_wf_spin.irp.f +++ b/plugins/QMC/truncate_wf_spin.irp.f @@ -101,7 +101,7 @@ subroutine run print *, 'Energy', E exit enddo - call wf_of_psi_bilinear_matrix() + call wf_of_psi_bilinear_matrix(.True.) call save_wavefunction deallocate (iorder, norm_sort) From 24725e60e6704629fceb352c77609b37bea83658 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 14 Jul 2017 21:49:32 +0000 Subject: [PATCH 09/10] Removed memory bottleneck --- src/Determinants/spindeterminants.irp.f | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Determinants/spindeterminants.irp.f b/src/Determinants/spindeterminants.irp.f index a1ad04fe..b6ca1cba 100644 --- a/src/Determinants/spindeterminants.irp.f +++ b/src/Determinants/spindeterminants.irp.f @@ -1217,7 +1217,6 @@ subroutine wf_of_psi_bilinear_matrix(truncate) integer :: idx integer, external :: get_index_in_psi_det_sorted_bit double precision :: norm(N_states) - PROVIDE psi_bilinear_matrix do k=1,N_det i = psi_bilinear_matrix_rows(k) From 2beeb454a448c2679102fc398183ec351d5c707c Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Sat, 15 Jul 2017 01:02:13 +0200 Subject: [PATCH 10/10] Solved bug for large calculations --- src/Determinants/slater_rules.irp.f | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) diff --git a/src/Determinants/slater_rules.irp.f b/src/Determinants/slater_rules.irp.f index 80dbbad4..e3f5c0b1 100644 --- a/src/Determinants/slater_rules.irp.f +++ b/src/Determinants/slater_rules.irp.f @@ -43,10 +43,12 @@ subroutine get_excitation_degree(key1,key2,degree,Nint) degree = sum(popcnt(xorvec(1:8))) case default - do l=1,ishft(Nint,1) + integer :: lmax + lmax = ishft(Nint,1) + do l=1,lmax xorvec(l) = xor( key1(l), key2(l)) enddo - degree = sum(popcnt(xorvec(1:l))) + degree = sum(popcnt(xorvec(1:lmax))) end select @@ -1503,14 +1505,16 @@ subroutine get_excitation_degree_vector_double_alpha_beta(key1,key2,degree,Nint, !DIR$ LOOP COUNT (1000) do i=1,sze d = 0 + degree_alpha = 0 + degree_beta = 0 !DIR$ LOOP COUNT MIN(4) do m=1,Nint d = d + popcnt(xor( key1(m,1,i), key2(m,1))) & + popcnt(xor( key1(m,2,i), key2(m,2))) key_tmp(m,1) = xor(key1(m,1,i),key2(m,1)) key_tmp(m,2) = xor(key1(m,2,i),key2(m,2)) - degree_alpha = popcnt(key_tmp(m,1)) - degree_beta = popcnt(key_tmp(m,2)) + degree_alpha += popcnt(key_tmp(m,1)) + degree_beta += popcnt(key_tmp(m,2)) enddo if(degree_alpha .gt.3 .or. degree_beta .gt.3 )cycle !! no double excitations of same spin degree(l) = ishft(d,-1) @@ -1661,12 +1665,13 @@ subroutine get_excitation_degree_vector_mono_or_exchange_verbose(key1,key2,degre do i=1,sze d = 0 exchange_1 = 0 + exchange_2 = 0 !DIR$ LOOP COUNT MIN(4) do m=1,Nint d = d + popcnt(xor( key1(m,1,i), key2(m,1))) & + popcnt(xor( key1(m,2,i), key2(m,2))) - exchange_1 = popcnt(xor(iand(key1(m,1,i),key1(m,2,i)),iand(key2(m,1),key2(m,2)))) - exchange_2 = popcnt(iand(xor(key1(m,1,i),key2(m,1)),xor(key1(m,2,i),key2(m,2)))) + exchange_1 += popcnt(xor(iand(key1(m,1,i),key1(m,2,i)),iand(key2(m,1),key2(m,2)))) + exchange_2 += popcnt(iand(xor(key1(m,1,i),key2(m,1)),xor(key1(m,2,i),key2(m,2)))) enddo if (d > 4)cycle if (d ==4)then @@ -2225,7 +2230,7 @@ subroutine get_excitation_degree_spin(key1,key2,degree,Nint) degree = sum(popcnt(xorvec(1:4))) case default - do l=1,N_int + do l=1,Nint xorvec(l) = xor( key1(l), key2(l)) enddo degree = sum(popcnt(xorvec(1:Nint)))