mirror of
https://github.com/LCPQ/quantum_package
synced 2024-12-23 04:43:50 +01: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)
|
call write_time(output_determinants)
|
||||||
do j=1,N_states_diag
|
do j=1,N_states_diag
|
||||||
CI_energy_dressed(j) = CI_electronic_energy_dressed(j) + nuclear_repulsion
|
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
|
enddo
|
||||||
|
|
||||||
END_PROVIDER
|
END_PROVIDER
|
||||||
|
@ -314,12 +314,7 @@ subroutine diagonalize_s2_betweenstates(keys_tmp,psi_coefs_inout,n,nmax_keys,nma
|
|||||||
enddo
|
enddo
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$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)
|
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 PARALLEL DO COLLAPSE(2) DEFAULT(NONE) SCHEDULE(dynamic) &
|
||||||
!$OMP PRIVATE(i,j) SHARED(overlap,psi_coefs_inout,nstates,n)
|
!$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
|
||||||
enddo
|
enddo
|
||||||
!$OMP END PARALLEL DO
|
!$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)
|
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'
|
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
|
do i = 1, nstates
|
||||||
write(*,'(10(F10.6,X))')s2(i,:)
|
write(*,'(10(F10.6,X))')s2(i,:)
|
||||||
s2(i,i) = s2(i,i)
|
s2(i,i) = s2(i,i)
|
||||||
enddo
|
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))
|
allocate(eigvalues(nstates),eigvectors(nstates,nstates))
|
||||||
call lapack_diagd(eigvalues,eigvectors,s2,nstates,nstates)
|
call lapack_diagd(eigvalues,eigvectors,s2,nstates,nstates)
|
||||||
print*,'Shifted Eigenvalues of s^2'
|
print*,'Eigenvalues'
|
||||||
do i = 1, nstates
|
do i = 1, nstates
|
||||||
print*,'s2 = ',eigvalues(i)
|
print*,'s2 = ',eigvalues(i)
|
||||||
s2_eigvalues(i) = eigvalues(i)
|
s2_eigvalues(i) = eigvalues(i)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
print*,'Building the eigenvectors of the S^2 matrix'
|
|
||||||
allocate(psi_coefs_tmp(nmax_coefs,nstates))
|
allocate(psi_coefs_tmp(nmax_coefs,nstates))
|
||||||
psi_coefs_tmp = 0.d0
|
psi_coefs_tmp = 0.d0
|
||||||
do j = 1, nstates
|
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
|
do i = 1, n_det
|
||||||
accu += psi_coefs_tmp(i,j) * psi_coefs_tmp(i,j)
|
accu += psi_coefs_tmp(i,j) * psi_coefs_tmp(i,j)
|
||||||
enddo
|
enddo
|
||||||
print*,'Norm of vector = ',accu
|
|
||||||
accu = 1.d0/dsqrt(accu)
|
accu = 1.d0/dsqrt(accu)
|
||||||
do i = 1, n_det
|
do i = 1, n_det
|
||||||
psi_coefs_inout(i,j) = psi_coefs_tmp(i,j) * accu
|
psi_coefs_inout(i,j) = psi_coefs_tmp(i,j) * accu
|
||||||
|
Loading…
Reference in New Issue
Block a user