From be8818538a305cb2d2502b1bdb12dab8a30cecef Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Sat, 28 Mar 2015 00:15:09 +0100
Subject: [PATCH] Completed SVD ezfio for QMC=Chem

---
 src/Dets/save_for_qmcchem.irp.f        |  2 +
 src/Dets/spindeterminants.ezfio_config |  4 ++
 src/Dets/spindeterminants.irp.f        | 51 +++++++++++++++++++++++++-
 3 files changed, 55 insertions(+), 2 deletions(-)

diff --git a/src/Dets/save_for_qmcchem.irp.f b/src/Dets/save_for_qmcchem.irp.f
index 363e0ba2..7dea70c6 100644
--- a/src/Dets/save_for_qmcchem.irp.f
+++ b/src/Dets/save_for_qmcchem.irp.f
@@ -42,8 +42,10 @@ subroutine save_dets_qmcchem
  enddo
  close(31)
  call system('gzip -f '//trim(ezfio_filename)//'/mo_basis/mo_classif')
+
 end
 
 program save_for_qmc
   call save_dets_qmcchem
+ call write_spindeterminants
 end
diff --git a/src/Dets/spindeterminants.ezfio_config b/src/Dets/spindeterminants.ezfio_config
index e6a0ed9a..1c7d81e3 100644
--- a/src/Dets/spindeterminants.ezfio_config
+++ b/src/Dets/spindeterminants.ezfio_config
@@ -7,4 +7,8 @@ spindeterminants
   psi_det_alpha   integer*8 (spindeterminants_n_int*spindeterminants_bit_kind/8,spindeterminants_n_det_alpha)
   psi_det_beta    integer*8 (spindeterminants_n_int*spindeterminants_bit_kind/8,spindeterminants_n_det_beta)
   psi_coef_matrix double precision (spindeterminants_n_det_alpha,spindeterminants_n_det_beta,spindeterminants_n_states)
+  n_svd_coefs     integer
+  psi_svd_alpha   double precision (spindeterminants_n_det_alpha,spindeterminants_n_svd_coefs,spindeterminants_n_states)
+  psi_svd_beta    double precision (spindeterminants_n_det_beta,spindeterminants_n_svd_coefs,spindeterminants_n_states)
+  psi_svd_coefs   double precision (spindeterminants_n_svd_coefs,spindeterminants_n_states)
 
diff --git a/src/Dets/spindeterminants.irp.f b/src/Dets/spindeterminants.irp.f
index 236dc1fc..4b426faa 100644
--- a/src/Dets/spindeterminants.irp.f
+++ b/src/Dets/spindeterminants.irp.f
@@ -26,7 +26,7 @@ subroutine write_spindeterminants
   enddo
   call ezfio_set_spindeterminants_psi_det_alpha(psi_det_alpha_unique)
   deallocate(tmpdet)
-
+  
   allocate(tmpdet(N_int2,N_det_beta_unique))
   do i=1,N_det_beta_unique
     do k=1,N_int
@@ -38,7 +38,54 @@ subroutine write_spindeterminants
   enddo
   call ezfio_set_spindeterminants_psi_det_beta(psi_det_beta_unique)
   deallocate(tmpdet)
-
+  
   call ezfio_set_spindeterminants_psi_coef_matrix(psi_svd_matrix)
+  
+  integer                        :: n_svd_coefs
+  double precision               :: norm, f
+  f = 1.d0/dble(N_states)
+  norm = 1.d0
+  do n_svd_coefs=1,N_det_alpha_unique
+    do k=1,N_states
+      norm -= psi_svd_coefs(n_svd_coefs,k)*psi_svd_coefs(n_svd_coefs,k)
+    enddo
+    if (norm < 1.d-6) then
+      exit
+    endif
+  enddo
+  n_svd_coefs -= 1
+  call ezfio_set_spindeterminants_n_svd_coefs(n_svd_coefs)
+  
+  double precision, allocatable  :: dtmp(:,:,:)
+  allocate(dtmp(N_det_alpha_unique,n_svd_coefs,N_states))
+  do k=1,N_states
+    do j=1,n_svd_coefs
+      do i=1,N_det_alpha_unique
+        dtmp(i,j,k) = psi_svd_alpha(i,j,k)
+      enddo
+    enddo
+  enddo
+  call ezfio_set_spindeterminants_psi_svd_alpha(dtmp)
+  deallocate(dtmp)
+
+  allocate(dtmp(N_det_beta_unique,n_svd_coefs,N_states))
+  do k=1,N_states
+    do j=1,n_svd_coefs
+      do i=1,N_det_beta_unique
+        dtmp(i,j,k) = psi_svd_beta(i,j,k)
+      enddo
+    enddo
+  enddo
+  call ezfio_set_spindeterminants_psi_svd_beta(dtmp)
+  deallocate(dtmp)
+
+  allocate(dtmp(n_svd_coefs,N_states,1))
+  do k=1,N_states
+    do j=1,n_svd_coefs
+        dtmp(j,k,1) = psi_svd_coefs(j,k)
+    enddo
+  enddo
+  call ezfio_set_spindeterminants_psi_svd_coefs(dtmp)
+  deallocate(dtmp)
 
 end