      subroutine gendet(nsa,nsb,iadrr,io1,io2,ispo1,ispo2,kdet
     *,inddet,mh,mt)
      use mod_ndimcs0
      implicit real*8(a-h,o-x,z),logical*1 (y)
      parameter(maxsym=8)
      include 'maxorb.prm'
      parameter(maxorbcas=16,maxdetc=12870,idicmr=35000)
c
c    |-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|
c    |      iadrr    |  mh   |  mt   |
c
      common/dim/iadri ; integer(8) iadri
      dimension nsa(maxorbcas,maxdetc)
      dimension nsb(maxorbcas,maxdetc)
      dimension iadrr(iadri*2),mh(iadri),mt(iadri)
c
      common/opt/ihab,calcul
      character*3 calcul
      common /det/ndet,mdet(50),nbdet_cas
      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/mr3/ maxcmr(-2:2,maxsym,-2:2),mixtpmr(idicmr)
     *,ndetc,ndetc0,iadrc_mr(idicmr)
      dimension iocc(maxorbcas),ica(maxorbcas),icb(maxorbcas),
     *ita(2),itb(2),ipa(2),ipb(2),it(2),ip(2)
      dimension iispc(5)
      common/gd/ melc(5),nmelc
      common /adrcs/ ces(0:maxorbcas,0:maxorbcas),idimcs
      integer ces
      dimension ic1(maxorbcas)
      common/test/itest(100)
      common/igen/ igener
 
c      data melc /0,1,-1,2,-2/
      yw=.false.
      yw1=.false.
      max_adr=iadri*4
c
      do k=1,norb
      enddo
      if(ispo1.eq.1) then
      else
      endif
      if(ispo2.eq.1) then
c         yoca(io2)=.true.
      else
c         yocb(io2)=.true.
      endif
c      iso=its(itsym(io1),itsym(io2))
c
c-----on commence a remplir les trous et part
c
      mta=0
      mtb=0
      mpa=0
      mpb=0
      ist0=1
      isp0=1
      if(itype(io1).eq.1) then
         ist0=itsym(io1)
         if(ispo1.eq.1) then
            mta=mta+1
            ita(mta)=io1
         else
            mtb=mtb+1
            itb(mtb)=io1
         endif
      else if(itype(io1).eq.3) then
         isp0=itsym(io1)
         if(ispo1.eq.1) then
            mpa=mpa+1
            ipa(mpa)=io1
         else
            mpb=mpb+1
            ipb(mpb)=io1
         endif
      endif
      if(itype(io2).eq.1) then
         ist0=its(ist0,itsym(io2))
         if(ispo2.eq.1) then
            mta=mta+1
            ita(mta)=io2
         else
            mtb=mtb+1
            itb(mtb)=io2
         endif
      else if(itype(io2).eq.3) then
         isp0=its(isp0,itsym(io2))
         if(ispo2.eq.1) then
            mpa=mpa+1
            ipa(mpa)=io2
         else
            mpb=mpb+1
            ipb(mpb)=io2
         endif
      endif
      nto=mta+mtb
      npo=mpa+mpb
      nin=2-nto
      nvi=2-npo
      ispt0=mta-mtb
      ispp0=mpa-mpb
c
c-----nin et nvi sont les nombres d'inactives et de virtuelles a remplir
c-----nto et npo sont les nombres de trous et part deja occupes
c-----ispt0 et ispp0 sont les spins de depart des T et P
c
      if(yw)print*,'nin,nvi',nin,nvi
      if(yw)print*,'mta,mtb,mpa,mpb',mta,mtb,mpa,mpb
c      print*,'ita,itb,ipa,ipb',(ita(k),k=1,mta),(ipa(k),k=1,mpa),
c     * (itb(k),k=1,mtb),(ipb(k),k=1,mpb)
c
c           -----------------------------------
c             GENERATION DU CAS
c           ----------------------------------
c
       yw=.false.
!      Dans certains cas, on va generer des det ou le nb de couches
!      ouvertes dans le CAS est trop petit pour etre augmente dans
!      les TP jusqu'a abs(ms2), qui est la valeur min pour le det.
      min_nb_co_in_det=abs(ms2)
      if(igener==1.or.igener==2) then 
         min_nb_co_in_cas=min_nb_co_in_det-2
      else
         min_nb_co_in_cas=min_nb_co_in_det-igener
      endif

c     boucle sur le nombre d'electrons du CAS
      do 1 kelc=1,nmelc
      nelc=melc(kelc)
      nelcas=nelac+nelc
c        nelcas est le nombre total d'electrons du CAS
c         ipasc=1
c         if(nelc.eq.1.or.nelc.eq.-1) ipasc=2
c        boucle sur le spin du CAS
      call vispc(nelc,nispc,iispc,gener)
      if(yw)write(6,*)'nelc,nelcas,nispc',nelc,nelcas,nispc
      if(yw)write(6,*)'iispc',iispc
      do 3 ii=1,nispc
      ispc1=iispc(ii)
c         do 3 ispc1=-1,1,ipasc
      ispc=jsp(ispc1,nelc)
      ispcas=ms2+ispc
c           ispc est le spin relatif du CAS
c           ispcas est le spin total du CAS
      if(yw)write(6,*)'ms2,ispc,ispcas',ms2,ispc,ispcas
      if(iabs(ispcas).gt.nelcas) goto 3
      nca=(nelcas+ispcas)/2
      if(nca.lt.0) goto 3
      ncb=(nelcas-ispcas)/2
      if(inddet.eq.28)isgnc=1-2*mod(nca,2)
      if(inddet.eq.29)isgnc=1-2*mod(ncb,2)
      !if(yw)write(6,*)'isgnc',isgnc
      if(yw)write(6,*)'nelc,nelcas,ispcas,nca,ncb',
     *nelc,nelcas,ispcas,nca,ncb
      if(nca.gt.noac.or.ncb.gt.noac) goto 3
      call combin(nsa,noac,nca,na,maxorbcas,maxdetc)
      call combin(nsb,noac,ncb,nb,maxorbcas,maxdetc)
      if(yw)write(6,*)'na,nb',na,nb
      do 10 ia=1,na
      isca=1
      do k=1,nca
c                  if(yw)
c     *            write(6,*)'ia,nsa(k,ia)',ia,(nsa(kk,ia),kk=1,nca)
         ica(k)=numac(nsa(k,ia))
         isca=its(isca,itsym(ica(k)))
      enddo
      do 11 ib=1,nb
      iscb=1
      do k=1,ncb
         if(yw)
     *   write(6,*)'ib,nsb(k,ib)',ib,(nsb(kk,ib),kk=1,ncb)
         icb(k)=numac(nsb(k,ib))
         iscb=its(iscb,itsym(icb(k)))
      enddo
      isc=its(isca,iscb)
      if(yw)
     *write(6,*)'CAS',(ica(k),k=1,nca),'   ',(-icb(k),k=1,ncb)
      if(yw)
     *write(6,*)'isc,ispcas,ispc,ispc1',isc,ispcas,ispc,ispc1
      if(gener.eq.'MR') then
         call adrc_mr(nca,ica,ncb,icb,iadrcas)
         call callim(mixtpmr(iadrcas),maxt1,maxp1,mint1,minp1)
         if(maxt1.lt.0) goto 11
         if(yw)write(6,'('' maxt1,maxp1,mint1,minp1,nin,nvi''
     *   ,6i4)')maxt1,maxp1,mint1,minp1,nin,nvi
      else if(gener(1:2).eq.'MR') then
         call tradmrs(iocc,nca,ica,ncb,icb)
         if(yw)print*,'iocc',(iocc(k),k=1,noac)
         ncouv=count(iocc(1:noac)==1)
         if(ncouv<min_nb_co_in_cas) cycle
         call adrcass(iocc,iadrs,ncf,nc1,ic1)
         if(yw)print*,'iadrs',iadrs
         mixtpmrs=ichar(tpmrs(iadrs))
         if(mixtpmrs==0) cycle
         if(yw)print*,'gendet mixtpmrs',mixtpmrs
         call sptxm(mint1,maxt1,minp1,mixtpmrs)
         if(yw)print*,'apres mixtpmrs',mixtpmrs
         if(mint1.gt.maxt1) goto 11
         maxp1=minp1+maxt1-mint1
         if(yw)write(6,'('' maxt1,maxp1,mint1,minp1,nin,nvi''
     *   ,6i4)')maxt1,maxp1,mint1,minp1,nin,nvi
      endif
 
c
c              -----------------------------------
c                GENERATION DES TROUS
c              -----------------------------------
c
c----         boucle sur le nombre de trous rajoutes
      do 4 nt=0,nin
      np=nt-nin-nelc+nvi
      if(yw)write(6,*)'nt,np',nt,np
c                np est le nombre de part rajoutees
      if(np.gt.nvi) goto 4
      if(np.lt.0) goto 4
      ntto=nt+nto
      nppo=np+npo
      if(gener(1:2).eq.'MR') then
         if(ntto.lt.mint1.or.ntto.gt.maxt1) goto 4
         if(nppo.lt.minp1.or.nppo.gt.maxp1) goto 4
      endif
c                ntto et nppo sont les nb de trous et part totaux
      if(yw) then
         write(6,*)'nt,np,ntto,nppo,gener,nin,nvi,isc,is0,ispc'
         write(6,*)nt,np,ntto,nppo,gener,nin,nvi,isc,is0,ispc
      endif
      if(gener.eq.'PERT'.or.gener.eq.'MR') then
         if(nt.eq.nin.and.np.eq.nvi) then
            if(isc.ne.is0) goto 4
            if(ispc.ne.0) goto 4
         endif
      endif
      if(gener.eq.'DDCI'.or.gener.eq.'DDci') then
         if(nt.eq.nin.and.np.eq.nvi) goto 4
      endif
      if(ygmono) then
         if(nt.ge.nin.or.np.ge.nvi) goto 4
      endif
      if(gener.eq.'DDC2') then
         if(nt.ge.nin-1.and.np.ge.nvi) goto 4
         if(nt.ge.nin.and.np.ge.nvi-1) goto 4
      endif
      if(yw)write(6,*)'ntto,nppo',ntto,nppo
      ipast=1
      if(ntto.eq.1) ipast=2
c---             boucle sur le spin total des trous
      do 6 ispt1=-1,1,ipast
      ispt=jsp(ispt1,ntto)
      if(yw)write(6,*)
     *'ispt1,ispt,ispo1,ispo2',ispt1,ispt,ispo1,ispo2
c                   quelques impossibilites :
      if(iabs(ispt-ispt0).gt.nin) goto 6
      if(nin.eq.0) then
         if(ispo1+ispo2.ne.ispt) goto 6
      endif
c---                ispt est le spin des ntto trous
      if(iabs(ispt).gt.ntto) goto 6
      if(yw)write(6,*)'ispt',ispt
c                   nta et ntb sont les nb de trous alpha et beta
      nta=(ntto+ispt)/2
      ntb=(ntto-ispt)/2
      ispp=ispt-ispc
      if(yw)write(6,*)'ispp',ispp
      if(yw)write(6,*)'ispp',iabs(ispp-ispp0),nvi
c---                ispp est le spin des nppo part
c                   quelques impossibilites :
      if(iabs(ispp-ispp0).gt.nvi) goto 6
      if(yw)write(6,*)'apres imp 1'
      if(nvi.eq.0) then
         if(ispo1+ispo2.ne.ispp) goto 6
      endif
      if(yw)write(6,*)'apres imp 2'
      if(iabs(ispp).gt.nppo) goto 6
      if(yw)write(6,*)'apres imp 3'
      npa=(nppo+ispp)/2
      npb=(nppo-ispp)/2
c                   npa et npb sont les nb de part alpha et beta
      if(yw)write(6,*)'nta,ntb,npa,npb',nta,ntb,npa,npb
      ispp1=ksp(ispp)
      ideb2=1
c----               1ere boucle sur les trous rajoutes
      if(nt.eq.0) then
         ifin1=1
         ifin2=1
      else
         ifin1=ninac
         ifin2=1
      endif
      if(yw)write(6,*)'ifin1',ifin1
      ist1=ist0
      mta1=0
      mtb1=0
      mpa1=0
      mpb1=0
      do 21 jt1=1,ifin1
      if(nt.eq.0) goto 27
      if(nta-mta.gt.0) then
         it1=numt(jt1)
         mta1=mta+1
         ita(mta1)=it1
      endif
      if(ntb-mtb.gt.0.and.nta-mta.eq.0) then
         it1=numt(jt1)
         mtb1=mtb+1
         itb(mtb1)=it1
c                           if(yw)print*,'mtb1,it1',mtb1,it1
      endif
      ist1=its(ist0,itsym(it1))
c----                   2eme boucle sur les trous rajoutes
      if(nt.eq.2) then
         ifin2=ninac
         if(ispt.ne.0) then
            ideb2=jt1+1
         else
            ideb2=1
         endif
      endif
c                        if(yw)write(6,*)'ideb2,ifin2',ideb2,ifin2
c                        if(nt.ge.1)ist=itsym(it1)
c                       print*,'ist1',ist1
 27   continue
      ist=ist1
      do 22 jt2=ideb2,ifin2
      if(nt.le.1) goto 28
      if(nta-mta1.gt.0) then
         it2=numt(jt2)
         mta2=mta1+1
         ita(mta2)=it2
      endif
c                           if(yw)print*,'nta,mta1,ntb,mtb1',
c     *                     nta,mta1,ntb,mtb1
      if(nta-mta1.eq.0.and.ntb-mtb1.gt.0) then
         it2=numt(jt2)
         mtb2=mtb1+1
         itb(mtb2)=it2
c                              if(yw)print*,'mtb2,it2',mtb2,it2
      endif
      ist=its(ist1,itsym(it2))
 28   continue
      kk=0
      do k=1,nta
         kk=kk+1
         it(kk)=ita(k)
      enddo
      do k=1,ntb
         kk=kk+1
         it(kk)=itb(k)
      enddo
      isgnt=1
      if(nta.eq.2)call reor(2,it,isgnt)
      if(ntb.eq.2)call reor(2,it,isgnt)
c                           if(nta.eq.2.or.ntb.eq.2)
c     *                     write(6,'('' gendet nta,ntb,it isgnt''
c     *                     2i5,1x,2i3,2x,2i5)')nta,ntb,it,isgnt
c                           if(nt.ge.2)ist=its(itsym(it1),itsym(it2))
c                          print*,'ist2',ist
      if(yw)
     *write(6,*)'TROU',(ita(k),k=1,nta),'   ',
     *(-itb(k),k=1,ntb)
      if(yw)write(6,*)'ist,ispt',ist,ispt
c
c                          -----------------------------------
c                            GENERATION DES PARTICULES
c                          ----------------------------------
c
      isct=its(isc,ist)
      if(yw)write(6,*)'np,isct,ispp',np,isct,ispp
      if(nppo.eq.0.and.isct.ne.is0) goto 22
      isp=its(is0,isct)
c---                       1ere boucle sur les part rajoutees
      ideb1p=1
      if(np.eq.0) then
         ifin1p=ideb1p
c                             mpa=1
c                             mpb=1
         ideb2p=1
         ifin2p=1
      else
         ifin1p=nvirt
      endif
      if(yw)write(6,*)'ideb1p,ifin1p',ideb1p,ifin1p
      isp1=isp0
      do 23 jp1=ideb1p,ifin1p
      if(yw)print*,'np,jp1',np,jp1
      if(np.eq.0) goto 25
      ip1=nump(jp1)
      if(yw)print*,'ip1,npa,mpa',ip1,npa,mpa
      if(npa-mpa.gt.0) then
         mpa1=mpa+1
         ipa(mpa1)=ip1
      endif
      if(yw)print*,'npa,mpa,npb,mpb',
     *npa,mpa,npb,mpb
      if(npb-mpb.gt.0.and.npa-mpa.eq.0) then
         mpb1=mpb+1
         ipb(mpb1)=ip1
         if(yw)print*,'mpb1,ipb(mpb1)'
     *   ,mpb1,ipb(mpb1)
      endif
      isp1=its(isp0,itsym(ip1))
c---                          2eme boucle sur les part rajoutees
      ideb2p=1
      ifin2p=ideb2p
      if(np.eq.2) then
         ifin2p=nvirt
         if(ispp.ne.0) ideb2p=jp1+1
      endif
 25   continue
      if(yw)
     *write(6,*)'ideb2p,ifin2p',ideb2p,ifin2p
      isp2=isp1
      do 24 jp2=ideb2p,ifin2p
      if(np.le.1) goto 26
      ip2=nump(jp2)
      if(npa-mpa1.gt.0) then
c                                    if(yoca(ip2)) goto 24
         mpa2=mpa1+1
         ipa(mpa2)=ip2
      endif
      if(npa-mpa1.eq.0.and.npb-mpb1.gt.0)then
c                                    if(yocb(ip2)) goto 24
         mpb2=mpb1+1
         ipb(mpb2)=ip2
      endif
      isp2=its(isp1,itsym(ip2))
 26   continue
c                                isgn=isgnt*isgnp
c                                 isp1=1
      if(yw)print*,'isp2,isp',isp2,isp
      if(isp2.ne.isp) goto 24
c                                if(its(itsym(ip1),itsym(ip2)).ne.isp)
c     *                           goto 24
      kdet=kdet+1
c      if(kdet.gt.max_adr) then
c         write(6,*)'kdet,max_adr',kdet,max_adr
c         stop 26
c      endif
c                                ---EPV ?
      iepv=0
      if(inddet.ge.7.and.inddet.le.14) then
         call tesepv(nta,ita,iepv)
         call tesepv(npa,ipa,iepv)
         call tesepv(ntb,itb,iepv)
         call tesepv(npb,ipb,iepv)
      endif
      if(inddet.ge.28.and.inddet.le.29) then
         call tesepv(nta,ita,iepv)
         call tesepv(npa,ipa,iepv)
         call tesepv(ntb,itb,iepv)
         call tesepv(npb,ipb,iepv)
      endif
      if(yw1) then
c                                    print*,'gendet appel wrdet'
         call wrdet
     *   (nca,ncb,ica,icb,nta,ntb,ita,
     *   itb,npa,npb,ipa,ipb)
         if(iepv.eq.1)print*,'EPV'
      endif
c                                 if(yw) then
c                                    write(75,*)nca,(ica(k),k=1,nca),'$'
c                                    call scril
c                                    write(75,*)ncb,(icb(k),k=1,ncb),'$'
c                                   call scril
c                                    write(75,*)nta,(ita(k),k=1,nta),'$'
c                                    call scril
c                                    write(75,*)ntb,(itb(k),k=1,ntb),'$'
c                                    call scril
c                                    write(75,*)npa,(ipa(k),k=1,npa),'$'
c                                     call scril
c                                    write(75,*)npb,(ipb(k),k=1,npb),'$'
c                                    call scril
c                                    write(6,*)'ispt,ispp',ispt,ispp
c                                 endif
      if(iepv.eq.1) then
         if(kdet.le.iadri*2)iadrr(kdet)=0
         goto 24
      endif
      kk=0
      do k=1,npa
         kk=kk+1
         ip(kk)=ipa(k)
      enddo
      do k=1,npb
         kk=kk+1
         ip(kk)=ipb(k)
      enddo
      isgnp=1
c                                 write(6,'('' gendet it ip ''
c     *                           ,2i3,2x,2i3,2x,2i5)')it,ip
      if(inddet.ge.32.and.inddet.le.39) then
         call gendec
     *   (nca,ica,ncb,icb,nta,ita,ntb,itb,
     *   npa,ipa,npb,ipb,iepv,inddet,iadr
     *   ,isgn)
         if(iepv.eq.1) then
            if(kdet.le.iadri*2)iadrr(kdet)=0
            goto 24
         endif
         goto 35
      endif
      if(npa.eq.2)call reor(2,ip,isgnp)
      if(npb.eq.2)call reor(2,ip,isgnp)
      call adrdet(nca,ica,ncb,icb,
     *ntto,it,ispt,nppo,ip,ispp,iadr,
     *      mhdum,mtdum)
      if(yw)print*,'kdet,iadr',kdet,iadr
c                                 write(6,'('' gendet it ip isgnt isgnp'
c     *                           ,2i3,2x,2i3,2x,2i5)')it,ip,isgnt,isgnp
c
c-----                           on a calcule l'adresse du determinant
c-----                           iadrr etablit une correspondance entre
c-----                           le numero du determinant dans la
c-----                           grande liste et son numero dans la
c-----                           petite liste
c
      isgn=isgnt*isgnp
      if(inddet.eq.28.or.inddet.eq.29)then
c                                    if(nta.eq.2.and.npa.eq.2)isgn=-isgn
c                                    if(ntb.eq.2.and.npb.eq.2)isgn=-isgn
c                                    if(nta.eq.2.or.npa.eq.2)isgn=-isgn
c                                    if(ntb.eq.2.or.npb.eq.2)isgn=-isgn
         if(nta.eq.2)isgn=-isgn
         if(ntb.eq.2)isgn=-isgn
         if(yw)write(6,*)'isgn,isgnc,nca,ncb'
     *   ,isgn,isgnc,nca,ncb
         isgn=isgn*isgnc
      endif
 35   continue
c      if(calcul.eq.'MD') then
         if(kdet.le.iadri*2)iadrr(kdet)=iadr*isgn
         if(itest(44).eq.2.and.inddet.le.6) then
            if(kdet.le.iadri) then
               mh(kdet)=mhdum
               mt(kdet)=mtdum
            endif
         endif
 24   continue
 23   continue
 22   continue
 21   continue
 6    continue
      if(yw)print*,'apres 6'
 4    continue
      if(yw)print*,'apres 4'
 11   continue
      if(yw)print*,'apres 11'
 10   continue
      if(yw)print*,'apres 10'
 3    continue
      if(yw)print*,'apres 3'
 1    continue
c      write(6,*)'**************************************'
c      write(6,*)'*******      fin de casdet    ********'
      if(yw1)write(6,*)' nombre de determinants generes',kdet
c      write(6,*)'**************************************'
      return
      end
