      subroutine reor_on(norbgd,itype,on,workl,dens,work,workl2,yhier)
      implicit real*8(a-h,o-x,z),logical*1(y)
      dimension on(norbgd,norbgd)
      dimension dens(norbgd,norbgd)
      dimension work(norbgd,norbgd)
      dimension workl(norbgd),workl2(norbgd)
      dimension itype(norbgd)
      dimension ml(1),nbvectyp(3)
!
!-------------------------------------------------------------
! dens est la matrice densite diagonalisee
! on sont les vecteurs propres de la matrice densite, donc la 
! matrice de passage
! On va mettre a zero les blocs extradiagonaux de on
! Ces blocs sont definis par itype
! il faut que les parties qu'on met a zero soient les parties
! "petites" de on. Il peut arriver une erreur si, dans jacobi, les
! vecteurs de on ne sont aps arrives dans un ordre correct
! Cette subroutine teste si les parties gardees sont vraiment 
! les plus grandes
!-------------------------------------------------------------
!
!      call script(on,norbgd,norbgd,norbgd,norbgd)
      if(.not.yhier) return
! nomgre d'OL par type :
      nbvectyp=0
      do i=1,norbgd
         nbvectyp(itype(i))=nbvectyp(itype(i))+1
      enddo
! boucle sur ityp
      nn=0
      do ityp=1,3
         workl=0.d0
! On cherche les vecteurs de plus grande projection sur les orbitales
! du ityp considere
! boucle sur les vecteurs propres
         do i=1,norbgd
! boucles sur les OL
            do j=1,norbgd
               if(itype(j)/=ityp) cycle
               workl(i)=workl(i)+on(j,i)*on(j,i)
            enddo
         enddo
! on va chercher, pour cette valeur de  ityp, 
! les vecteurs de plus grand recouvrement
         !print*, nbvectyp
         !print*,'ityp,workl',ityp,workl
         do i=1,nbvectyp(ityp)
            ml=maxloc(workl)
            nn=nn+1
            !print*,'nn,ml',nn,ml
            workl(ml(1))=workl(nn)
            workl(ml(1))=0.d0
            work(:,nn)=on(:,ml(1))
            workl2(nn)=dens(ml(1),ml(1))
         enddo
      enddo
      !print*,'dens',(workl2(k),k=1,norbgd)
      !print*,'workl',(workl(k),k=1,norbgd)
      !call script(work,norbgd,norbgd,norbgd,norbgd)
      do k=1,norbgd
         dens(k,k)=workl2(k)
         on(:,k)=work(:,k)
      enddo
      return
      end
      
