From 5e93c8bcc4e0a3e56b7a99cd16b02ee31fa3d834 Mon Sep 17 00:00:00 2001
From: Abdallah Ammar <abd.ammar.phys@gmail.com>
Date: Fri, 17 Nov 2023 10:54:53 +0100
Subject: [PATCH] v1 of test col

---
 src/HF/print_GHF.f90 | 37 ++++++++++++++-----------------------
 1 file changed, 14 insertions(+), 23 deletions(-)

diff --git a/src/HF/print_GHF.f90 b/src/HF/print_GHF.f90
index 82b4e79..4c3a090 100644
--- a/src/HF/print_GHF.f90
+++ b/src/HF/print_GHF.f90
@@ -256,6 +256,8 @@ subroutine print_GHF(nBas,nBas2,nO,eHF,C,P,S,ENuc,ET,EV,EJ,EK,EGHF,dipole)
   call vecout(nBas2,eHF)
   write(*,*)
 
+  call print_GHFspin(nBas, nBas2, nO, C, S)
+
 end subroutine 
 
 ! ---
@@ -271,39 +273,27 @@ subroutine print_GHFspin(nBas, nBas2, nO, C, S)
   double precision              :: Na, Nb
   double precision              :: nonco_z, contam_ghf
   double precision              :: S2, Sz, Sz2
-  double precision, allocatable :: Ca(:,:), Cb(:,:), Stmp(:,:)
+  double precision, allocatable :: Ca(:,:), Cb(:,:)
   double precision, allocatable :: Paa(:,:), Pab(:,:), Pba(:,:), Pbb(:,:)
   double precision, allocatable :: Mc(:,:), Eigc(:)
 
-  ! TODO
-  ! Check Cab and Cba
-  allocate(Ca(nBas2,nBas), Cb(nBas2,nBas))
+  print *, ' Spin properties for GHF WF:'
 
-  do i = 1, nBas
-    do j = 1, nBas2
-      Ca(j,i) = C(j,     i)
-      Cb(j,i) = C(j,nBas+i)
-    enddo
-  enddo
-
-  allocate(Stmp(nBas2,nBas2))
-  do i = 1, nBas
+  allocate(Ca(nBas,nO), Cb(nBas,nO))
+  do i = 1, nO
     do j = 1, nBas
-      Stmp(     j,     i) = S(j,i)
-      Stmp(     j,nBas+i) = S(j,i)
-      Stmp(nBas+j,     i) = S(j,i)
-      Stmp(nBas+j,nBas+i) = S(j,i)
+      Ca(j,i) = C(     j,i)
+      Cb(j,i) = C(nBas+j,i)
     enddo
   enddo
 
   ! TODO DGEMM
-  allocate(Paa(nBas,nBas), Pab(nBas,nBas), Pba(nBas,nBas), Pbb(nBas,nBas))
-  Paa = matmul(transpose(Ca), matmul(Stmp, Ca))
-  Pab = matmul(transpose(Ca), matmul(Stmp, Cb))
-  Pba = matmul(transpose(Cb), matmul(Stmp, Ca))
-  Pbb = matmul(transpose(Cb), matmul(Stmp, Cb))
+  allocate(Paa(nO,nO), Pab(nO,nO), Pba(nO,nO), Pbb(nO,nO))
+  Paa = matmul(transpose(Ca), matmul(S, Ca))
+  Pab = matmul(transpose(Ca), matmul(S, Cb))
+  Pba = matmul(transpose(Cb), matmul(S, Ca))
+  Pbb = matmul(transpose(Cb), matmul(S, Cb))
 
-  deallocate(Stmp)
   deallocate(Ca, Cb)
 
   Na = 0.d0
@@ -354,6 +344,7 @@ subroutine print_GHFspin(nBas, nBas2, nO, C, S)
       Mc(1,3) = Mc(1,3) - 0.25d0 * (Pab(i,j) + Pba(i,j))*(Paa(j,i) - Pbb(j,j))
     enddo
   enddo
+  Mc(3,1) = Mc(1,3)
 
   call diagonalize_matrix(3, Mc, Eigc)
   print *, ' eigenvalues of Collinearity matrix:', Eigc