From 67da0834f5de519f51184755cd0430d3bd6e913e Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Fri, 14 Jul 2017 03:12:46 +0200 Subject: [PATCH] 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