      subroutine genmr
      implicit real*8(a-h,o-x,z),logical*1 (y)
      parameter(maxorb=1024,nsymz=8)
      parameter(maxorbcas=16,maxdetc=12870)
      parameter (maxref=15000)
      common/occ/noac,nelac,numac(maxorbcas),is0,ninac,nvirt
     *,numt(maxorb),nump(maxorb),ntac,nutac(maxorbcas),ms2
      common/f4/norb,noc,noca,nocb,nca0,ncb0,ydet,ydetv,ydetcl
     *,ydetsc,yf_act,ywcas,ynosym,ytp0
      common/det/msto,nsto,mstov,nstov,idet(2400),nex(100),
     *long(maxorbcas+2),imono,ndet,msto256,
     *ncfmin,ncfmax
      common/util/jsp(-2:2,-2:2),ksp(-4:4)
      common/mr/nmr,nel,yref(-maxorb:maxorb,maxref)
      common/sym/nsym,its(nsymz,nsymz),itsym(maxorb)
      dimension nsa(maxorbcas,maxdetc)
      dimension nsb(maxorbcas,maxdetc)
      dimension ica(maxorbcas),icb(maxorbcas),
     *ita(2),itb(2),ipa(2),ipb(2)
      dimension it(20),ip(20),melc(5)
      dimension jt(20),jp(20)
      dimension iispc(5)
      character*8 gener
      common/gene/gener,ygcas,ygmono,ygmr
      common/print/nprint
      dimension nmf(maxorbcas),nmo(maxorbcas)
      dimension jlibreo(maxorbcas)
      dimension ns1(maxorbcas+4)
      dimension iocca(maxorbcas)
      dimension ys1(maxorbcas+4)
      data melc /0,1,-1,2,-2/
      yw=.false.
      ndet=0
      ndetc=0
      if(ywcas)open(29,file='ESCASOU0',status='unknown')
      do 1 kelc=1,5
      if(yw)write(6,*)'kelc',kelc
      if(ygmono.and.kelc.ge.4) goto 1
      if(ygcas.and.kelc.ge.2) goto 1
      nelc=melc(kelc)
      nelcas=nelac+nelc
      if(yw)print*,'nelc,nelcas',nelc,nelcas
c
c           -----------------------------------
c             GENERATION DU CAS
c           ----------------------------------
c
c     ncfmina,ncfmaxa min et max du nombre de CF a ajouter
      iplus=2
      if(ygcas) iplus=0
      if(ygmono) iplus=1
      imoins=iplus
      if(ninac.eq.0) iplus=0
      if(nvirt.eq.0) imoins=0
      ncfmaxa=min(noac,(nelcas+iplus)/2)
      ncfmaxa=min(ncfmax,ncfmaxa)
      ncfmina=max(0,nelcas-imoins-noac)
      ncfmina=max(ncfmin,ncfmina)
c
c     boucles sur le nombre de CF et CO rajoutees au CAS
c
      do 10 ncfc=ncfmina,ncfmaxa
      ncomaxa=min(noac-ncfc,nelcas+iplus-ncfc*2)
      if(yw)print*,'nelcas,ncfc',nelcas,ncfc
      ncomina=max(0,nelcas-imoins-ncfc*2)
      if(yw)print*,'ncfc,ncomina,ncomaxa',ncfc,ncomina,ncomaxa
c      do 11 ncouva=ncomina,ncomaxa
      ncouva=nelcas-ncfc*2
      if(yw)print*,'ncfc,ncouva',ncfc,ncouva
c      nc100=ncfc+ncfc+ncouva
c      if(yww)print*,'nc100',nc100
c      if(nc100.lt.nelcas-imoins) goto 11
c      if(nc100.gt.nelcas+iplus) goto 11
      if(ncouva.lt.ncomina.or.ncouva.gt.ncomaxa) goto 11
      call combi0(nmf,noac,ncfc,iretf)
      goto 300
 25   call combi2(nmf,noac,ncfc,iretf)
 300  continue
      do l=1,noac
         iocca(l)=0
      enddo
      do l=1,ncfc
         iocca(nmf(l))=2
      enddo
      mlibreo=0
      do l=1,noac
         if(iocca(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
      do l=1,ncouva
         iocca(jlibreo(nmo(l)))=1
      enddo
      if(yw) then
         write(75,*)'1iocca',(iocca(k),k=1,noac),'$'
         call scril
      endif
      mint=0
      minp=0
      maxt=2
      maxp=2
c            call mr2sbis(nca,ncb,ica,icb,mint,minp,
      call mr2sbis(iocca,mint,minp,
     *maxt,maxp)
      if(yw)print*,'mint,minp',mint,minp
      if(yw)print*,'maxt,maxp',maxt,maxp
      isc=1
      do k=1,noac
         if(iocca(k).eq.1) isc=its(isc,itsym(numac(k)))
      enddo
c      maxt=0
c      maxp=0
c
c              -----------------------------------
c                GENERATION DES TROUS
c              ----------------------------------
c
      do 4 nt=mint,maxt
      if(ygcas.and.nt.ne.0) goto 4
      if(ygmono.and.nt.eq.2) goto 4
      np=nt-nelc
      if(ygmono.and.np.eq.2) goto 4
      if(yw)write(6,*)'nt,np',nt,np
      if(np.gt.maxp) goto 4
      if(np.lt.minp) goto 4
      if(gener(5:8).eq.'DDC2') then
         if(nt.ge.2.and.np.ge.1) goto 4
         if(nt.ge.1.and.np.ge.2) goto 4
      else if(ygmono) then
         if(nt.gt.1.or.np.gt.1) goto 4
      endif
      if(nt.eq.2.and.np.eq.2) then
         if(gener(5:8).eq.'DDCI')  goto 4
      endif
      if(yw)print*,'apres goto 4'
      if(nt.eq.0) then
         ifint1=1
         ifint2=1
      else if(nt.eq.1) then
         ifint1=ninac
         ifint2=1
      else if(nt.eq.2) then
         ifint1=ninac
         ifint2=ninac
      endif
      do 21 it1=1,ifint1
      if(nt.le.1) then
         idebt2=1
         ifint2=1
      else if(nt.eq.2) then
         idebt2=it1
         ifint2=ninac
      endif
      if(yw)print*,'idebt2,ifint2',idebt2,ifint2
      do 22 it2=idebt2,ifint2
      ist=1
      if(nt.ge.1) ist=itsym(numt(it1))
      if(nt.ge.2) ist=its(itsym(numt(it2)),ist)
      if(yw)print*,'ist',ist
      if(nt.eq.2) then
         if(it1.eq.it2) then
            ncfo=1
            ncoo=0
         else
            ncfo=0
            ncoo=2
         endif
      else
         ncfo=nt
         ncoo=nt
      endif
      jt(1)=numt(it1)
      jt(2)=numt(it2)
c
c                          -----------------------------------
c                            GENERATION DES PARTICULES
c                          ----------------------------------
c
      isct=its(isc,ist)
      if(yw)write(6,*)'np,isc,ist,isct',np,isc,ist,isct
      if(np.eq.0.and.isct.ne.is0.and..not.ynosym) goto 22
      isp=its(is0,isct)
      if(yw)print*,'isp',isp
      if(np.eq.0) then
         ifinp1=1
         ifinp2=1
         idebp2=1
      else if(np.eq.1) then
         ifinp1=nvirt
         ifinp2=1
      else if(np.eq.2) then
         ifinp1=nvirt
         ifinp2=nvirt
      endif
      do 23 ip1=1,ifinp1
      if(np.eq.1) then
         idebp2=1
         ifinp2=1
      else if(np.eq.2) then
         idebp2=ip1
         ifinp2=nvirt
      endif
      do 24 ip2=idebp2,ifinp2
      isp1=1
      if(np.ge.1) isp1=itsym(nump(ip1))
      if(np.ge.2) isp1=its(itsym(nump(ip2)),isp1)
      if(yw)print*,'isp,isp1',isp,isp1
      if(isp.ne.isp1) goto 24
      if(np.eq.2) then
         if(ip1.eq.ip2) then
            ncfv=1
            ncov=0
         else
            ncfv=0
            ncov=2
         endif
      else
         ncfv=np
         ncov=np
      endif
      jp(1)=nump(ip1)
      jp(2)=nump(ip2)
      if(yw)print*,'jp',(jp(k),k=1,np)
c
c                          ---------------------------
c                            GENERATION DES SPINS
c                          ---------------------------
c
c     nombre total de couches ouvertes
      nco=ncoo+ncouva+ncov
      if(yw)print*,'nco,ncoo,ncov,ncouva',nco,ncoo,ncov,ncouva
      nela=(nco+ms2)/2
      nelb=(nco-ms2)/2
      if(nela.lt.0) stop'nela=0'
      if(nelb.lt.0) stop'nelb=0'
      if(nt.eq.0) then
         nta=0
         ntb=0
      endif
      if(np.eq.0) then
         npa=0
         npb=0
      endif
      if(nt.eq.2.and.it1.eq.it2) then
         nta=1
         ntb=1
         ita(1)=jt(1)
         itb(1)=jt(2)
      endif
      if(np.eq.2.and.ip1.eq.ip2) then
         npa=1
         npb=1
         ipa(1)=jp(1)
         ipb(1)=jp(2)
      endif
      do k=1,nco
         ys1(k)=.false.
      enddo
      call combi0(ns1,nco,nela,iretsp)
      goto 500
 66   call combi2(ns1,nco,nela,iretsp)
 500  continue
      if(yw)print*,'ns1',(ns1(k),k=1,nela)
      do k=1,nela
         ys1(ns1(k))=.true.
      enddo
      if(ncoo.ne.0) then
         nta=0
         ntb=0
         do k=1,nt
            if(ys1(k)) then
               ntb=ntb+1
               itb(ntb)=jt(k)
            endif
         enddo
         do k=1,nt
            if(.not.ys1(k)) then
               nta=nta+1
               ita(nta)=jt(k)
            endif
         enddo
      endif
      if(yw)print*,'jp',(jp(k),k=1,np)
      if(ncov.ne.0) then
         npa=0
         npb=0
         do k=1,np
            if(ys1(nco+k-np)) then
               npa=npa+1
               ipa(npa)=jp(k)
            endif
         enddo
         do k=1,np
            if(.not.ys1(nco+k-np)) then
               npb=npb+1
               ipb(npb)=jp(k)
            endif
         enddo
      endif
      if(yw)print*,'nt,np,nta,ntb,npa,npb',nt,np,nta,ntb,npa,npb
      if(yw)print*,'ys1',(ys1(k),k=1,nco)
      nca=0
      ncb=0
      kk=ncoo
      do k=1,noac
         if(iocca(k).eq.1) then
            kk=kk+1
            if(ys1(kk)) then
               nca=nca+1
               ica(nca)=numac(k)
            else
               ncb=ncb+1
               icb(ncb)=numac(k)
            endif
         else if(iocca(k).eq.2) then
            nca=nca+1
            ica(nca)=numac(k)
            ncb=ncb+1
            icb(ncb)=numac(k)
         endif
      enddo
      ndet=ndet+1
      if(yw)print*,'ica',(ica(k),k=1,nca)
      if(yw)print*,'icb',(icb(k),k=1,ncb)
      if(nt.eq.0.and.np.eq.0) ndetc=ndetc+1
      if(yw.or.nprint.ge.3)
     *call wrdet(nca,ncb,ica,icb,nta,ntb,ita,
     *itb,npa,npb,ipa,ipb)
      call wrcas(nca,ncb,ica,icb,nta,ntb,ita,
     *itb,npa,npb,ipa,ipb)
      call tradnv
     *(nca,ncb,ica,icb,nta,ntb,ita,
     *itb,npa,npb,ipa,ipb,it,ip)
      do k=1,nela
         ys1(ns1(k))=.false.
      enddo
      if(iretsp.eq.0) goto 66
 24   continue
 23   continue
 22   continue
 21   continue
 4    continue
      do k=1,noac
         if(iocca(k).eq.1) iocca(k)=0
      enddo
      if(ireto.eq.0) goto 26
      if(iretf.eq.0) goto 25
 11   continue
 10   continue
 1    continue
      print*,' '
      write(6,*)'****************************************************'
      write(6,*)'***********      fin de casdet    ******************'
      write(6,*)' nombre de determinants generes             ',ndet
      write(6,*)' parmi ces determinants :                   '
      write(6,*)' nombre de determinants appartenant au CAS  ',ndetc
      if(gener(1:3).eq.'SEL')
     *write(6,*)' nombre de determinants MR                  ',nmr
      write(6,*)'****************************************************'
      return
      end
