From 34d81fc372994892f0bae5a52ab94ae7d757af37 Mon Sep 17 00:00:00 2001
From: Anthony Scemama <scemama@irsamc.ups-tlse.fr>
Date: Fri, 3 Oct 2014 15:24:04 +0200
Subject: [PATCH] MO to AO and AO to MO subroutines

---
 src/NEEDED_MODULES            |  2 +-
 src/Utils/LinearAlgebra.irp.f | 60 +++++++++++++++++++++++++++++++++++
 2 files changed, 61 insertions(+), 1 deletion(-)

diff --git a/src/NEEDED_MODULES b/src/NEEDED_MODULES
index 19028952..f644440c 100644
--- a/src/NEEDED_MODULES
+++ b/src/NEEDED_MODULES
@@ -1 +1 @@
-Utils
+AOs  Bitmask Dets Hartree_Fock  Electrons  Ezfio_files  MOs  Nuclei  Output  Utils  SCF
diff --git a/src/Utils/LinearAlgebra.irp.f b/src/Utils/LinearAlgebra.irp.f
index cd71f1b7..8759bf0f 100644
--- a/src/Utils/LinearAlgebra.irp.f
+++ b/src/Utils/LinearAlgebra.irp.f
@@ -362,3 +362,63 @@ subroutine lapack_partial_diag(eigvalues,eigvectors,H,nmax,n,n_st)
 
   deallocate(A)
 end
+
+
+
+subroutine ao_to_mo(A_ao,LDA_ao,A_mo,LDA_mo)
+  implicit none
+  BEGIN_DOC
+  ! Transform A from the AO basis to the MO basis
+  END_DOC
+  double precision, intent(in)   :: A_ao(LDA_ao)
+  double precision, intent(out)  :: A_mo(LDA_mo)
+  integer, intent(in)            :: LDA_ao,LDA_mo
+  double precision, allocatable  :: T(:,:)
+  
+  allocate ( T(ao_num_align,mo_tot_num) )
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
+  
+  call dgemm('N','N', ao_num, mo_tot_num, ao_num,                    &
+      1.d0, A_ao,LDA_ao,                                             &
+      mo_coef, size(mo_coef,1),                                      &
+      0.d0, T, ao_num_align)
+  
+  call dgemm('T','N', mo_tot_num, mo_tot_num, ao_num,                &
+      1.d0, mo_coef,size(mo_coef,1),                                 &
+      T, ao_num_align,                                               &
+      0.d0, A_mo, LDA_mo)
+  
+  deallocate(T)
+end
+
+subroutine mo_to_ao(A_mo,LDA_mo,A_ao,LDA_ao)
+  implicit none
+  BEGIN_DOC
+  ! Transform A from the MO basis to the AO basis
+  END_DOC
+  double precision, intent(in)   :: A_mo(LDA_mo)
+  double precision, intent(out)  :: A_ao(LDA_ao)
+  integer, intent(in)            :: LDA_ao,LDA_mo
+  double precision, allocatable  :: T(:,:), SC(:,:)
+  
+  allocate ( SC(ao_num_align,mo_tot_num) )
+  allocate ( T(mo_tot_num_align,ao_num) )
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: T
+  
+  call dgemm('N','N', ao_num, mo_tot_num, ao_num,                    &
+      1.d0, ao_overlap,size(ao_overlap,1),                           &
+      mo_coef, size(mo_coef,1),                                      &
+      0.d0, SC, ao_num_align)
+  
+  call dgemm('N','T', mo_tot_num, ao_num, mo_tot_num,                &
+      1.d0, A_mo,LDA_mo,                                             &
+      SC, size(SC,1),                                      &
+      0.d0, T, mo_tot_num_align)
+  
+  call dgemm('N','N', ao_num, ao_num, mo_tot_num,                    &
+      1.d0, SC,size(SC,1),                                 &
+      T, mo_tot_num_align,                                           &
+      0.d0, A_ao, LDA_ao)
+  
+  deallocate(T,SC)
+end