wip: complex_diis_extrapolation

src/AOtoMO/complex_Hartree_matrix_AO_basis.f90

@@ -9,7 +9,7 @@ subroutine complex_Hartree_matrix_AO_basis(nBas,P,ERI,H)
 
   integer,intent(in)            :: nBas
   complex*16,intent(in)         :: P(nBas,nBas)
-  complex*16,intent(in)         :: ERI(nBas,nBas,nBas,nBas)
+  double precision,intent(in)   :: ERI(nBas,nBas,nBas,nBas)
 
 ! Local variables
 
@@ -25,7 +25,6 @@ subroutine complex_Hartree_matrix_AO_basis(nBas,P,ERI,H)
     do nu=1,nBas
       do la=1,nBas
         do mu=1,nBas
-           write(*,*) mu,la,nu,si,ERI(mu,la,nu,si)
            H(mu,nu) = H(mu,nu) + P(la,si)*ERI(mu,la,nu,si)
         end do
       end do

src/AOtoMO/complex_exchange_matrix_AO_basis.f90

@@ -9,7 +9,7 @@ subroutine complex_exchange_matrix_AO_basis(nBas,P,ERI,K)
 
   integer,intent(in)            :: nBas
   complex*16,intent(in)         :: P(nBas,nBas)
-  complex*16,intent(in)         :: ERI(nBas,nBas,nBas,nBas)
+  double precision,intent(in)   :: ERI(nBas,nBas,nBas,nBas)
 
 ! Local variables
 
@@ -25,7 +25,8 @@ subroutine complex_exchange_matrix_AO_basis(nBas,P,ERI,K)
     do si=1,nBas
       do la=1,nBas
         do mu=1,nBas
-          K(mu,nu) = K(mu,nu) - P(la,si)*ERI(mu,la,si,nu)
+          K(mu,nu) = K(mu,nu) - P(la,si)
+          !K(mu,nu) = K(mu,nu) - P(la,si)*ERI(mu,la,si,nu)
         end do
       end do
     end do

src/HF/cRHF.f90

@@ -156,7 +156,7 @@ subroutine cRHF(dotest,maxSCF,thresh,max_diis,guess_type,level_shift,nNuc,ZNuc,r
     if(max_diis > 1) then
 
       n_diis = min(n_diis+1,max_diis)
-      call DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,F)
+      call complex_DIIS_extrapolation(rcond,nBasSq,nBasSq,n_diis,err_diis,F_diis,err,F)
 
     end if
 

src/HF/complex_core_guess.f90

@@ -15,7 +15,6 @@ subroutine complex_core_guess(nBas, nOrb, Hc, X, c)
   complex*16,allocatable  :: cp(:,:)
   complex*16,allocatable  :: e(:)
 
-
 ! Output variables
 
   complex*16,intent(out)  :: c(nBas,nOrb)

src/utils/utils.f90

@@ -294,6 +294,39 @@ subroutine prepend(N,M,A,b)
 
 end subroutine 
 
+subroutine complex_prepend(N,M,A,b)
+
+! Prepend the vector b of size N into the matrix A of size NxM
+
+  implicit none
+
+! Input variables
+
+  integer,intent(in)            :: N,M
+  complex*16,intent(in)         :: b(N)
+
+! Local viaruabkes
+
+  integer                       :: i,j
+
+! Output variables
+
+  complex*16,intent(out)        :: A(N,M)
+
+
+! print*,'b in append'
+! call matout(N,1,b)
+
+  do i=1,N
+    do j=M-1,1,-1
+      A(i,j+1) = A(i,j)
+    end do
+    A(i,1) = b(i)
+  end do
+
+end subroutine
+
+
 !------------------------------------------------------------------------
 subroutine append(N,M,A,b)
 

src/utils/wrap_lapack.f90

@@ -296,6 +296,29 @@ subroutine linear_solve(N,A,b,x,rcond)
 
 end subroutine 
 
+subroutine complex_linear_solve(N,A,b,x,rcond)
+
+! Solve the linear system A.x = b where A is a NxN matrix
+! and x and b are vectors of size N
+
+  implicit none
+
+  integer,intent(in)             :: N
+  complex*16,intent(out)         :: A(N,N),b(N)
+  double precision               :: rcond
+  complex*16,intent(out)         :: x(N)
+
+  integer                        :: info
+  double precision               :: ferr,berr
+  integer,allocatable            :: ipiv(:)
+
+  ! Find optimal size for temporary arrays
+
+  allocate(ipiv(N))
+
+  call zgesv(N,1,A,N,ipiv,b,N,info)
+end subroutine
+
 subroutine easy_linear_solve(N,A,b,x)
 
 ! Solve the linear system A.x = b where A is a NxN matrix