      subroutine genper
      implicit real*8(a-h,o-x,z),logical*1 (y)
      parameter(maxorb=1024,nsymz=8)
      parameter(maxorbcas=16)
      character*8 gener
      common/occ/noac,nelac,numac(maxorbcas),is0,ninac,nvirt
     *,numt(maxorb),nump(maxorb),ntac,nutac(maxorbcas),ms2
      common/gene/gener,ygcas,ygmono,ygmr
      common/det/msto,nsto,mstov,nstov,idet(2400),nex(100),
     *long(maxorbcas+2),imono,ndet,msto256,
     *ncfmin,ncfmax
      common/f4/norb,noc,noca,nocb,nca0,ncb0,ydet,ydetv,ydetcl
     *,ydetsc,yf_act,ywcas,ynosym,ytp0
      common/sym/nsym,its(nsymz,nsymz),itsym(maxorb)
      dimension iocca(maxorbcas),iocca0(maxorbcas)
      dimension nmf(maxorbcas),nmo(maxorbcas)
      dimension jlibreo(maxorbcas)
      character*80 ll
      character*100000 namel1
      dimension ic(maxorbcas*2)
      common/selm/iselm
      yw=.false.
      yw1=.false.
c      
      iselm=1
      gener(1:4)='SEL+'
      print*,' '
      print*,'======================='
      print*,'GENERATION PERTURBATIVE'
      print*,'======================='
      print*,'GENer',gener
c
c           -----------------------------------
c             GENERATION DU CAS
c           ----------------------------------
c
c     ncfmina,ncfmaxa min et max du nombre de CF a ajouter
      nnn=0
      ncas=0
      iplus=2
c      
      rewind 45
      rewind 94
      call LECNAM('&COST_AO',namel1,45,ierr,0)
      call nameli(namel1,its(1,1),'ITS',4)
      rewind 45
      call LECNAM('&COST_MO',namel1,45,ierr,0)
      call nameli(namel1,noc,'NOC',4)
      call nameli(namel1,NORB,'NORB',4)
      call nameli(namel1,itsym(1),'ITSYM',4)
      noca=noc-(-ms2+1)/2
      nocb=noc-ms2/2
      ninac=noc-(nelac+1)/2
      nvirt=norb-noac-ninac
c      
      if(ygcas) iplus=0
      if(ygmono) iplus=1
      imoins=iplus
      if(ninac.eq.0) iplus=0
      if(nvirt.eq.0) imoins=0
      iplus=0
      imoins=0
      ncfmaxa=min(noac,(nelac+iplus)/2)
      ncfmaxa=min(ncfmax,ncfmaxa)
      ncfmina=max(0,nelac-imoins-noac)
      ncfmina=max(ncfmin,ncfmina)
      rewind 1
      if(yw)print*,
     *'ncfmina,ncfmaxa,iplus',ncfmina,ncfmaxa,iplus,noac,ninac
      if(yw)print*,'noac,ninac,nvirt,imoins',noac,ninac,nvirt,imoins
      if(yw)print'('' ygcas'',l2)',ygcas
c
c     boucles sur le nombre de CF et CO rajoutees au CAS
c
      do 10 ncfc=ncfmina,ncfmaxa
      ncomaxa=min(noac-ncfc,nelac+iplus-ncfc*2)
      if(yw)print*,'ncfc',ncfc
      ncomina=max(0,nelac-imoins-ncfc*2)
      if(yw)print*,'ncfc,ncomina,ncomaxa',ncfc,ncomina,ncomaxa
      do 11 ncouva=ncomina,ncomaxa
      if(yw)print*,'ncfc,ncouva',ncfc,ncouva
c     on repartit les couches fermees
      call combi0(nmf,noac,ncfc,iretf)
      if(yw)print*,'nmf0',(nmf(k),k=1,noac)
      goto 300
 25   call combi2(nmf,noac,ncfc,iretf)
 300  continue
      if(yw)print*,'nmf',(nmf(k),k=1,noac)
      do l=1,noac
         iocca0(l)=0
      enddo
      do l=1,ncfc
         iocca0(nmf(l))=2
      enddo
c     on repartit les couches ouvertes
      mlibreo=0
      do l=1,noac
         if(iocca0(l).ne.2) then
            mlibreo=mlibreo+1
            jlibreo(mlibreo)=l
         endif
      enddo
      call combi0(nmo,mlibreo,ncouva,ireto)
      goto 400
 26   call combi2(nmo,mlibreo,ncouva,ireto)
 400  continue
      nnn=nnn+1
      ncas=ncas+1
      if(yw)print*,'nnn,ncas',nnn,ncas
!      if(nnn.gt.1024) then
!         nnn=1
!         if(yw)print*,'ecriture 40'
!         write(40)((iocca(k,l),k=1,noac),l=1,1024)
!      endif
      do l=1,noac
         iocca(l)=iocca0(l)
      enddo
      do l=1,ncouva
         iocca(jlibreo(nmo(l)))=1
      enddo
c     formation de la namelist &mr
      ll(1:5)=' &mr '
      kk=0
      is=1
      do k=1,noac
         do l=1,iocca(k)
            kk=kk+1
            ic(kk)=numac(k)
            is=its(is,itsym(ic(kk)))
            if(yw)print*,'kk,ic',kk,ic(kk)
         enddo
      enddo
c      is=1
c      do k=1,noac
c         is=its(is,itsym(ic(k)))
c      enddo
      if(yw)print*,'is,is0',is,is0
      if(is.ne.is0) goto 32
      if(yw1) then
         write(75,*)'1iocca',(iocca(k),k=1,noac),'$'
         call scril
         write(75,*)'ic',(ic(k),k=1,kk),'$'
         call scril
      endif
      do k=6,80
         ll(k:k)=' '
      enddo
      if(kk.eq.0) then
         ll(7:7)='/'
         write(1,'(a80)') ll
!         write(6,'(a80)') ll
      else if(kk.le.16) then
         write(ll(6:80),'(''ic='',16(i3,'',''))') (ic(k),k=1,kk)
         ll(4*kk+10:4*kk+10)='/'
         write(1,'(a80)') ll
!         write(6,'(a80)') ll
      else
         write(ll(6:80),'(''ic='',16(i3,'',''))') (ic(k),k=1,16)
         write(1,'(a80)') ll
!         write(6,'(a80)') ll
         do k=1,75
            ll(k:k)=' '
         enddo
         write(ll(2:80),'(16(i3,'',''))') (ic(k),k=16,kk)
         ll(4*kk+10:4*kk+10)='/'
         write(1,'(a80)') ll
!         write(6,'(a80)') ll
      endif
c
 32   continue
      if(ireto.eq.0) goto 26
      if(iretf.eq.0) goto 25
 11   continue
 10   continue
      print*,'======================='
      return
      end
