      subroutine ecrocc
      use module
      use mod_licost
      use mod_tijkl
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      character(80) filorb
      character*18 afr
      real(8),allocatable,dimension(:) :: orb11
      character(18),allocatable,dimension(:) :: tipo1,tipo2
      integer act_loc(8)
      character(10000) namel
      yw=.false.
      act_loc=0
      allocate(orb11(norb))
      allocate(tipo1(norb))
      allocate(tipo2(norb))
      rewind 93
      call LECNAM('&IJKL ',namel,93,ierr,1)
      call namell(namel,SEMI_ACTIVE,'SEMI_ACTIVE',4)
      call nameli(namel,act_loc,'ACT',4)
c
c     store Local Orbital labels, if they exist
c
      open(80,file=orb1,status='old')
      open(81,status='unknown',file='BID81')
      ylabel=.false.
 27   read(80,'(a)',end=28) filorb
      INAM=INDEX(filorb,'LABELS')
      IF(INAM.EQ.0) goto 27
      ylabel=.true.
 29   read(80,'(a)',end=28) filorb
      write(81,'(a)') filorb
      goto 29
 28   continue
      rewind 80
      rewind 81
c
c     lecture des nombres d'occupation
c
!      read(80,'(a)',end=26) filorb
      !print*,filorb
      do
         read(80,'(a)',end=26) filorb
         INAM=INDEX(filorb,'OCCUPATION NUMBERS')
         IF(INAM.ne.0) exit
      enddo
      noc=sum(fermi)
      ninac=noc-(nactel+1)/2
c      print*,'noc,norb',noc,norb
      if(yw)print*,'fermi',(fermi(k),k=1,nsym)
      if(yw)print*,'isym',(isym(k),k=1,nsym)
      if(yw)print*,'isymoa',(isymoa(k),k=1,nsym)
      if(yw)print*,'insinv',(insinv(k),k=1,norb)
      if(yw)print*,'ninac',ninac
      ifin0=0
      orb11=1.d10
      do is=1,nsym
         nsi=isym(is)
         nsif=nsi+frozen(is)
         ideb0=ifin0+1
         ifin0=ideb0+nsi-1
         if(nsif.ne.0) read(80,1000)
     *   (fr,k=1,frozen(is)),
     *   (orb11(insinv(k)),k=ideb0,ifin0),
     *   (de,k=1,delete(is))
!         print*,'orb11',ideb0,ifin0,
!     *   insinv(ideb0:ifin0),orb11(insinv(ideb0:ifin0))
!         do k=1,norb
!         if(nsif.ne.0)print'(a5,i4,f10.6)','Orb11 ',k,orb11(k)
!         enddo
         if(ylabel.and.nsif.ne.0) read(81,1001)
     *   (afr,k=1,frozen(is)),
     *   (tipo1(insinv(k)),k=ideb0,ifin0),
     *   (de,k=1,delete(is))
      enddo
      if(yw) then
         do k=1,norb
            if(ylabel.and.nsif.ne.0)print'(a5,a12)','tipo ',tipo1(k)
            if(nsif.ne.0)print'(a5,f10.6)','orb11 ',orb11(k)
         enddo
      endif
 1000 format(4d18.12)
 1001 format(4a18)
c ------------------------------------------------------------
 
      write(*,*)
      write(*,*)'   ',('-',k=1,15),' orbital rearrangement ',
     *                ('-',k=1,15)
      print*,' '
      print*,'Data for the renumerotation of the orbitals:'
      print'(2a)',   ' orb_sort                      ',orb_sort
      print'(a,8i5)',' Fermi                       ',fermi(1:nsym)
      if(orb_sort=='OAV') then
         print'(a,8i5)',' Act                         ',act(1:nsym)
         print'(a,8i5)',' Inac                        ',inac(1:nsym)
         print'(a,i5)', ' nactel                      ',nactel
      endif

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!     reordonnancement avec actives non implemente'
      act_loc=0
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !print'(a,8i5)',' Act                         ',act_loc(1:nsym)




      if(all(act_loc==0).and.all(fermi==0))
     *print*,'(no rearrangement)'
      print*,' '
      write(*,12)(k,itsym(k),orb11(k),k=1,ninac)
 12    format((1x,4(i4,'(',i1,') #',f7.5,'# ')))
      if(orb_sort=='OV') then
         write(*,12)(k,itsym(k),orb11(k),k=1+ninac,noc)
         write(*,*)'   ',('-',k=1,15),'          Fermi level         ',
     *                   ('-',k=1,15)
         write(*,12)(k,itsym(k),orb11(k),k=noc+1,ninac+noac)
      else if(orb_sort=='OAV') then
         write(*,*)'   ',('-',k=1,15),'      Begin Active Orbitals   ',
     *                   ('-',k=1,15)
         write(*,12)(k,itsym(k),orb11(k),k=1+ninac,ninac+noac)
         write(*,*)'   ',('-',k=1,15),'        End Active Orbitals   ',
     *                   ('-',k=1,15)
      endif
      write(*,12)(k,itsym(k),orb11(k),k=ninac+noac+1,norb)
      write(*,*)'   ',('-',k=1,62)
      write(*,*)
      if(.not.ylabel) return
      write(*,*)'   ',('-',k=1,15),'------------- labels -----------',
     *                ('-',k=1,15)
      write(*,13)(k,itsym(k),tipo1(k),k=1,ninac)
 
 
      if(orb_sort=='OV') then
         write(*,13)(k,itsym(k),tipo1(k),k=1+ninac,noc)
         write(*,*)'   ',('-',k=1,15),'          Fermi level         ',
     *                   ('-',k=1,15)
         write(*,13)(k,itsym(k),tipo1(k),k=noc+1,ninac+noac)
      else
         write(*,*)'   ',('-',k=1,15),'      Begin Active Orbitals   ',
     *                   ('-',k=1,15)
         write(*,13)(k,itsym(k),tipo1(k),k=1+ninac,ninac+noac)
         write(*,*)'   ',('-',k=1,15),'        End Active Orbitals   ',
     *                   ('-',k=1,15)
      endif
      write(*,13)(k,itsym(k),tipo1(k),k=ninac+noac+1,norb)
      write(*,*)'   ',('-',k=1,62)
      write(*,*)
 13    format((1x,4(i4,'(',i1,') #',a7,'# ')))

      return
 26   continue
      print*,'no line ''OCCUPATION NUMBERS'' found in InpOrb file'
      return
      end
