natural orbitals of the super_ci works

src/casscf/get_energy.irp.f

@@ -39,6 +39,7 @@ subroutine routine_bis
   accu_d += psi_coef(i,1)**2
  enddo
  print*,'accu_d = ',accu_d
+ provide superci_natorb
 end
 
 subroutine routine

src/casscf/swap_orb.irp.f

@@ -52,8 +52,8 @@
  ! equation B3.c of the annex B of Roos et. al. Chemical Physics 48 (1980) 157-173
  do i = 1, n_core_inact_orb
   iorb = list_core_inact(i)
-  do a = 1, n_act_orb
-   aorb = list_act(a)
+  do a = 1, n_virt_orb
+   aorb = list_virt(a)
    super_ci_dm(aorb,iorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
    super_ci_dm(iorb,aorb) = 2.d0 * c0 * lowest_super_ci_coef_mo(aorb,iorb)
   enddo
@@ -125,6 +125,12 @@
 
  END_PROVIDER 
 
+ BEGIN_PROVIDER [double precision, superci_natorb, (ao_num,mo_num)
+&BEGIN_PROVIDER [double precision, superci_nat_occ, (mo_num)
+ implicit none
+ call general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(super_ci_dm,mo_num,mo_num,mo_num,superci_nat_occ,superci_natorb)
+
+END_PROVIDER 
 
  BEGIN_PROVIDER [double precision, mat_tmp_dm_super_ci, (n_act_orb,n_act_orb)]
  implicit none

src/mo_basis/utils.irp.f

@@ -217,3 +217,59 @@ subroutine mo_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,eig,label)
 end
 
 
+subroutine general_mo_coef_new_as_svd_vectors_of_mo_matrix_eig(matrix,lda,m,n,eig,mo_coef_new)
+  implicit none
+  integer,intent(in)             :: lda,m,n
+  double precision, intent(in)   :: matrix(lda,n)
+  double precision, intent(out)  :: eig(m),mo_coef_new(ao_num,m)
+
+  integer :: i,j
+  double precision :: accu
+  double precision, allocatable  ::  mo_coef_tmp(:,:), U(:,:),D(:), A(:,:), Vt(:,:), work(:)
+  !DIR$ ATTRIBUTES ALIGN : $IRP_ALIGN :: mo_coef_new, U, Vt, A
+
+  call write_time(6)
+  if (m /= mo_num) then
+    print *, irp_here, ': Error : m/= mo_num'
+    stop 1
+  endif
+
+  allocate(A(lda,n),U(lda,n),D(m),Vt(lda,n),mo_coef_tmp(ao_num,mo_num))
+
+  do j=1,n
+    do i=1,m
+      A(i,j) = matrix(i,j)
+    enddo
+  enddo
+  mo_coef_tmp = mo_coef
+
+  call svd(A,lda,U,lda,D,Vt,lda,m,n)
+
+  write (6,'(A)')  ''
+  write (6,'(A)') 'Eigenvalues'
+  write (6,'(A)')  '-----------'
+  write (6,'(A)') ''
+  write (6,'(A)')  '======== ================ ================'
+  write (6,'(A)')  '   MO       Eigenvalue       Cumulative   '
+  write (6,'(A)')  '======== ================ ================'
+
+  accu = 0.d0
+  do i=1,m
+    accu = accu + D(i)
+    write (6,'(I8,1X,F16.10,1X,F16.10)')  i,D(i), accu
+  enddo
+  write (6,'(A)')  '======== ================ ================'
+  write (6,'(A)')  ''
+
+  call dgemm('N','N',ao_num,m,m,1.d0,mo_coef_tmp,size(mo_coef_new,1),U,size(U,1),0.d0,mo_coef_new,size(mo_coef,1))
+
+  do i=1,m
+    eig(i) = D(i)
+  enddo
+
+  deallocate(A,U,Vt,D,mo_coef_tmp)
+  call write_time(6)
+
+end
+
+