      subroutine prepar
      IMPLICIT REAL*8(A-H,O-X,Z),LOGICAL*1 (Y)
      parameter(maxsym=8,maxorbcas=16,lungo=100)
      include 'maxorb.prm'
      parameter(maxne=maxorbcas+2)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/orb2/numina(maxorb),numvir(maxorb),iordo(maxorb*2)
     *,iodro(maxorb*2)
     *,numinb(maxorb),numvib(maxorb)
      common/sy2/nts(maxsym),ncs(maxsym),nps(maxsym)
     *,norbs(maxsym)
      common/sy4/ntstot(0:maxsym),ncstot(0:maxsym),npstot(0:maxsym)
      common/sy3/itorbi(maxorb),isbrot(maxorb),itorbc(maxorb)
     *,itorbs(maxorb)
      common/util/jsp(-2:2,-2:2),ksp(-4:4)
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common/pr/nprint,mprint(10)
      character*1 ctps,cex
      common/detsto/mdestod,ndestod,mdestod1,ndestod1,npie2,mpie2,
     *mpie256,mdestod256,mdestod2561,
     *ctps(maxne*lungo*2),cex(lungo),c256((maxne/4+1)*lungo)
      common/sy7/inumsy(maxsym,maxorb)
      common /prep/ nca0,ncb0,ic0(maxorbcas),icamun(maxorb+maxorb)
     *,numt(maxorb),nump(maxorb),nv
     *,gener,yoc(maxorb+maxorb),yrefc(maxorbcas),yac(maxorb)
     *,ygmono,ygddci,ygddc2,ygcas,ygtous
      character*4 gener
      mdestod=0
      ndestod=0
      mdestod1=0
      ndestod1=0
      mdestod2561=0
      mdestod256=0
      npie2=0
      mpie2=0
      mpie256=0
      jsp(-1,-2)=-2
      jsp( 0,-2)= 0
      jsp( 1,-2)= 2
      jsp(-1,-1)=-1
      jsp( 1,-1)= 1
      jsp(-1, 0)=-2
      jsp( 0, 0)= 0
      jsp( 1, 0)= 2
      jsp(-1, 1)=-1
      jsp( 1, 1)= 1
      jsp(-1, 2)=-2
      jsp( 0, 2)= 0
      jsp( 1, 2)= 2
      ksp(-2)=-1
      ksp(-1)=-1
      ksp( 0)= 0
      ksp( 1)= 1
      ksp( 2)= 1
      jsp(-2, 0)=-4
      jsp( 2, 0)= 4
      jsp(-2, 1)=-3
      jsp( 2, 1)= 3
      jsp(-2,-1)=-3
      jsp( 2,-1)= 3
      ksp(-4)=-2
      ksp(-3)=-2
      ksp( 4)= 2
      ksp( 3)= 2
      do k=1,noca0
         itype(k)=1
      enddo
      do k=noca0+1,norb
         itype(k)=3
      enddo
      do k=1,noac
         itype(numac(k))=2
      enddo
      ygcas=gener.eq.'CAS'.or.gener.eq.'MRC'.or.gener.eq.'MRTC'
      ygmono=gener.eq.'MONO'.or.gener.eq.'MRM'.or.gener.eq.'MRTM'
      if(nprint.ge.1) then
         write(6,*)' '
         write(6,*)
     *   '===================================================='
         write(6,*)
     *   'prepar  analyse des donnees concernant les orbitales'
         write(6,*)
     *   '===================================================='
         write(6,*)'TYPE DES ORBITALES   occ 1     CAS 2     virt 3'
         do ideb=1,norb,20
            ifin=min0(ideb+19,norb)
            write(6,'(20i3)')(i,i=ideb,ifin)
            write(6,'(20i3)')(itype(i),i=ideb,ifin)
            write(6,*)' '
         enddo
      endif
c--------numeros des orbitales dans leurs symetries
      ninac=0
      nvirt=0
      do k=1,nsym
         nts(k)=0
         nps(k)=0
         ncs(k)=0
      enddo
      do k=1,norb
         norbs(itsym(k))=norbs(itsym(k))+1
         itorbi(k)=norbs(itsym(k))
         inumsy(itsym(k),itorbi(k))=k
      enddo
      do k=1,noca0
         if(itype(k).eq.1) then
            ninac=ninac+1
            numina(ninac)=k
            numinb(ninac)=k+norb
            nts(itsym(k))=nts(itsym(k))+1
         else
            ncs(itsym(k))=ncs(itsym(k))+1
         endif
      enddo
      do k=noca0+1,norb
         if(itype(k).eq.3) then
            nvirt=nvirt+1
            numvir(nvirt)=k
            numvib(nvirt)=k+norb
            nps(itsym(k))=nps(itsym(k))+1
         else
            ncs(itsym(k))=ncs(itsym(k))+1
         endif
      enddo
c calcul de isbrot pour le signe des elements de matrice
      n=0
      do k=1,ninac
         n=n+1
c        isbrot(n)=numina(k)
         isbrot(numina(k))=n
         itorbc(numina(k))=k
      enddo
      do k=1,noac
         n=n+1
c        isbrot(n)=numac(k)
         isbrot(numac(k))=n
         itorbc(numac(k))=k
      enddo
      do k=1,nvirt
         n=n+1
c        isbrot(n)=numvir(k)
         isbrot(numvir(k))=n
         itorbc(numvir(k))=k
      enddo
      do k=1,norb
         itorbs(isbrot(k))=k
      enddo
      ntstot(0)=0
      npstot(0)=0
      ncstot(0)=0
      do k=1,nsym
         ntstot(k)=ntstot(k-1)+nts(k)
         npstot(k)=npstot(k-1)+nps(k)
         ncstot(k)=ncstot(k-1)+ncs(k)
      enddo
      write(6,*)' '
      write(6,*)'================================================ '
      write(6,*)' '
      if(nprint.ge.1) then
      write(6,*)' '
      write(6,*)'===ORBITALES OCCUPEES, ACTIVES, VIRTUELLES==='
      write(6,1)'inactives   ',ninac,'  ',(numina(k),k=1,ninac)
      write(6,1)'actives     ',noac,'  ',(numac(k),k=1,noac)
      write(6,1)'virtuelles  ',nvirt,'  ',(numvir(k),k=1,nvirt)
      endif
      write(6,*)'nombre d''orbitales par symetrie'
      write(6,2)'occupees    ',(nts(k),k=1,nsym)
      write(6,2)'CAS         ',(ncs(k),k=1,nsym)
      write(6,2)'virtuelles  ',(nps(k),k=1,nsym)
      write(6,2)'total       ',(norbs(k),k=1,nsym)
      if(nprint.ge.2) then
         write(6,2)'itorbi      ',(itorbi(k),k=1,norb)
         write(6,2)'isbrot      ',(isbrot(k),k=1,norb)
         write(6,2)'itorbs      ',(itorbs(k),k=1,norb)
         write(6,2)'itorbc      ',(itorbc(k),k=1,norb)
         write(6,2)'ntstot occupees    ',(ntstot(k),k=1,nsym)
         write(6,2)'ncstot CAS         ',(ncstot(k),k=1,nsym)
         write(6,2)'npstot virtuelles  ',(npstot(k),k=1,nsym)
      endif
 1    format(1x,a12,i4,a3,20i4,/,12(20x,20i4))
 2    format(1x,a12,10(20i4,/))
c---------
      write(6,*)'===================================================='
      write(6,*)''
      write(6,*)''
      return
      end
