subroutine huckel_guess(ovl, orbitals, infos, basis, huckel_basis)
use constants, only: tol_int
use types, only: information
use messages, only: show_message, WITH_ABORT
use mathlib, only: matrix_invsqrt
use basis_tools, only: basis_set
use int1, only: basis_overlap
use guess, only: corresponding_orbital_projection
implicit none
type(information), intent(in) :: infos
type(basis_set), intent(in) :: basis, huckel_basis
real(kind=dp) :: ovl(*), orbitals(*)
integer :: nat, i, ok, l0, l0co, nbf, nbf2, nbf_co, nact, ndoc, nproj
real(kind=dp), allocatable :: scr(:)
real(kind=dp), allocatable :: q(:)
real(kind=dp), allocatable :: vec(:,:)
real(kind=dp), allocatable :: sco(:,:)
nbf = basis%nbf
nbf2 = nbf*(nbf+1)/2
nat = infos%mol_prop%natom
! Number of orbitals in MINI basis used in Huckel
nbf_co = huckel_basis%nbf
allocate(scr(nbf), &
q(nbf*nbf), &
vec(nbf_co,nbf_co), &
sco(nbf_co,nbf), &
stat=ok)
if (ok/=0) call show_message('Cannot allocate memory', WITH_ABORT)
! Get overlap between the minimal basis set and the input basis
call basis_overlap(sco, basis, huckel_basis, tol=log(10.0d0)*tol_int)
do i = 1, nbf
sco(:,i) = sco(:,i)*basis%bfnrm(i) * huckel_basis%bfnrm
end do
! Determine which orbitals should be projected
if (infos%control%scftype == 1) then
ndoc = infos%mol_prop%nelec/2
nact = 0
else if (infos%control%scftype >= 2) then
ndoc = infos%mol_prop%nelec_b
nact = infos%mol_prop%nelec_a-infos%mol_prop%nelec_b
end if
! Extended Huckel calculation in mini basis set
call huckel_calc(huckel_basis, vec, l0co, nat, infos%atoms%zn, tol_int)
! Do at most 5 virtuals from the huckel
nproj = min(l0co,ndoc+nact+5)
! Get canonical orbitals in input basis space
call matrix_invsqrt(ovl, q, nbf, qrnk=l0)
orbitals(1:nbf*nbf) = q(1:nbf*nbf)
! Project minimal basis set guess onto the input canonical orbitals,
call corresponding_orbital_projection(vec, sco, orbitals, ndoc, nact, nproj, nbf, nbf_co, l0)
deallocate(vec, sco)
call orthogonalize_orbitals(q, ovl, orbitals, nproj, l0, nbf, nbf)
end subroutine huckel_guess