Cleaned neworbs

src/casscf/casscf.irp.f

@@ -21,10 +21,6 @@ subroutine run
     call run_cipsi
 
     write(6,*) ' total energy = ',eone+etwo+ecore
-    mo_label = "MCSCF"
-    mo_label = "Natural"
-    mo_coef(:,:) = NatOrbsFCI(:,:)
-    call save_mos
 
     call driver_optorb
     energy_old = energy

src/casscf/neworbs.irp.f

@@ -1,7 +1,11 @@
-! -*- F90 -*-
 BEGIN_PROVIDER [real*8, SXmatrix, (nMonoEx+1,nMonoEx+1)]
   implicit none
+  BEGIN_DOC
+  ! Single-excitation matrix
+  END_DOC
+  
   integer                        :: i,j
+  
   do i=1,nMonoEx+1
     do j=1,nMonoEx+1
       SXmatrix(i,j)=0.D0
@@ -31,15 +35,22 @@ END_PROVIDER
 
  BEGIN_PROVIDER [real*8, SXeigenvec, (nMonoEx+1,nMonoEx+1)]
 &BEGIN_PROVIDER [real*8, SXeigenval, (nMonoEx+1)]
+  implicit none
+  BEGIN_DOC
+  ! Eigenvectors/eigenvalues of the single-excitation matrix
+  END_DOC
+  call lapack_diag(SXeigenval,SXeigenvec,SXmatrix,nMonoEx+1,nMonoEx+1)
 END_PROVIDER
 
  BEGIN_PROVIDER [real*8, SXvector, (nMonoEx+1)]
 &BEGIN_PROVIDER [real*8, energy_improvement]
   implicit none
+  BEGIN_DOC
+  ! Best eigenvector of the single-excitation matrix
+  END_DOC
   integer                        :: ierr,matz,i
   real*8                         :: c0
   
-      call lapack_diag(SXeigenval,SXeigenvec,SXmatrix,nMonoEx+1,nMonoEx+1)
   write(6,*) ' SXdiag : lowest 5 eigenvalues '
   write(6,*) ' 1 - ',SXeigenval(1),SXeigenvec(1,1)
   write(6,*) ' 2 - ',SXeigenval(2),SXeigenvec(1,2)
@@ -78,53 +89,32 @@ END_PROVIDER
 
 BEGIN_PROVIDER [real*8, NewOrbs, (ao_num,mo_num) ]
   implicit none
+  BEGIN_DOC
+  ! Updated orbitals
+  END_DOC
   integer                        :: i,j,ialph
   
-! form the exponential of the Orbital rotations
+  call dgemm('N','T', ao_num,mo_num,mo_num,1.d0,                     &
-      call get_orbrotmat
+      NatOrbsFCI, size(NatOrbsFCI,1),                                &
-! form the new orbitals
+      Umat, size(Umat,1), 0.d0,                                      &
-      do i=1,ao_num
+      NewOrbs, size(NewOrbs,1))
-       do j=1,mo_num
-        NewOrbs(i,j)=0.D0
-       end do
-      end do
-
-      do ialph=1,ao_num
-       do i=1,mo_num
-        wrkline(i)=mo_coef(ialph,i)
-       end do
-       do i=1,mo_num
-        do j=1,mo_num
-         NewOrbs(ialph,i)+=Umat(i,j)*wrkline(j)
-        end do
-       end do
-      end do
   
 END_PROVIDER
 
- BEGIN_PROVIDER [real*8, Tpotmat, (mo_num,mo_num) ]
+BEGIN_PROVIDER [real*8, Umat, (mo_num,mo_num) ]
-&BEGIN_PROVIDER [real*8, Umat, (mo_num,mo_num) ]
-&BEGIN_PROVIDER [real*8, wrkline, (mo_num) ]
-&BEGIN_PROVIDER [real*8, Tmat, (mo_num,mo_num) ]
-END_PROVIDER
-
-      subroutine get_orbrotmat
   implicit none
+  BEGIN_DOC
+  ! Orbital rotation matrix
+  END_DOC
   integer                        :: i,j,indx,k,iter,t,a,ii,tt,aa
-      real*8 :: sum
   logical                        :: converged
   
+  real*8 :: Tpotmat (mo_num,mo_num), Tpotmat2 (mo_num,mo_num) 
+  real*8 :: Tmat(mo_num,mo_num) 
+  real*8 :: f
   
   ! the orbital rotation matrix T
-      do i=1,mo_num
+  Tmat(:,:)=0.D0
-       do j=1,mo_num
-        Tmat(i,j)=0.D0
-        Umat(i,j)=0.D0
-        Tpotmat(i,j)=0.D0
-       end do
-       Tpotmat(i,i)=1.D0
-      end do
-
   indx=1
   do i=1,n_core_orb
     ii=list_core(i)
@@ -154,69 +144,29 @@ END_PROVIDER
     end do
   end do
   
-      write(6,*) ' the T matrix '
+  ! Form the exponential
-      do indx=1,nMonoEx
-       i=excit(1,indx)
-       j=excit(2,indx)
-!       if (abs(Tmat(i,j)).gt.1.D0) then
-!        write(6,*) ' setting matrix element ',i,j,' of ',Tmat(i,j),' to ' &
-!             , sign(1.D0,Tmat(i,j))
-!        Tmat(i,j)=sign(1.D0,Tmat(i,j))
-!        Tmat(j,i)=-Tmat(i,j)
-!       end if
-        if (abs(Tmat(i,j)).gt.1.D-9) write(6,9901) i,j,excit_class(indx),Tmat(i,j)
-  9901 format('   ',i4,' -> ',i4,' (',A3,') : ',E14.6)
-      end do
 
-      write(6,*) 
+  Tpotmat(:,:)=0.D0
-      write(6,*) ' forming the matrix exponential '
+  Umat(:,:)   =0.D0
-      write(6,*) 
+  do i=1,mo_num
-! form the exponential
+    Tpotmat(i,i)=1.D0
+    Umat(i,i)   =1.d0
+  end do
   iter=0
   converged=.false.
   do while (.not.converged)
     iter+=1
-! add the next term
+    f = 1.d0 / dble(iter)
-       do i=1,mo_num
+    Tpotmat2(:,:) = Tpotmat(:,:) * f
-        do j=1,mo_num
+    call dgemm('N','N', mo_num,mo_num,mo_num,1.d0,                   &
-         Umat(i,j)+=Tpotmat(i,j)
+        Tpotmat2, size(Tpotmat2,1),                                  &
-        end do
+        Tmat, size(Tmat,1), 0.d0,                                    &
-       end do
+        Tpotmat, size(Tpotmat,1))
-! next power of T, we multiply Tpotmat with Tmat/iter
+    Umat(:,:) = Umat(:,:) + Tpotmat(:,:)
-       do i=1,mo_num
-        do j=1,mo_num
-         wrkline(j)=Tpotmat(i,j)/dble(iter)
-         Tpotmat(i,j)=0.D0
-        end do
-        do j=1,mo_num
-         do k=1,mo_num
-          Tpotmat(i,j)+=wrkline(k)*Tmat(k,j)
-         end do
-        end do
-       end do
-! Convergence test
-       sum=0.D0
-       do i=1,mo_num
-        do j=1,mo_num
-         sum+=abs(Tpotmat(i,j))
-        end do
-       end do
-       write(6,*) ' Iteration No ',iter,' Sum = ',sum
-       if (sum.lt.1.D-6) then
-        converged=.true.
-       end if
-       if (iter.ge.NItExpMax) then
-        stop ' no convergence '
-       end if
-      end do
-      write(6,*)
-      write(6,*) ' Converged ! '
-      write(6,*)
     
-      end subroutine get_orbrotmat
+    converged = ( sum(abs(Tpotmat(:,:))) < 1.d-6).or.(iter>30)
-
+  end do
-BEGIN_PROVIDER [integer, NItExpMax]
-   NItExpMax=100
 END_PROVIDER
   
 
+