mirror of
https://github.com/LCPQ/quantum_package
synced 2024-08-25 05:51:46 +02:00
Print S2 in MRCC
This commit is contained in:
parent
243f46cbca
commit
76f4087227
@ -298,6 +298,8 @@ BEGIN_PROVIDER [ double precision, CI_energy_dressed, (N_states_diag) ]
|
||||
call write_time(output_determinants)
|
||||
do j=1,N_states_diag
|
||||
CI_energy_dressed(j) = CI_electronic_energy_dressed(j) + nuclear_repulsion
|
||||
call write_double(output_determinants,CI_energy(j),'Energy of state '//trim(st))
|
||||
call write_double(output_determinants,CI_eigenvectors_s2(j),'S^2 of state '//trim(st))
|
||||
enddo
|
||||
|
||||
END_PROVIDER
|
||||
|
@ -314,12 +314,7 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
print*,'Overlap matrix in the basis of the states considered'
|
||||
do i = 1, nstates
|
||||
write(*,'(10(F16.10,X))')overlap(i,:)
|
||||
enddo
|
||||
call ortho_lowdin(overlap,size(overlap,1),nstates,psi_coefs_inout,size(psi_coefs_inout,1),n)
|
||||
print*,'passed ortho'
|
||||
|
||||
!$OMP PARALLEL DO COLLAPSE(2) DEFAULT(NONE) SCHEDULE(dynamic) &
|
||||
!$OMP PRIVATE(i,j) SHARED(overlap,psi_coefs_inout,nstates,n)
|
||||
@ -336,41 +331,49 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma
|
||||
enddo
|
||||
enddo
|
||||
!$OMP END PARALLEL DO
|
||||
print*,'Overlap matrix in the basis of the Lowdin orthonormalized states '
|
||||
do i = 1, nstates
|
||||
write(*,'(10(F16.10,X))')overlap(i,:)
|
||||
enddo
|
||||
|
||||
call get_uJ_s2_uI(keys_tmp,psi_coefs_inout,n_det,size(psi_coefs_inout,1),size(keys_tmp,3),s2,nstates)
|
||||
print*,'S^2 matrix in the basis of the states considered'
|
||||
double precision :: accu_precision_diag,accu_precision_of_diag
|
||||
accu_precision_diag = 0.d0
|
||||
accu_precision_of_diag = 0.d0
|
||||
do i = 1, nstates
|
||||
do j = i+1, nstates
|
||||
! 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
|
||||
enddo
|
||||
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'
|
||||
double precision :: accu_precision_diag,accu_precision_of_diag
|
||||
accu_precision_diag = 0.d0
|
||||
accu_precision_of_diag = 0.d0
|
||||
do i = 1, nstates
|
||||
! Do not combine states of the same spin symmetry
|
||||
do j = i+1, nstates
|
||||
if( dabs(s2(i,i) - s2(j,j)) .le.0.5d0) then
|
||||
s2(i,j) = 0.d0
|
||||
s2(j,i) = 0.d0
|
||||
endif
|
||||
enddo
|
||||
! Do not rotate if the diagonal is correct
|
||||
if( dabs(s2(i,i) - expected_s2).le.5.d-3) then
|
||||
do j = 1, nstates
|
||||
if (j==i) cycle
|
||||
s2(i,j) = 0.d0
|
||||
s2(j,i) = 0.d0
|
||||
enddo
|
||||
endif
|
||||
enddo
|
||||
|
||||
print*,'Modified S^2 matrix that will be diagonalized'
|
||||
do i = 1, nstates
|
||||
write(*,'(10(F10.6,X))')s2(i,:)
|
||||
s2(i,i) = s2(i,i)
|
||||
enddo
|
||||
|
||||
allocate(eigvalues(nstates),eigvectors(nstates,nstates))
|
||||
call lapack_diagd(eigvalues,eigvectors,s2,nstates,nstates)
|
||||
print*,'Shifted Eigenvalues of s^2'
|
||||
print*,'Eigenvalues'
|
||||
do i = 1, nstates
|
||||
print*,'s2 = ',eigvalues(i)
|
||||
s2_eigvalues(i) = eigvalues(i)
|
||||
enddo
|
||||
|
||||
print*,'Building the eigenvectors of the S^2 matrix'
|
||||
allocate(psi_coefs_tmp(nmax_coefs,nstates))
|
||||
psi_coefs_tmp = 0.d0
|
||||
do j = 1, nstates
|
||||
@ -386,7 +389,6 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma
|
||||
do i = 1, n_det
|
||||
accu += psi_coefs_tmp(i,j) * psi_coefs_tmp(i,j)
|
||||
enddo
|
||||
print*,'Norm of vector = ',accu
|
||||
accu = 1.d0/dsqrt(accu)
|
||||
do i = 1, n_det
|
||||
psi_coefs_inout(i,j) = psi_coefs_tmp(i,j) * accu
|
||||
|
Loading…
Reference in New Issue
Block a user