From 3adf8cdcb72261b1f5515598f26ffe2cfad3f519 Mon Sep 17 00:00:00 2001 From: Anthony Scemama Date: Wed, 30 Nov 2016 21:12:21 +0100 Subject: [PATCH] Accelerated MRSC2 --- plugins/mrcc_selected/dressing_slave.irp.f | 36 +++++----------------- src/Determinants/determinants.irp.f | 24 +++++++-------- 2 files changed, 19 insertions(+), 41 deletions(-) diff --git a/plugins/mrcc_selected/dressing_slave.irp.f b/plugins/mrcc_selected/dressing_slave.irp.f index 9e9fa65a..c2e5dd55 100644 --- a/plugins/mrcc_selected/dressing_slave.irp.f +++ b/plugins/mrcc_selected/dressing_slave.irp.f @@ -74,8 +74,6 @@ subroutine mrsc2_dressing_slave(thread,iproc) ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state) cj_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state) end do - !delta = 0.d0 - !delta_s2 = 0.d0 n = 0 delta(:,0,:) = 0d0 delta(:,:nlink(J),1) = 0d0 @@ -129,25 +127,10 @@ subroutine mrsc2_dressing_slave(thread,iproc) if(h_cache(J,i) == 0.d0) cycle if(h_cache(i_I,i) == 0.d0) cycle - !ok = .false. - !do i_state=1, N_states - ! if(lambda_mrcc(i_state, i) /= 0d0) then - ! ok = .true. - ! exit - ! end if - !end do - !if(.not. ok) cycle -! - komon(0) += 1 kn = komon(0) komon(kn) = i - -! call get_excitation(psi_ref(1,1,J),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ji,N_int) -! if(I_i /= J) call get_excitation(psi_ref(1,1,I_i),psi_non_ref(1,1,i),exc_IJ,degree2,phase_Ii,N_int) -! if(I_i == J) phase_Ii = phase_Ji - do i_state = 1,N_states dkI = h_cache(J,i) * dij(i_I, i, i_state) dleat(i_state, kn, 1) = dkI @@ -163,25 +146,21 @@ subroutine mrsc2_dressing_slave(thread,iproc) komoned = .true. end if - + integer :: hpmin(2) + hpmin(1) = 2 - HP(1,k) + hpmin(2) = 2 - HP(2,k) + do m = 1, komon(0) i = komon(m) - - call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) - if(.not. ok) cycle - if(HP(1,i) + HP(1,k) <= 2 .and. HP(2,i) + HP(2,k) <= 2) then -! if(is_in_wavefunction(det_tmp, N_int)) cycle + if(HP(1,i) <= hpmin(1) .and. HP(2,i) <= hpmin(2) ) then cycle end if - !if(isInCassd(det_tmp, N_int)) cycle + call apply_excitation(psi_non_ref(1,1,i),exc_Ik,det_tmp,ok,N_int) + if(.not. ok) cycle do i_state = 1, N_states - !if(lambda_mrcc(i_state, i) == 0d0) cycle - - - !contrib = h_cache(i_I,k) * lambda_mrcc(i_state, k) * dleat(i_state, m, 2)! * phase_al contrib = dij(i_I, k, i_state) * dleat(i_state, m, 2) contrib_s2 = dij(i_I, k, i_state) * dleat_s2(i_state, m, 2) delta(i_state,ll,1) += contrib @@ -192,7 +171,6 @@ subroutine mrsc2_dressing_slave(thread,iproc) endif if(I_i == J) cycle - !contrib = h_cache(J,l) * lambda_mrcc(i_state, l) * dleat(i_state, m, 1)! * phase_al contrib = dij(J, l, i_state) * dleat(i_state, m, 1) contrib_s2 = dij(J, l, i_state) * dleat_s2(i_state, m, 1) delta(i_state,kk,2) += contrib diff --git a/src/Determinants/determinants.irp.f b/src/Determinants/determinants.irp.f index 98d7d5c9..bed3327d 100644 --- a/src/Determinants/determinants.irp.f +++ b/src/Determinants/determinants.irp.f @@ -861,14 +861,14 @@ subroutine apply_particles(det, s1, p1, s2, p2, res, ok, Nint) res = det if(p1 /= 0) then - ii = (p1-1)/bit_kind_size + 1 - pos = mod(p1-1, bit_kind_size)!iand(p1-1,bit_kind_size-1) + ii = ishft(p1-1,-bit_kind_shift) + 1 + pos = p1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return res(ii, s1) = ibset(res(ii, s1), pos) end if - ii = (p2-1)/bit_kind_size + 1 - pos = mod(p2-1, bit_kind_size)!iand(p2-1,bit_kind_size-1) + ii = ishft(p2-1,-bit_kind_shift) + 1 + pos = p2-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return res(ii, s2) = ibset(res(ii, s2), pos) @@ -890,14 +890,14 @@ subroutine apply_holes(det, s1, h1, s2, h2, res, ok, Nint) res = det if(h1 /= 0) then - ii = (h1-1)/bit_kind_size + 1 - pos = mod(h1-1, bit_kind_size)!iand(h1-1,bit_kind_size-1) + ii = ishft(h1-1,-bit_kind_shift) + 1 + pos = h1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return res(ii, s1) = ibclr(res(ii, s1), pos) end if - ii = (h2-1)/bit_kind_size + 1 - pos = mod(h2-1, bit_kind_size)!iand(h2-1,bit_kind_size-1) + ii = ishft(h2-1,-bit_kind_shift) + 1 + pos = h2-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return res(ii, s2) = ibclr(res(ii, s2), pos) @@ -917,8 +917,8 @@ subroutine apply_particle(det, s1, p1, res, ok, Nint) ok = .false. res = det - ii = (p1-1)/bit_kind_size + 1 - pos = mod(p1-1, bit_kind_size)!iand(p1-1,bit_kind_size-1) + ii = ishft(p1-1,-bit_kind_shift) + 1 + pos = p1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return res(ii, s1) = ibset(res(ii, s1), pos) @@ -939,8 +939,8 @@ subroutine apply_hole(det, s1, h1, res, ok, Nint) ok = .false. res = det - ii = (h1-1)/bit_kind_size + 1 - pos = mod(h1-1, bit_kind_size)!iand(h1-1,bit_kind_size-1) + ii = ishft(h1-1,-bit_kind_shift) + 1 + pos = h1-1-ishft(ii-1,bit_kind_shift) if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return res(ii, s1) = ibclr(res(ii, s1), pos)