! ---

 BEGIN_PROVIDER [ double precision, fock_tc_reigvec_mo, (mo_num, mo_num)]
&BEGIN_PROVIDER [ double precision, fock_tc_leigvec_mo, (mo_num, mo_num)]
&BEGIN_PROVIDER [ double precision, eigval_fock_tc_mo, (mo_num)]
&BEGIN_PROVIDER [ double precision, overlap_fock_tc_eigvec_mo, (mo_num, mo_num)]

  BEGIN_DOC
  ! EIGENVECTORS OF FOCK MATRIX ON THE MO BASIS and their OVERLAP
  END_DOC

  implicit none
  integer                       :: n_real_tc 
  integer                       :: i, j, k, l
  double precision              :: accu_d, accu_nd, accu_tmp
  double precision              :: norm
  double precision, allocatable :: eigval_right_tmp(:)
  double precision, allocatable :: F_tmp(:,:)

  allocate( eigval_right_tmp(mo_num), F_tmp(mo_num,mo_num) )

  PROVIDE Fock_matrix_tc_mo_tot

  do i = 1, mo_num
    do j = 1, mo_num
      F_tmp(j,i) = Fock_matrix_tc_mo_tot(j,i)
    enddo
  enddo
  ! insert level shift here
  do i = elec_beta_num+1, elec_alpha_num
    F_tmp(i,i) += 0.5d0 * level_shift_tcscf
  enddo
  do i = elec_alpha_num+1, mo_num
    F_tmp(i,i) += level_shift_tcscf
  enddo

  call non_hrmt_bieig( mo_num, F_tmp, thresh_biorthog_diag, thresh_biorthog_nondiag &
                     , fock_tc_leigvec_mo, fock_tc_reigvec_mo                       & 
                     , n_real_tc, eigval_right_tmp )

  deallocate(F_tmp)

  eigval_fock_tc_mo = eigval_right_tmp

  ! L.T x R 
  call dgemm( "T", "N", mo_num, mo_num, mo_num, 1.d0          &
            , fock_tc_leigvec_mo, size(fock_tc_leigvec_mo, 1) &
            , fock_tc_reigvec_mo, size(fock_tc_reigvec_mo, 1) &
            , 0.d0, overlap_fock_tc_eigvec_mo, size(overlap_fock_tc_eigvec_mo, 1) )

  ! ---

  accu_d  = 0.d0
  accu_nd = 0.d0
  do i = 1, mo_num
    do k = 1, mo_num
      if(i==k) then
        accu_tmp = overlap_fock_tc_eigvec_mo(k,i)
        accu_d += dabs(accu_tmp )
      else
        accu_tmp = overlap_fock_tc_eigvec_mo(k,i)
        accu_nd += accu_tmp * accu_tmp
        if(dabs(overlap_fock_tc_eigvec_mo(k,i)) .gt. thresh_biorthog_nondiag)then
         print *, 'k,i', k, i, overlap_fock_tc_eigvec_mo(k,i)
        endif
      endif
    enddo 
  enddo
  accu_nd = dsqrt(accu_nd) / accu_d
  if(accu_nd .gt. thresh_biorthog_nondiag) then
    print *, ' bi-orthog failed'
    print *, ' accu_nd MO = ', accu_nd, thresh_biorthog_nondiag
    print *, ' overlap_fock_tc_eigvec_mo = '
    do i = 1, mo_num
      write(*,'(100(F16.10,X))') overlap_fock_tc_eigvec_mo(i,:)
    enddo
    stop
  endif

  ! ---

  if(dabs(accu_d - dble(mo_num))/dble(mo_num) .gt. thresh_biorthog_diag) then

    print *, ' mo_num     = ', mo_num 
    print *, ' accu_d  MO = ', accu_d, thresh_biorthog_diag
    print *, ' normalizing vectors ...'
    do i = 1, mo_num
      norm = dsqrt(dabs(overlap_fock_tc_eigvec_mo(i,i)))
      if(norm .gt. thresh_biorthog_diag) then
        do k = 1, mo_num
          fock_tc_reigvec_mo(k,i) *= 1.d0/norm
          fock_tc_leigvec_mo(k,i) *= 1.d0/norm
        enddo
      endif
    enddo

    call dgemm( "T", "N", mo_num, mo_num, mo_num, 1.d0          &
              , fock_tc_leigvec_mo, size(fock_tc_leigvec_mo, 1) &
              , fock_tc_reigvec_mo, size(fock_tc_reigvec_mo, 1) &
              , 0.d0, overlap_fock_tc_eigvec_mo, size(overlap_fock_tc_eigvec_mo, 1) )

    accu_d  = 0.d0
    accu_nd = 0.d0
    do i = 1, mo_num
      do k = 1, mo_num
        if(i==k) then
          accu_tmp = overlap_fock_tc_eigvec_mo(k,i)
          accu_d  += dabs(accu_tmp)
        else
          accu_tmp = overlap_fock_tc_eigvec_mo(k,i)
          accu_nd += accu_tmp * accu_tmp
          if(dabs(overlap_fock_tc_eigvec_mo(k,i)) .gt. thresh_biorthog_nondiag)then
           print *, 'k,i', k, i, overlap_fock_tc_eigvec_mo(k,i)
          endif
        endif
      enddo 
    enddo
    accu_nd = dsqrt(accu_nd) / accu_d
    if(accu_nd .gt. thresh_biorthog_diag) then
      print *, ' bi-orthog failed'
      print *, ' accu_nd MO = ', accu_nd, thresh_biorthog_nondiag
      print *, ' overlap_fock_tc_eigvec_mo = '
      do i = 1, mo_num
        write(*,'(100(F16.10,X))') overlap_fock_tc_eigvec_mo(i,:)
      enddo
      stop
    endif

  endif
 
  ! ---

END_PROVIDER 

! ---

 BEGIN_PROVIDER [ double precision, fock_tc_reigvec_ao, (ao_num, mo_num)]
&BEGIN_PROVIDER [ double precision, fock_tc_leigvec_ao, (ao_num, mo_num)]
&BEGIN_PROVIDER [ double precision, overlap_fock_tc_eigvec_ao, (mo_num, mo_num) ]

  BEGIN_DOC
  ! EIGENVECTORS OF FOCK MATRIX ON THE AO BASIS and their OVERLAP
  !
  ! THE OVERLAP SHOULD BE THE SAME AS overlap_fock_tc_eigvec_mo
  END_DOC

  implicit none
  integer                       :: i, j, k, q, p
  double precision              :: accu, accu_d
  double precision, allocatable :: tmp(:,:)

  PROVIDE mo_l_coef mo_r_coef

!  ! MO_R x R
   call dgemm( 'N', 'N', ao_num, mo_num, mo_num, 1.d0          &
             , mo_r_coef, size(mo_r_coef, 1)                   &
             , fock_tc_reigvec_mo, size(fock_tc_reigvec_mo, 1) &
             , 0.d0, fock_tc_reigvec_ao, size(fock_tc_reigvec_ao, 1) )

   ! MO_L x L
   call dgemm( 'N', 'N', ao_num, mo_num, mo_num, 1.d0          &
             , mo_l_coef, size(mo_l_coef, 1)                   &
             , fock_tc_leigvec_mo, size(fock_tc_leigvec_mo, 1) &
             , 0.d0, fock_tc_leigvec_ao, size(fock_tc_leigvec_ao, 1) )
 
  allocate( tmp(mo_num,ao_num) )

  ! tmp <-- L.T x S_ao
  call dgemm( "T", "N", mo_num, ao_num, ao_num, 1.d0                                           &
            , fock_tc_leigvec_ao, size(fock_tc_leigvec_ao, 1), ao_overlap, size(ao_overlap, 1) &
            , 0.d0, tmp, size(tmp, 1) )

  ! S <-- tmp x R
  call dgemm( "N", "N", mo_num, mo_num, ao_num, 1.d0                             &
            , tmp, size(tmp, 1), fock_tc_reigvec_ao, size(fock_tc_reigvec_ao, 1) &
            , 0.d0, overlap_fock_tc_eigvec_ao, size(overlap_fock_tc_eigvec_ao, 1) )

  deallocate( tmp )

  ! ---
  double precision :: norm
  do i = 1, mo_num
   norm = 1.d0/dsqrt(dabs(overlap_fock_tc_eigvec_ao(i,i)))
   do j = 1, mo_num
    fock_tc_reigvec_ao(j,i) *= norm
    fock_tc_leigvec_ao(j,i) *= norm
   enddo
  enddo

  allocate( tmp(mo_num,ao_num) )

  ! tmp <-- L.T x S_ao
  call dgemm( "T", "N", mo_num, ao_num, ao_num, 1.d0                                           &
            , fock_tc_leigvec_ao, size(fock_tc_leigvec_ao, 1), ao_overlap, size(ao_overlap, 1) &
            , 0.d0, tmp, size(tmp, 1) )

  ! S <-- tmp x R
  call dgemm( "N", "N", mo_num, mo_num, ao_num, 1.d0                             &
            , tmp, size(tmp, 1), fock_tc_reigvec_ao, size(fock_tc_reigvec_ao, 1) &
            , 0.d0, overlap_fock_tc_eigvec_ao, size(overlap_fock_tc_eigvec_ao, 1) )

  deallocate( tmp )

END_PROVIDER

