      subroutine prede2s(iesp,idebd,iadrr,mh,mt,nordeb,num1
     *,num2,ispi1,ispi2,inddet,is)
      implicit real*8(a-h,o-x,z),logical*1 (y)
      parameter(maxsym=8)
      include 'maxorb.prm'
      common/dim/iadri ; integer(8) iadri
      parameter(maxorbcas=16,maxdetc=12870)
c
c    |-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|
c    |     iadrr     |  mh   |  mt   |
c
      common/test/itest(100)
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      dimension idebd(norb,norb),ilond(maxsym)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common/sy2/ntcps(maxsym,3)
     *,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
      common/sy4/ntcpstot(0:maxsym,3)
      character*4 gener
      common /det/ndet,mdet(50),nbdet_cas
      dimension iesp(maxorbcas*maxdetc*2),iadrr(iadri*4),num1(*),num2(*)
      dimension mh(iadri),mt(iadri)
      dimension ip(2)
      integer(8) ndet8
cdcor
ccor      common/bidvr/ibidv(10000),ibidr(10000,20),icor
cfcor
      yw=.false.
      yw1=.false.
      if(yw1)print*,'entree prede2s',inddet
      ndet8=ndet
      do k=1,min(ndet8*2,iadri)
         iadrr(k)=0
      enddo
      kdet=0
      if(inddet.le.3) then
         ityp=3
      else if(inddet.le.6) then
         ityp=1
      endif
c
c     boucle sur l'ordre des orbitales
c     0 : io1=io2 ; 1 : io1<io2 ; 2 : io1>io2
c
      if(nordeb.eq.1) then
         iordd=0
         iordf=2
      else
         iordd=1
         iordf=1
      endif
      do iord=iordd,iordf
         if(iord.eq.0) then
            isolp=0
         else
            isolp=2
         endif
         if(yw)print 1000,'§§§§§§iord, isolp',iord, isolp
c
c           boucles sur la symetrie des particules
c
         if(isolp.eq.0) then
            ispf=1
         else
            ispf=nsym
         endif
         do isp=1,ispf
            yprem=.true.
            do is1=1,nsym
               is2=its(isp,is1)
               if(iord.eq.1.and.is2.lt.is1) goto 1
               if(iord.eq.2.and.is2.gt.is1) goto 1
               if(yw)print 1000,'§§§§§§isp,is1,is2',isp,is1,is2
c
c           boucles sur les orbitales
c
               do ko1=ntcpstot(is1-1,ityp)+1,ntcpstot(is1,ityp)
                  io1=num1(ko1)
                  if(iord.eq.0) then
                     io2d=ko1
                     io2f=ko1
                  else if (iord.eq.1) then
                     if(isp.eq.1) then
                        io2d=ko1+1
                        io2f=ntcpstot(is2,ityp)
                     else
                        io2d=ntcpstot(is2-1,ityp)+1
                        io2f=ntcpstot(is2,ityp)
                     endif
                  else if (iord.eq.2) then
                     if(isp.eq.1) then
                        io2d=ntcpstot(is2-1,ityp)+1
                        io2f=ko1-1
                     else
                        io2d=ntcpstot(is2-1,ityp)+1
                        io2f=ntcpstot(is2,ityp)
                     endif
                  endif
                  do ko2=io2d,io2f
                     io2=num2(ko2)
                     if(yw)print 1000,'io1,io2',io1,io2
                     idebd(io1,io2)=kdet+1
                     if(yw)print 1000,
     *               'io1,io2,idebd',io1,io2,idebd(io1,io2)
c           si is=1 on symetrise idebd
                     if(is.eq.1) idebd(io2,io1)=kdet+1
                     if(yw1)write(6,'('' ----prede2s orb,io1,io2'',4i5)'
     &               )
     *               io1,io2
                     if(yw1)call flush(6)
                     if(inddet.eq.1.or.inddet.eq.4) then
                        ip(1)=io1
                        ip(2)=io2+norb
                     else if(inddet.eq.2.or.inddet.eq.5) then
                        ip(1)=io1+norb
                        ip(2)=io2+norb
                     else if(inddet.eq.3.or.inddet.eq.6) then
                        ip(1)=io1
                        ip(2)=io2
                     endif
                     if(ityp.eq.1) then
                        call adrts(2,ip,iadrp)
                     else
                        call adrps(2,ip,iadrp)
                     endif
                     if(yw)print 1000,'ip',ip
                     if(yprem) then
                        kdet0=kdet+1
                        call gendet(iesp,
     *                  iesp(maxorbcas*maxdetc+1)
     *                  ,iadrr,io1,io2,ispi1,ispi2
     *                  ,kdet,inddet,mh,mt)
                        if(kdet.gt.iadri) then
                           write(6,*)'kdet,iadri',kdet,iadri
                           stop 290
                        endif
                        ilond(its(itsym(io1),itsym(io2)))
     *                  =kdet-idebd(io1,io2)
                        kdet1=kdet
                        if(yw)print 1000,'apres gendet kdet0,kdet1',
     *                  kdet0,kdet1
                        yprem=.false.
                        iadrp0=iadrp
                        if(yw)then
                           do k=kdet0,kdet1
                               print 1000,
     *                        'k,mh,mt,iadrr',
     *                        k,mh(k),mt(k),iadrr(k)
                           enddo
                        endif
                     else
                        if(yw)print 1000,'ypremF kdet0,kdet1',
     *                  kdet0,kdet1
                        if(yw)print 1000,'iadrp0,iadrp',iadrp0,iadrp
                        iadrp1=iadrp-iadrp0
                        do i=kdet0,kdet1
                           kdet=kdet+1
c                           if(kdet.gt.iadri) then
c                              write(6,*)'kdet,iadri',kdet,iadri
c                              stop 29
c                           endif
                           if(ityp.eq.3) then
                              if(kdet.le.iadri)
     *                        iadrr(kdet)=iadrr(i)+iadrp1*mh(i)*mt(i)
 1000                         format(a30,10i5)
                              if(yw)print 1000,
     *                        'kdet,i,iadrrv,mh,mt,iadrr',
     *                        kdet,i,iadrr(i),mh(i),mt(i)
     *                        ,iadrr(kdet)
                           else
                              if(kdet.le.iadri)
     *                        iadrr(kdet)=iadrr(i)+iadrp1*mh(i)
                              if(yw)print 1000,
     *                        'kdet,i,iadrrv,mh,mt,iadrr',
     *                        kdet,i,iadrr(i),mh(i),mt(i)
     *                        ,iadrr(kdet)
                           endif
                        enddo
 
 
 
                     endif
                  enddo
               enddo
 1             continue
            enddo
         enddo
      enddo
      mdet(inddet)=kdet
      if(yw) then
         print*,'prede2s inddet',inddet
         do k=1,norb
            write(75,*)'prede2s idebd',(idebd(k,l),l=1,norb),'$'
            call scril
         enddo
         write(6,*)'prede2s ilond',(ilond(k),k=1,nsym)
         do k=1,kdet
            write(6,*)'prede2s k,iadrr(k)',k,iadrr(k)
         enddo
      endif
      call ecri(idebd,norb*norb,77)
      call ecri(ilond,maxsym,77)
      call ecribl(iadrr,kdet,76)
      return
      end
