10
0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-17 02:35:26 +02:00

Don't mix same spin symmetry with s2eig

This commit is contained in:
Anthony Scemama 2016-09-13 15:36:36 +02:00
parent df72e480ca
commit 243f46cbca
2 changed files with 8 additions and 6 deletions

View File

@ -457,7 +457,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun
! ----------------------
do k=1,N_st
call H_u_0(W(1,k,iter),U(1,k,iter),H_jj,sze,dets_in,Nint)
call H_u_0(W(1,k,iter),U(1,k,iter),H_jj,sze,dets_in,Nint)
enddo
@ -530,7 +530,7 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun
!$OMP END PARALLEL
write(iunit,'(X,I3,X,100(X,F16.10,X,E16.6))') iter, to_print(:,1:N_st)
call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_states,converged)
call davidson_converged(lambda,residual_norm,wall,iter,cpu,N_states_diag,converged)
if (converged) then
exit
endif
@ -554,14 +554,14 @@ subroutine davidson_diag_hjj(dets_in,u_in,H_jj,energies,dim_in,sze,N_st,Nint,iun
do l=1,N_st
c = u_dot_v(U(1,k,iter+1),U(1,l,iter2),sze)
do i=1,sze
U(i,k,iter+1) -= c * U(i,l,iter2)
U(i,k,iter+1) = U(i,k,iter+1) - c * U(i,l,iter2)
enddo
enddo
enddo
do l=1,k-1
c = u_dot_v(U(1,k,iter+1),U(1,l,iter+1),sze)
do i=1,sze
U(i,k,iter+1) -= c * U(i,l,iter+1)
U(i,k,iter+1) = U(i,k,iter+1) - c * U(i,l,iter+1)
enddo
enddo
call normalize( U(1,k,iter+1), sze )

View File

@ -348,7 +348,8 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma
accu_precision_of_diag = 0.d0
do i = 1, nstates
do j = i+1, nstates
if( ( dabs(s2(i,i) - s2(j,j)) .le.1.d-10 ) .and. (dabs(s2(i,j) + dabs(s2(i,j)))) .le.1.d-10) then
! Do not combine states of the same spin symmetry
if( dabs(s2(i,i) - s2(j,j)) .le.0.5d0) then
s2(i,j) = 0.d0
s2(j,i) = 0.d0
endif
@ -356,13 +357,14 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma
enddo
do i = 1, nstates
write(*,'(10(F10.6,X))')s2(i,:)
s2(i,i) = s2(i,i)
enddo
print*,'Diagonalizing the S^2 matrix'
allocate(eigvalues(nstates),eigvectors(nstates,nstates))
call lapack_diagd(eigvalues,eigvectors,s2,nstates,nstates)
print*,'Eigenvalues of s^2'
print*,'Shifted Eigenvalues of s^2'
do i = 1, nstates
print*,'s2 = ',eigvalues(i)
s2_eigvalues(i) = eigvalues(i)