mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01:00
Accelerated MRSC2
This commit is contained in:
parent
eb8f1757ab
commit
3adf8cdcb7
@ -74,8 +74,6 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
ci_inv(i_state) = 1.d0 / psi_ref_coef(i_I,i_state)
|
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)
|
cj_inv(i_state) = 1.d0 / psi_ref_coef(J,i_state)
|
||||||
end do
|
end do
|
||||||
!delta = 0.d0
|
|
||||||
!delta_s2 = 0.d0
|
|
||||||
n = 0
|
n = 0
|
||||||
delta(:,0,:) = 0d0
|
delta(:,0,:) = 0d0
|
||||||
delta(:,:nlink(J),1) = 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(J,i) == 0.d0) cycle
|
||||||
if(h_cache(i_I,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
|
komon(0) += 1
|
||||||
kn = komon(0)
|
kn = komon(0)
|
||||||
komon(kn) = i
|
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
|
do i_state = 1,N_states
|
||||||
dkI = h_cache(J,i) * dij(i_I, i, i_state)
|
dkI = h_cache(J,i) * dij(i_I, i, i_state)
|
||||||
dleat(i_state, kn, 1) = dkI
|
dleat(i_state, kn, 1) = dkI
|
||||||
@ -163,25 +146,21 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
komoned = .true.
|
komoned = .true.
|
||||||
end if
|
end if
|
||||||
|
|
||||||
|
integer :: hpmin(2)
|
||||||
|
hpmin(1) = 2 - HP(1,k)
|
||||||
|
hpmin(2) = 2 - HP(2,k)
|
||||||
|
|
||||||
do m = 1, komon(0)
|
do m = 1, komon(0)
|
||||||
|
|
||||||
i = komon(m)
|
i = komon(m)
|
||||||
|
if(HP(1,i) <= hpmin(1) .and. HP(2,i) <= hpmin(2) ) then
|
||||||
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
|
|
||||||
cycle
|
cycle
|
||||||
end if
|
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
|
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 = 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)
|
contrib_s2 = dij(i_I, k, i_state) * dleat_s2(i_state, m, 2)
|
||||||
delta(i_state,ll,1) += contrib
|
delta(i_state,ll,1) += contrib
|
||||||
@ -192,7 +171,6 @@ subroutine mrsc2_dressing_slave(thread,iproc)
|
|||||||
endif
|
endif
|
||||||
|
|
||||||
if(I_i == J) cycle
|
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 = dij(J, l, i_state) * dleat(i_state, m, 1)
|
||||||
contrib_s2 = dij(J, l, i_state) * dleat_s2(i_state, m, 1)
|
contrib_s2 = dij(J, l, i_state) * dleat_s2(i_state, m, 1)
|
||||||
delta(i_state,kk,2) += contrib
|
delta(i_state,kk,2) += contrib
|
||||||
|
@ -861,14 +861,14 @@ subroutine apply_particles(det, s1, p1, s2, p2, res, ok, Nint)
|
|||||||
res = det
|
res = det
|
||||||
|
|
||||||
if(p1 /= 0) then
|
if(p1 /= 0) then
|
||||||
ii = (p1-1)/bit_kind_size + 1
|
ii = ishft(p1-1,-bit_kind_shift) + 1
|
||||||
pos = mod(p1-1, bit_kind_size)!iand(p1-1,bit_kind_size-1)
|
pos = p1-1-ishft(ii-1,bit_kind_shift)
|
||||||
if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return
|
if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return
|
||||||
res(ii, s1) = ibset(res(ii, s1), pos)
|
res(ii, s1) = ibset(res(ii, s1), pos)
|
||||||
end if
|
end if
|
||||||
|
|
||||||
ii = (p2-1)/bit_kind_size + 1
|
ii = ishft(p2-1,-bit_kind_shift) + 1
|
||||||
pos = mod(p2-1, bit_kind_size)!iand(p2-1,bit_kind_size-1)
|
pos = p2-1-ishft(ii-1,bit_kind_shift)
|
||||||
if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return
|
if(iand(det(ii, s2), ishft(1_bit_kind, pos)) /= 0_8) return
|
||||||
res(ii, s2) = ibset(res(ii, s2), pos)
|
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
|
res = det
|
||||||
|
|
||||||
if(h1 /= 0) then
|
if(h1 /= 0) then
|
||||||
ii = (h1-1)/bit_kind_size + 1
|
ii = ishft(h1-1,-bit_kind_shift) + 1
|
||||||
pos = mod(h1-1, bit_kind_size)!iand(h1-1,bit_kind_size-1)
|
pos = h1-1-ishft(ii-1,bit_kind_shift)
|
||||||
if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return
|
if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return
|
||||||
res(ii, s1) = ibclr(res(ii, s1), pos)
|
res(ii, s1) = ibclr(res(ii, s1), pos)
|
||||||
end if
|
end if
|
||||||
|
|
||||||
ii = (h2-1)/bit_kind_size + 1
|
ii = ishft(h2-1,-bit_kind_shift) + 1
|
||||||
pos = mod(h2-1, bit_kind_size)!iand(h2-1,bit_kind_size-1)
|
pos = h2-1-ishft(ii-1,bit_kind_shift)
|
||||||
if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return
|
if(iand(det(ii, s2), ishft(1_bit_kind, pos)) == 0_8) return
|
||||||
res(ii, s2) = ibclr(res(ii, s2), pos)
|
res(ii, s2) = ibclr(res(ii, s2), pos)
|
||||||
|
|
||||||
@ -917,8 +917,8 @@ subroutine apply_particle(det, s1, p1, res, ok, Nint)
|
|||||||
ok = .false.
|
ok = .false.
|
||||||
res = det
|
res = det
|
||||||
|
|
||||||
ii = (p1-1)/bit_kind_size + 1
|
ii = ishft(p1-1,-bit_kind_shift) + 1
|
||||||
pos = mod(p1-1, bit_kind_size)!iand(p1-1,bit_kind_size-1)
|
pos = p1-1-ishft(ii-1,bit_kind_shift)
|
||||||
if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return
|
if(iand(det(ii, s1), ishft(1_bit_kind, pos)) /= 0_8) return
|
||||||
res(ii, s1) = ibset(res(ii, s1), pos)
|
res(ii, s1) = ibset(res(ii, s1), pos)
|
||||||
|
|
||||||
@ -939,8 +939,8 @@ subroutine apply_hole(det, s1, h1, res, ok, Nint)
|
|||||||
ok = .false.
|
ok = .false.
|
||||||
res = det
|
res = det
|
||||||
|
|
||||||
ii = (h1-1)/bit_kind_size + 1
|
ii = ishft(h1-1,-bit_kind_shift) + 1
|
||||||
pos = mod(h1-1, bit_kind_size)!iand(h1-1,bit_kind_size-1)
|
pos = h1-1-ishft(ii-1,bit_kind_shift)
|
||||||
if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return
|
if(iand(det(ii, s1), ishft(1_bit_kind, pos)) == 0_8) return
|
||||||
res(ii, s1) = ibclr(res(ii, s1), pos)
|
res(ii, s1) = ibclr(res(ii, s1), pos)
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user