!>  Diagonalise the hamiltonian in a basis set of norbe orbitals and select the first
!!  norb eigenvectors. Works also with the spin-polarisation case and perform also the 
!!  treatment of semicore atoms. 
!!  In the absence of norbe parameters, it simply diagonalize the hamiltonian in the given
!!  orbital basis set.
!!  Works for wavefunctions given in a Gaussian basis set provided bt the structure G
subroutine Gaussian_DiagHam(iproc,nproc,natsc,nspin,orbs,G,mpirequests,&
      &   psigau,hpsigau,orbse,etol,norbsc_arr)
   use module_base
   use module_types
   use yaml_output
   implicit none
   integer, intent(in) :: iproc,nproc,natsc,nspin
   real(gp), intent(in) :: etol
   type(gaussian_basis), intent(in) :: G
   type(orbitals_data), intent(inout) :: orbs
   type(orbitals_data), intent(in) :: orbse
   integer, dimension(nproc-1), intent(in) :: mpirequests
   integer, dimension(natsc+1,nspin), intent(in) :: norbsc_arr
   real(wp), dimension(orbse%nspinor*G%ncoeff,orbse%norbp), intent(in) :: psigau,hpsigau
   !local variables
   character(len=*), parameter :: subname='Gaussian_DiagHam'
   !n(c) real(kind=8), parameter :: eps_mach=1.d-12
   logical :: semicore,minimal
   integer :: i,ndim_hamovr,norbi_max,j
   integer :: natsceff,ndh1,ispin,nspinor !n(c) norbtot,norbsc,npsidim
   real(gp) :: tolerance
   integer, dimension(:,:), allocatable :: norbgrp
   real(wp), dimension(:,:), allocatable :: hamovr

   tolerance=etol

   minimal=.true.!present(orbse)

   semicore=.true.!present(norbsc_arr)

   !define the grouping of the orbitals: for the semicore case, follow the semicore atoms,
   !otherwise use the number of orbitals, separated in the spin-polarised case
   !for the spin polarised case it is supposed that the semicore orbitals are disposed equally
   if (semicore) then
      !if (present(orbsv)) then
      !   norbi_max=max(maxval(norbsc_arr),orbsv%norb)
      !else
      norbi_max=maxval(norbsc_arr)
      !end if

      !calculate the dimension of the overlap matrix
      !take the maximum as the two spin dimensions
      ndim_hamovr=0
      do ispin=1,nspin
         ndh1=0
         !n(c) norbsc=0
         do i=1,natsc+1
            ndh1=ndh1+norbsc_arr(i,ispin)**2
         end do
         ndim_hamovr=max(ndim_hamovr,ndh1)
      end do
      if (natsc > 0) then
         if (nspin == 2) then
            if (sum(norbsc_arr(1:natsc,1)) /= sum(norbsc_arr(1:natsc,2))) then
               call yaml_warning('(Gaussian_DiagHam) The number of semicore orbitals must be the same for both spins')
               !write(*,'(1x,a)')&
               !   &   'ERROR (Gaussian_DiagHam): The number of semicore orbitals must be the same for both spins'
               stop
            end if
         end if
         !n(c) norbsc=sum(norbsc_arr(1:natsc,1))
      else
         !n(c) norbsc=0
      end if

      natsceff=natsc
      norbgrp = f_malloc((/ natsceff+1, nspin /),id='norbgrp')

      !assign the grouping of the orbitals
      do j=1,nspin
         do i=1,natsceff+1
            norbgrp(i,j)=norbsc_arr(i,j)
         end do
      end do
   else
      !this works also for non spin-polarised since there norbu=norb
      norbi_max=max(orbs%norbu,orbs%norbd) 
      ndim_hamovr=norbi_max**2

      natsceff=0
      norbgrp = f_malloc((/ 1, nspin /),id='norbgrp')

      !n(c) norbsc=0
      norbgrp(1,1)=orbs%norbu
      if (nspin == 2) norbgrp(1,2)=orbs%norbd

   end if

   !assign total orbital number for calculating the overlap matrix and diagonalise the system

   if(minimal) then
      !n(c) norbtot=orbse%norb !beware that norbe is equal both for spin up and down
      !n(c) npsidim=orbse%npsidim
      nspinor=orbse%nspinor
   else
      !n(c) norbtot=orbs%norb
      !n(c) npsidim=orbs%npsidim
      nspinor=orbs%nspinor
   end if

   hamovr = f_malloc((/ nspin*ndim_hamovr, 2 /),id='hamovr')

   if (iproc.eq.0) call yaml_comment('Overlap Matrix...')
   !if (iproc.eq.0) write(*,'(1x,a)',advance='no') 'Overlap Matrix...'

   call overlap_and_gather(iproc,nproc,mpirequests,G%ncoeff,natsc,nspin,ndim_hamovr,orbse,&
      &   norbsc_arr,psigau,hpsigau,hamovr)

   call solve_eigensystem(norbi_max,&
      &   ndim_hamovr,sum(norbgrp),natsceff,nspin,nspinor,norbgrp,hamovr,orbs%eval)
   !!!
   !!!  !allocate the pointer for virtual orbitals
   !!!  if(present(orbsv) .and. present(psivirt) .and. orbsv%norb > 0) then
   !!!     allocate(psivirt(orbsv%npsidim),stat=i_stat)
   !!!     call memocc(i_stat,psivirt,'psivirt',subname)
   !!!  end if
   !!!
   !!!  if (iproc.eq.0) write(*,'(1x,a)',advance='no')'Building orthogonal Wavefunctions...'
   !!!  nvctr=wfd%nvctr_c+7*wfd%nvctr_f
   !!!  if (.not. present(orbsv)) then
   !!!     call build_eigenvectors(orbs%norbu,orbs%norbd,orbs%norb,norbtot,nvctrp,&
!!!          natsceff,nspin,orbs%nspinor,ndim_hamovr,norbgrp,hamovr,psi,psit)
   !!!  else
   !!!     call build_eigenvectors(orbs%norbu,orbs%norbd,orbs%norb,norbtot,nvctrp,&
      !!!          natsceff,nspin,orbs%nspinor,ndim_hamovr,norbgrp,hamovr,psi,psit,orbsv%norb,psivirt)
!!!  end if
   !!!  
   !!!  !if(nproc==1.and.nspinor==4) call psitransspi(nvctrp,norbu+norbd,psit,.false.)
   !!!     
   call f_free(hamovr)
   !!!
   !!!  if (minimal) then
   !!!     !deallocate the old psi
   !!!     i_all=-product(shape(psi))*kind(psi)
   !!!     deallocate(psi,stat=i_stat)
   !!!     call memocc(i_stat,i_all,'psi',subname)
   !!!  else if (nproc == 1) then
   !!!     !reverse objects for the normal diagonalisation in serial
   !!!     !at this stage hpsi is the eigenvectors and psi is the old wavefunction
   !!!     !this will restore the correct identification
   !!!     nullify(hpsi)
   !!!     hpsi => psi
   !!!!     if(nspinor==4) call psitransspi(nvctrp,norb,psit,.false.) 
   !!!    nullify(psi)
   !!!     psi => psit
   !!!  end if
   !!!
   !!!  !orthogonalise the orbitals in the case of semi-core atoms
   !!!  if (norbsc > 0) then
   !if(nspin==1) then
   !   call orthon_p(iproc,nproc,norb,nvctrp,wfd%nvctr_c+7*wfd%nvctr_f,psit,nspinor) 
   !else
   !!!     call orthon_p(iproc,nproc,orbs%norbu,nvctrp,wfd%nvctr_c+7*wfd%nvctr_f,psit,&
         !!!          orbs%nspinor) 
   !!!     if(orbs%norbd > 0) then
   !!!        call orthon_p(iproc,nproc,orbs%norbd,nvctrp,wfd%nvctr_c+7*wfd%nvctr_f,&
         !!!             psit(1+nvctrp*orbs%norbu),orbs%nspinor) 
   !   end if
   !!!     end if
   !!!  end if
   !!!
   !!!
   !!!  if (minimal) then
   !!!     allocate(hpsi(orbs%npsidim),stat=i_stat)
   !!!     call memocc(i_stat,hpsi,'hpsi',subname)
   !!!!     hpsi=0.0d0
   !!!     if (nproc > 1) then
   !!!        !allocate the direct wavefunction
   !!!        allocate(psi(orbs%npsidim),stat=i_stat)
   !!!        call memocc(i_stat,psi,'psi',subname)
   !!!     else
   !!!        psi => psit
   !!!     end if
   !!!  end if
   !!!
   !!!  !this untranspose also the wavefunctions 
   !!!  call untranspose_v(iproc,nproc,orbs%norbp,orbs%nspinor,wfd,nvctrp,comms,&
        !!!       psit,work=hpsi,outadd=psi(1))
   !!!
   !!!  if (nproc == 1) then
   !!!     nullify(psit)
   !!!  end if

END SUBROUTINE Gaussian_DiagHam
