LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-06-21 12:42:13 +02:00
Code Issues Releases Wiki Activity

Print S2 in MRCC

Browse Source
This commit is contained in:
Anthony Scemama 2016-09-15 14:31:34 +02:00
parent 243f46cbca
commit 76f4087227
2 changed files with 29 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
plugins/MRCC_Utils/mrcc_utils.irp.f
View File

@ -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

52
src/Determinants/s2.irp.f
View File

@ -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