10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-25 22:52:15 +02:00

Removed state-following in MRCC

This commit is contained in:
Anthony Scemama 2016-11-16 20:37:13 +01:00
parent 6c452bb63a
commit 13f2c5d5a9

View File

@ -784,7 +784,7 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
if (s2_eig) then
logical :: state_ok(N_st_diag*davidson_sze_max)
do k=1,shift2
state_ok(k) = (dabs(s2(k)-expected_s2) < 0.6d0)
state_ok(k) = (dabs(s2(k)-expected_s2) < 1.d0)
enddo
do k=1,shift2
if (.not. state_ok(k)) then
@ -803,39 +803,39 @@ subroutine davidson_diag_hjj_sjj_mrcc(dets_in,u_in,H_jj,S2_jj,energies,dim_in,sz
endif
! Compute overlap with U_in
! -------------------------
integer :: coord(2), order(N_st_diag)
overlap = -1.d0
do k=1,shift2
do i=1,shift2
overlap(k,i) = dabs(y(k,i))
enddo
enddo
do k=1,N_st
coord = maxloc(overlap)
order( coord(2) ) = coord(1)
overlap(coord(1),coord(2)) = -1.d0
enddo
overlap = y
do k=1,N_st
l = order(k)
if (k /= l) then
y(1:shift2,k) = overlap(1:shift2,l)
endif
enddo
do k=1,N_st
overlap(k,1) = lambda(k)
overlap(k,2) = s2(k)
enddo
do k=1,N_st
l = order(k)
if (k /= l) then
lambda(k) = overlap(l,1)
s2(k) = overlap(l,2)
endif
enddo
! ! Compute overlap with U_in
! ! -------------------------
!
! integer :: coord(2), order(N_st_diag)
! overlap = -1.d0
! do k=1,shift2
! do i=1,shift2
! overlap(k,i) = dabs(y(k,i))
! enddo
! enddo
! do k=1,N_st
! coord = maxloc(overlap)
! order( coord(2) ) = coord(1)
! overlap(coord(1),coord(2)) = -1.d0
! enddo
! overlap = y
! do k=1,N_st
! l = order(k)
! if (k /= l) then
! y(1:shift2,k) = overlap(1:shift2,l)
! endif
! enddo
! do k=1,N_st
! overlap(k,1) = lambda(k)
! overlap(k,2) = s2(k)
! enddo
! do k=1,N_st
! l = order(k)
! if (k /= l) then
! lambda(k) = overlap(l,1)
! s2(k) = overlap(l,2)
! endif
! enddo
! Express eigenvectors of h in the determinant basis