      subroutine gencas
      implicit real*8(a-h,o-x,z),logical*1 (y)
      parameter(maxorb=500,maxsym=8)
      parameter(maxorbcas=16,maxdetc=12870,idicmr=35000)
      parameter (idirac2=2000)
      common/opt/ihab,calcul
      character*3 calcul
      common /det/ndet,mdet(50)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/sy2/nts(maxsym),ncs(maxsym),nps(maxsym)
     *,norbs(maxsym)
      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
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      common/util/jsp(-2:2,-2:2),ksp(-4:4)
      common/mxdetc/maxc(-2:2,maxsym,-2:2),
     *maxca(-2:2,maxsym,maxsym,-2:2)
      common/mr3/ maxcmr(-2:2,maxsym,-2:2),mixtpmr(idicmr)
     *,ndetc,ndetc0,iadrc_mr(idicmr)
      dimension nsa(maxorbcas,maxdetc)
      dimension ica(maxorbcas)
      common /adrsym/irangs(maxdetc,0:maxorbcas)
     *,maxs(maxsym,0:maxorbcas)
      common/gd/ melc(5),nmelc
      common /cr/ mxstra(0:maxorbcas),mxstrb(maxsym,0:maxorbcas)
     *,nxstra(0:maxorbcas),nxstrb(maxsym,0:maxorbcas)
     *,kadra(idirac2),kadrb(idirac2),ksymca(idirac2)
     *,kok1a(idirac2),kok2a(idirac2),kok1b(idirac2),kok2b(idirac2)
     *,kkdeb1a(idirac2),kkdeb2a(idirac2)
     *,kkdeb1b(idirac2),kkdeb2b(idirac2)
     *,kkfin1a(idirac2),kkfin2a(idirac2)
     *,kkfin1b(idirac2),kkfin2b(idirac2)
     *,nnok1a,nnok1b,nnok2a,nnok2b,ndetca,ndetcb
     *,ksgnca(idirac2),ksgncb(idirac2)
     *,yimpca(maxorbcas,idirac2),yimpcb(maxorbcas,idirac2)
     *,ydetca(maxorbcas,idirac2),ydetcb(maxorbcas,idirac2)
c     *,yok1a(idirac2),yok2a(idirac2),yok1b(idirac2),yok2b(idirac2)
      common/pr/nprint,mprint(10)
      yw=.false.
      yw1=.false.
      if(gener(1:2).eq.'MR') return
c
c--   calcul de maxcmr (=maxc cumules)
      mxcmr=0
      do k=-2,2
         do is=1,nsym
            do l=-2,2
               maxcmr(l,is,k)=mxcmr
               mxcmr=mxcmr+maxc(l,is,k)
               if(maxc(l,is,k).ne.0.and.nprint.ge.1)
     *         write(6,'(a38,3i4,2i10)')
     *         ' dans gencas nelc,is,ispc,maxcmr,maxc',
     *         l,is,k, maxcmr(l,is,k),maxc(l,is,k)
            enddo
         enddo
      enddo
      if(gener.eq.'MR') then
         print*,'valeur min de idicmr',maxcmr(2,nsym,2)+mxcmr
         if(mxcmr.gt.idicmr) then
            write(6,*)'stop augmenter idicmr   idicmr=',idicmr
     *      ,'  val min',mxcmr
            stop
         endif
      endif
c
c           -----------------------------------
c             GENERATION DES STRINGS ALPHA DU CAS
c           -----------------------------------
c
c     boucle sur le nombre d'electrons
      mstri=0
      do 200 nca=max0(0,nca0-2),min0(nca0+2,noac)
      if(yw)print*,'nca',nca
      call combin(nsa,noac,nca,na,maxorbcas,maxdetc)
      na0=na
      if(yw)write(6,*)'na',na
      mxstra(nca)=mstri
c--   boucle sur les strings
c     print*,'ia',ia
      nstri=0
      do 210 ia=1,na
      isca=1
      do k=1,nca
         ica(k)=numac(nsa(k,ia))
         isca=its(isca,itsym(ica(k)))
      enddo
      mstri=mstri+1
      nstri=nstri+1
      if(yw)write(6,*)'a (nsa(k,ia),k=1,nca)',(nsa(k,ia),k=1,nca)
      call rang2(nca,nsa(1,ia),iranga)
      iadra=irangs(iranga,nca)
      jadra=iranga+mxstra(nca)
      if(yw)print*,'iranga,iadra,jadra',iranga,iadra,jadra
      call verdim('gencas idirac2 trop petit jadra idirac2',
     *jadra,idirac2)
      kadra(jadra)=iadra
      ksymca(jadra)=isca
      if(yw1) then
         write(75,*)'CAS',(ica(k),k=1,nca),'...',
     *   ', isca,nca',isca,nca,' iadra',iadra,' iranga',iranga,
     *   '  adr',jadra,'$'
         call scril
      endif
c--   determinant en occupation
      do k=1,noac
         ydetca(k,jadra)=.false.
      enddo
      do k=1,nca
         ydetca(nsa(k,ia),jadra)=.true.
      enddo
c--   nombre d'electrons a gauche de l'orbitale k
      nn=0
      do k=1,noac
         if(ydetca(k,jadra)) nn=nn+1
         yimpca(k,jadra)=mod(nn,2).eq.1
      enddo
      if(yw) then
         print*,'nsa',(nsa(k,ia),k=1,nca)
         print*,'ydetca  ',(ydetca(k,jadra),k=1,noac)
         print*,'yimpca   ',(yimpca(k,jadra),k=1,noac)
      endif
 210  continue
      nxstra(nca)=nstri
      if(yw)print*,'isca,nca,nstri,mstri',isca,nca,nstri,mstri
 204  continue
 200  continue
c
c           -----------------------------------
c             GENERATION DES STRINGS BETA DU CAS
c           -----------------------------------
c
      if(yw) print*,'GENERATION DES STRINGS BETA DU CAS'
c     boucle sur le nombre d'electrons
      mstri=0
      do 100 ncb=max0(0,ncb0-2),min0(ncb0+2,noac)
      if(yw)print*,'ncb',ncb
      call combin(nsa,noac,ncb,na,maxorbcas,maxdetc)
      na0=na
      if(yw)write(6,*)'na',na
c--   boucle sur la symetrie du string
      do 104 iscb0=1,nsym
      mxstrb(iscb0,ncb)=mstri
      if(yw)print*,'gencas iscb0,ncb,mxstrb',iscb0,ncb,mxstrb(iscb0,ncb)
      if(yw)print*,'iscb0',iscb0
c--   boucle sur les strings
c     print*,'ia',ia
      nstri=0
      do 110 ia=1,na
      iscb=1
      do k=1,ncb
         ica(k)=numac(nsa(k,ia))
         iscb=its(iscb,itsym(ica(k)))
      enddo
      if(iscb0.ne.iscb) goto 110
      mstri=mstri+1
      nstri=nstri+1
      if(yw)write(6,*)'a (nsa(k,ia),k=1,ncb)',(nsa(k,ia),k=1,ncb)
      call rang2(ncb,nsa(1,ia),iranga)
      iadra=irangs(iranga,ncb)
      jadra=iadra+mxstrb(iscb0,ncb)
      if(yw)print*,'iranga,iadra,jadra',iranga,iadra,jadra
      call verdim('gencas idirac2 trop petit jadra idirac2',
     *jadra,idirac2)
      kadrb(jadra)=iadra
      if(yw1) then
         write(75,*)'CAS',(ica(k),k=1,ncb),'...',
     *   ', iscb,ncb',iscb,ncb,' iadra',iadra,' iranga',iranga,
     *   '  adr',jadra,'$'
         call scril
      endif
c--   determinant en occupation
      do k=1,noac
         ydetcb(k,jadra)=.false.
      enddo
      do k=1,ncb
         ydetcb(nsa(k,ia),jadra)=.true.
      enddo
c--   nombre d'electrons a gauche de l'orbitale k
      nn=0
      do k=1,noac
         if(ydetcb(k,jadra)) nn=nn+1
         yimpcb(k,jadra)=mod(nn,2).eq.1
      enddo
      if(yw) then
         print*,'nsa',(nsa(k,ia),k=1,ncb)
         print*,'ydetcb  ',(ydetcb(k,jadra),k=1,noac)
         print*,'yimpcb   ',(yimpcb(k,jadra),k=1,noac)
      endif
 110  continue
      nxstrb(iscb0,ncb)=nstri
c      print*,'gencas iscb0,ncb,nxstrb',iscb0,ncb,nxstrb(iscb0,ncb)
      if(yw)print*,'iscb0,ncb,nstri,mstri',iscb0,ncb,nstri,mstri
 104  continue
 100  continue
      ndetca=mxstra(min0(nca0+2,noac))+nxstra(min0(nca0+2,noac))
      ndetcb=mxstrb(nsym,min0(ncb0+2,noac))
     *+nxstrb(nsym,min0(ncb0+2,noac))
c     print*,'ndetca,ndetcb',ndetca,ndetcb
      return
      end
