      subroutine ecrocc(nsym,isym,fermi,frozen,itsym,iord
     *,act,inact,delete,norb)
      use mod_lirorb
      IMPLICIT REAL*8(A-H,O-Z)
c     PARAMETER (maxorb=1024,maxsym=8)
      PARAMETER (maxorb=2048,maxsym=8)
      character*18 tipo1(maxorb),tipo2(maxorb),afr
      character*80 filorb
      dimension isym(norb),orb1(maxorb),isym_bid(8)
      dimension iord(norb),isymt(8)
      dimension fermi(nsym),itsym(maxorb),frozen(nsym),delete(nsym)
      dimension act(nsym),inact(nsym)
      integer fermi,frozen,act,delete
      logical yw,exist_labels
      yw=.false.
      !print'(a)','ecrocc Iord'
      !print'(20i4)',iord
! Compute isymt
      isymt=0
      do is=1,nsym-1
         isymt(is+1)=isymt(is)+isym(is)
      enddo



c
c ouverture de la file des orbitales
c
      call open_chose_number(if1,'BID1','unknown','formatted')
      call open_chose_number(if2,'BID2','unknown','formatted')
      call open_chose_number(if3,'BID3','unknown','formatted')
      call open_chose_number(if4,'BID4','unknown','formatted')
      close(if1)
      close(if2)
      close(if3)
      close(if4)
      noa=norb+sum(frozen)
      call lirorb('INPORB',noa,nsym,isym_bid,
     *if2,if1,ifiloc=if3,ifillab=if4
     *,exist_labels=exist_labels)
      
c
c ouverture d'une file locale
c
C      call open_chose_number
C     *(ifil_loc,'ECROCC_FIL','unknown','formatted')
c      print*,'entree ecrocc'
c
c     stockage des labels, s'ils existent
c
      if(exist_labels) then
         do is=1,nsym
            read(if4) (afr,k=1,frozen(is)),
     *      tipo1(isymt(is)+1:isymt(is)+isym(is))
         enddo
      endif
      tipo1(1:norb)=tipo1(iord(1:norb))
c
c     lecture des nombres d'occupation
c
      rewind if3
      do is=1,nsym
         read(if3) (bfr,k=1,frozen(is)),
     *   orb1(isymt(is)+1:isymt(is)+isym(is))
      enddo
      orb1(1:norb)=orb1(iord(1:norb))

      noc=sum(fermi)
      ninac=sum(inact)
      noac=sum(act)
      !print*,'tipo1',(tipo1(k),k=1,noc)
      !print*,'orb1',(orb1(k),k=1,noc)
 
      !print*,'ninac,noc,noac',ninac,noc,noac
      !print*,'act',act
c ------------------------------------------------------------
 
       
         write(*,*)'   ',('-',k=1,15),' Orbital Rearrangement ',
     *                   ('-',k=1,15)
      print*,'inact',inact
      print*,'ninac',ninac
      print*,'noac',noac
      print*,' '
 12    format((1x,4(i4,'(',i1,') #',f7.5,'# ')))
      if(all(act==0)) then
         write(*,12)(k,itsym(k),orb1(k),k=1,ninac)
         write(*,12)(k,itsym(k),orb1(k),k=1+ninac,noc)
         write(*,*)'   ',('-',k=1,15),'          Fermi level         ',
     *                   ('-',k=1,15)
         write(*,12)(k,itsym(k),orb1(k),k=noc+1,ninac+noac)
      else
         write(*,12)(k,itsym(k),orb1(k),k=1,ninac)
         write(*,*)'   ',('-',k=1,15),'      Begin Active Orbitals   ',
     *                   ('-',k=1,15)
         write(*,12)(k,itsym(k),orb1(k),k=1+ninac,ninac+noac)
         write(*,*)'   ',('-',k=1,15),'        End Active Orbitals   ',
     *                   ('-',k=1,15)
      endif
      write(*,12)(k,itsym(k),orb1(k),k=ninac+noac+1,norb)
      write(*,*)'   ',('-',k=1,62)
      write(*,*)
      if(.not.exist_labels) then
         close(if1)
         close(if2,status='delete')
         close(if4,status='delete')
         close(if3,status='delete')
         return
      endif
      write(*,*)'   ',('-',k=1,15),'------------- labels -----------',
     *                ('-',k=1,15)
      write(*,13)(k,itsym(k),tipo1(k),k=1,ninac)
 
      if(all(act==0)) 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,') ',a9,' ')))
 26   continue
      close(if1)
      close(if2,status='delete')
      close(if4,status='delete')
      close(if3,status='delete')
      return
      end
