mirror of
https://github.com/pfloos/quack
synced 2024-08-24 21:21:46 +02:00
working on collinearity test
This commit is contained in:
parent
74079b2920
commit
5ebe76056d
@ -37,6 +37,15 @@ subroutine print_GHF(nBas,nBas2,nO,e,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
|
|||||||
double precision,allocatable :: Pba(:,:)
|
double precision,allocatable :: Pba(:,:)
|
||||||
double precision,allocatable :: Pbb(:,:)
|
double precision,allocatable :: Pbb(:,:)
|
||||||
|
|
||||||
|
double precision,allocatable :: Mx(:,:)
|
||||||
|
double precision,allocatable :: My(:,:)
|
||||||
|
double precision,allocatable :: Mz(:,:)
|
||||||
|
double precision,allocatable :: PP(:,:)
|
||||||
|
double precision :: T(3,3)
|
||||||
|
double precision :: vec(3,3)
|
||||||
|
double precision :: val(3)
|
||||||
|
double precision :: lambda
|
||||||
|
|
||||||
double precision,external :: trace_matrix
|
double precision,external :: trace_matrix
|
||||||
|
|
||||||
logical :: dump_orb = .false.
|
logical :: dump_orb = .false.
|
||||||
@ -49,43 +58,82 @@ subroutine print_GHF(nBas,nBas2,nO,e,C,P,ENuc,ET,EV,EJ,EK,EHF,dipole)
|
|||||||
|
|
||||||
! Density matrices
|
! Density matrices
|
||||||
|
|
||||||
allocate(Paa(nBas2,nBas2),Pab(nBas2,nBas2),Pba(nBas2,nBas2),Pbb(nBas2,nBas2))
|
allocate(Paa(nBas,nBas),Pab(nBas,nBas),Pba(nBas,nBas),Pbb(nBas,nBas))
|
||||||
|
|
||||||
Paa(:,:) = P( 1:nBas , 1:nBas )
|
Paa(:,:) = P( 1:nBas , 1:nBas )
|
||||||
Pab(:,:) = P( 1:nBas ,nBas+1:nBas2)
|
Pab(:,:) = P( 1:nBas ,nBas+1:nBas2)
|
||||||
Pba(:,:) = P(nBas+1:nBas2, 1:nBas )
|
Pba(:,:) = P(nBas+1:nBas2, 1:nBas )
|
||||||
Pbb(:,:) = P(nBas+1:nBas2,nBas+1:nBas2)
|
Pbb(:,:) = P(nBas+1:nBas2,nBas+1:nBas2)
|
||||||
|
|
||||||
allocate(Ca(nBas,nBas2),Cb(nBas,nBas2))
|
! allocate(Ca(nBas,nBas2),Cb(nBas,nBas2))
|
||||||
|
|
||||||
Ca(:,:) = C( 1:nBas ,1:nBas2)
|
! Ca(:,:) = C( 1:nBas ,1:nBas2)
|
||||||
Cb(:,:) = C(nBas+1:nBas2,1:nBas2)
|
! Cb(:,:) = C(nBas+1:nBas2,1:nBas2)
|
||||||
|
|
||||||
! Compute expectation values of S^2 (WRONG!)
|
! Compute expectation values of S^2 (WRONG!)
|
||||||
|
|
||||||
Sx2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) + 0.25d0*trace_matrix(nBas,Pab+Pba)**2
|
! Sx2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) + 0.25d0*trace_matrix(nBas,Pab+Pba)**2
|
||||||
do mu=1,nBas
|
! do mu=1,nBas
|
||||||
do nu=1,nBas
|
! do nu=1,nBas
|
||||||
Sx2 = Sx2 - 0.5d0*(Paa(mu,nu)*Pbb(nu,mu) + Pab(mu,nu)*Pab(nu,mu))
|
! Sx2 = Sx2 - 0.5d0*(Paa(mu,nu)*Pbb(nu,mu) + Pab(mu,nu)*Pab(nu,mu))
|
||||||
end do
|
! end do
|
||||||
end do
|
! end do
|
||||||
|
|
||||||
Sy2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) - 0.25d0*trace_matrix(nBas,Pab+Pba)**2
|
! Sy2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) - 0.25d0*trace_matrix(nBas,Pab+Pba)**2
|
||||||
do mu=1,nBas
|
! do mu=1,nBas
|
||||||
do nu=1,nBas
|
! do nu=1,nBas
|
||||||
Sy2 = Sy2 - 0.5d0*(Paa(mu,nu)*Pbb(nu,mu) - Pab(mu,nu)*Pab(nu,mu))
|
! Sy2 = Sy2 - 0.5d0*(Paa(mu,nu)*Pbb(nu,mu) - Pab(mu,nu)*Pab(nu,mu))
|
||||||
end do
|
! end do
|
||||||
end do
|
! end do
|
||||||
|
|
||||||
Sz2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) + 0.25d0*trace_matrix(nBas,Pab-Pba)**2
|
! Sz2 = 0.25d0*trace_matrix(nBas,Paa+Pbb) + 0.25d0*trace_matrix(nBas,Pab-Pba)**2
|
||||||
do mu=1,nBas
|
! do mu=1,nBas
|
||||||
do nu=1,nBas
|
! do nu=1,nBas
|
||||||
Sz2 = Sz2 - 0.25d0*(Paa(mu,nu)*Pbb(nu,mu) - Pab(mu,nu)*Pab(nu,mu))
|
! Sz2 = Sz2 - 0.25d0*(Paa(mu,nu)*Pbb(nu,mu) - Pab(mu,nu)*Pab(nu,mu))
|
||||||
Sz2 = Sz2 + 0.25d0*(Pab(mu,nu)*Pba(nu,mu) - Pba(mu,nu)*Pab(nu,mu))
|
! Sz2 = Sz2 + 0.25d0*(Pab(mu,nu)*Pba(nu,mu) - Pba(mu,nu)*Pab(nu,mu))
|
||||||
end do
|
! end do
|
||||||
end do
|
! end do
|
||||||
|
!
|
||||||
|
! S2 = Sx2 + Sy2 + Sz2
|
||||||
|
|
||||||
S2 = Sx2 + Sy2 + Sz2
|
! Checl collinearity and coplanarity
|
||||||
|
|
||||||
|
allocate(PP(nBas,nBas),Mx(nBas,nBas),My(nBas,nBas),Mz(nBas,nBas))
|
||||||
|
|
||||||
|
PP(:,:) = 0.5d0*(Paa(:,:) + Pbb(:,:))
|
||||||
|
Mx(:,:) = 0.5d0*(Pba(:,:) + Pab(:,:))
|
||||||
|
My(:,:) = 0.5d0*(Pba(:,:) - Pab(:,:))
|
||||||
|
Mz(:,:) = 0.5d0*(Paa(:,:) - Pbb(:,:))
|
||||||
|
|
||||||
|
T(1,1) = trace_matrix(nBas,matmul(Mx,transpose(Mx)))
|
||||||
|
T(1,2) = trace_matrix(nBas,matmul(Mx,transpose(My)))
|
||||||
|
T(1,3) = trace_matrix(nBas,matmul(Mx,transpose(Mz)))
|
||||||
|
T(2,1) = trace_matrix(nBas,matmul(My,transpose(Mx)))
|
||||||
|
T(2,2) = trace_matrix(nBas,matmul(My,transpose(My)))
|
||||||
|
T(2,3) = trace_matrix(nBas,matmul(My,transpose(Mz)))
|
||||||
|
T(3,1) = trace_matrix(nBas,matmul(Mz,transpose(Mx)))
|
||||||
|
T(3,2) = trace_matrix(nBas,matmul(Mz,transpose(My)))
|
||||||
|
T(3,3) = trace_matrix(nBas,matmul(Mz,transpose(Mz)))
|
||||||
|
|
||||||
|
print*,'Value of Tr(P - P^2)'
|
||||||
|
lambda = trace_matrix(nBas,PP - matmul(PP,transpose(PP)))
|
||||||
|
print*,lambda
|
||||||
|
|
||||||
|
print*,'Eigenvalues of T'
|
||||||
|
vec(:,:) = T(:,:)
|
||||||
|
call diagonalize_matrix(3,vec,val)
|
||||||
|
print*,val
|
||||||
|
|
||||||
|
T(1,1) = - T(1,1) + lambda
|
||||||
|
T(2,2) = - T(2,2) + lambda
|
||||||
|
T(3,3) = - T(3,3) + lambda
|
||||||
|
|
||||||
|
print*,'Eigenvalues of A'
|
||||||
|
vec(:,:) = T(:,:)
|
||||||
|
call diagonalize_matrix(3,vec,val)
|
||||||
|
print*,val
|
||||||
|
|
||||||
|
deallocate(PP,Mx,My,Mz)
|
||||||
|
|
||||||
! Dump results
|
! Dump results
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user