      subroutine prede4s(iesp,iadrr,inddet,
     *ispi1,ispi2,llll,iiii,ifil,mh,mt)
      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)
      parameter(maxref=15000)
c    |-*-*-*-*-*-*-*-|-*-*-*-*-*-*-*-|
c    |     iadrr     |  mh   |  mt   |
c
      common/sym/ itsym(maxorb*2),its(maxsym,maxsym),nsym
      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 /det/ndet,mdet(50),nbdet_cas
      dimension iesp(maxorbcas*maxdetc*2),iadrr(iadri*4)
      common/mrmr/nmr,nel
      dimension mh(maxref,3,3),mt(maxref,3,3)
      dimension mh0(maxref),mt0(maxref)
      character*8 ifil
      common/ijd/inti(1024),intj(1024),intk(1024),intl(1024),aaint(1024)
      common/test/itest(100)
      dimension yprem(3,3),it(2),ip(2),idep(3,3)
      dimension iadrt(3,3),iadrp(3,3)
      dimension iadrt0(3,3),iadrp0(3,3)
      dimension isymv1(3,3),isymv2(3,3),isymv3(3,3)
cdcor
ccor      common/bidvr/ibidv(10000),ibidr(10000,20),icor
cfcor
      yw=.false.
      yw1=.false.
      if(yw1)print*,'entree prede4s'
      kdet=0
      do i=1,3
         do j=1,3
            yprem(j,i)=.true.
         enddo
      enddo
c
c--------------------------------------------------
c     generation des determinants non excites
c--------------------------------------------------
c
      call gende0(iesp,
     *iesp(maxorbcas*maxdetc+1),iadrr,kdet,
     *iadrr(iadri*2+1),iadrr(iadri*3+1))
      mdec=kdet
      if(yw) then
         do k=1,kdet
            if(yw)print 1000,
     *      '0k,iadrr',
     *      k,iadrr(k)
         enddo
      endif
c
c--------------------------------------------------
c     lecture des integrales <oovv>
c     generation des determinants diexcites
c--------------------------------------------------
c      print*,'ifil ',ifil
      call flush(6)
      open(42,status='OLD',file=ifil,form='UNFORMATTED')
      do ln=1,llll+1
         call lirin4(inti,intj,intk,intl,aaint,42)
         lfini=1024
         if(ln.eq.llll+1) lfini=iiii
         do in=1,lfini
            io1=inti(in)
            io2=intj(in)
            io3=intk(in)
            io4=intl(in)
            a=aaint(in)
            if(yw)write(6,*)'io1,io2,io3,io4'
     *      ,io1,io2,io3,io4
            if(io1.eq.io2) then
               indt=1
            else if(io1.lt.io2) then
               indt=2
            else if(io1.gt.io2) then
               indt=3
            endif
            if(io3.eq.io4) then
               indp=1
            else if(io3.lt.io4) then
               indp=2
            else if(io3.gt.io4) then
               indp=3
            endif
            it(1)=io1
            it(2)=io2
            ip(1)=io3
            ip(2)=io4
            if(.not.yprem(indt,indp)) then
               yprem(indt,indp)=isymv1(indt,indp).ne.itsym(io1)
     *         .or.isymv2(indt,indp).ne.itsym(io2)
     *         .or.isymv3(indt,indp).ne.itsym(io3)
               if(yw) then
                  print*,'isymv',isymv1(indt,indp),
     *            isymv2(indt,indp),isymv3(indt,indp)
                  print*,'itsym',itsym(io1),itsym(io2),itsym(io3)
                  print'(a10,l2)','yprem',yprem(indt,indp)
               endif
            endif
            if(yw)print 1000, 'it,ip',it,ip
            if(ifil.eq.'CDI_3311') then
               if(yprem(indt,indp)) then
c
c                 premiere fois : appel gende4
c
                  if(yw)print 1000,'1g indt,indp',indt,indp
                  idep(indt,indp)=kdet
                  call gende4(iesp,
     *            iesp(maxorbcas*maxdetc+1),iadrr,io1,io2,io3,io4,
     *            ispi1,ispi2,kdet,mh0,mt0)
                  isymv1(indt,indp)=itsym(io1)
                  isymv2(indt,indp)=itsym(io2)
                  isymv3(indt,indp)=itsym(io3)
                  do k=1,mdec
                     mt(k,indt,indp)=mt0(k)
                     mh(k,indt,indp)=mh0(k)
                  enddo
                  call adrts(2,it,iadrt0(indt,indp))
                  call adrps(2,ip,iadrp0(indt,indp))
                  yprem(indt,indp)=.false.
                  if(yw) then
                     kk=0
                     do k=kdet-mdec+1,kdet
                        kk=kk+1
                        if(yw)print 1000,
     *                  '1k,mh,mt,iadrr',
     *                  k,mh(kk,indt,indp),mt(kk,indt,indp)
     *                  ,iadrr(k),iadrt0(indt,indp),iadrp0(indt,indp)
                     enddo
                  endif
               else
c
c                 autres fois, calcul rapide
c
                  if(yw)print 1000,'1r indt,indp',indt,indp
                  do k=1,mdec
                     kdet=kdet+1
                     call adrts(2,it,iadrt(indt,indp))
                     call adrps(2,ip,iadrp(indt,indp))
                     iadrtp0=(iadrt0(indt,indp)
     *               +(iadrp0(indt,indp)-1)*mt(k,indt,indp)-1)
     *               *MH(k,indt,indp)
                     iadrtp=(iadrt(indt,indp)
     *               +(iadrp(indt,indp)-1)*mt(k,indt,indp)-1)
     *               *MH(k,indt,indp)
                     iadrdel=iadrtp-iadrtp0
                     if(iadrr(idep(indt,indp)+k).lt.0) iadrdel=-iadrdel
                     if(kdet.le.iadri)
     *               iadrr(kdet)=iadrr(idep(indt,indp)+k)+iadrdel
                     if(yw)print 1000,
     *               '1kdet,k,iadrrv,mh,mt,iadrr',
     *               kdet,k,iadrr(idep(indt,indp)+k)
     *               ,mh(k,indt,indp),mt(k,indt,indp)
     *               ,iadrr(kdet),iadrt(indt,indp),iadrp(indt,indp)
     *               ,iadrtp0,iadrtp
                  enddo
               endif
            endif
            if(io1.ne.io2.or.io3.ne.io4) then
               if(indt.eq.1) then
                  jndt=1
               else
                  jndt=5-indt
               endif
               if(indp.eq.1) then
                  jndp=1
               else
                  jndp=5-indp
               endif
               if(.not.yprem(jndt,jndp)) then
                  yprem(jndt,jndp)=isymv1(jndt,jndp).ne.itsym(io2)
     *            .or.isymv2(jndt,jndp).ne.itsym(io1)
     *            .or.isymv3(jndt,jndp).ne.itsym(io4)
                  if(yw) then
                     print*,'2isymv',isymv1(jndt,jndp),
     *               isymv2(jndt,jndp),isymv3(jndt,jndp)
                     print*,'2itsym',itsym(io2),itsym(io1),itsym(io4)
                     print'(a10,l2)','2yprem',yprem(jndt,jndp)
                  endif
               endif
               if(yprem(jndt,jndp)) then
                  if(yw)print 1000,'2g jndt,jndp',jndt,jndp
c
c                 premiere fois : appel gende4
c
                  if(yw)print 1000,'2g jndt,jndp',jndt,jndp
                  idep(jndt,jndp)=kdet
                  call gende4(iesp,
     *            iesp(maxorbcas*maxdetc+1),iadrr,io2,io1,io4,io3,
     *            ispi1,ispi2,kdet,mh0,mt0)
                  isymv1(jndt,jndp)=itsym(io2)
                  isymv2(jndt,jndp)=itsym(io1)
                  isymv3(jndt,jndp)=itsym(io4)
                  do k=1,mdec
                     mt(k,jndt,jndp)=mt0(k)
                     mh(k,jndt,jndp)=mh0(k)
                  enddo
                  call adrts(2,it,iadrt0(jndt,jndp))
                  call adrps(2,ip,iadrp0(jndt,jndp))
                  yprem(jndt,jndp)=.false.
                  if(yw) then
                     kk=0
                     do k=kdet-mdec+1,kdet
                        kk=kk+1
                        if(yw)print 1000,
     *                  '1k,mh,mt,iadrr',
     *                  k,mh(kk,jndt,jndp),mt(kk,jndt,jndp)
     *                  ,iadrr(k),iadrt0(jndt,jndp),iadrp0(jndt,jndp)
                     enddo
                  endif
               else
c
c                 autres fois, calcul rapide
c
                  if(yw)print 1000,'2r jndt,jndp',jndt,jndp
                  do k=1,mdec
                     kdet=kdet+1
                     call adrts(2,it,iadrt(jndt,jndp))
                     call adrps(2,ip,iadrp(jndt,jndp))
                     iadrtp0=(iadrt0(jndt,jndp)
     *               +(iadrp0(jndt,jndp)-1)*mt(k,jndt,jndp)-1)
     *               *MH(k,jndt,jndp)
                     iadrtp=(iadrt(jndt,jndp)
     *               +(iadrp(jndt,jndp)-1)*mt(k,jndt,jndp)-1)
     *               *MH(k,jndt,jndp)
                     iadrdel=iadrtp-iadrtp0
                     if(iadrr(idep(jndt,jndp)+k).lt.0) iadrdel=-iadrdel
                     if(yw)print*,'iadrtp0,iadrtp,iadrdel',
     *               iadrtp0,iadrtp,iadrdel
                     if(kdet.le.iadri)
     *               iadrr(kdet)=iadrr(idep(jndt,jndp)+k)+iadrdel
                     if(yw)print 1000,
     *               '2kdet,k,iadrrv,mh,mt,iadrr',
     *               kdet,k,iadrr(idep(jndt,jndp)+k)
     *               ,mh(k,jndt,jndp),mt(k,jndt,jndp)
     *               ,iadrr(kdet),iadrt(jndt,jndp),iadrp(jndt,jndp)
     *               ,iadrtp0,iadrtp
                  enddo
               endif
            endif
         enddo
      enddo
 1000 format(a30,10i5)
      mdet(inddet)=kdet
      close(42)
      write(77) mdec
      if(yw) then
         do k=1,kdet
            print*,'prede4 iadrr',k,iadrr(k)
         enddo
      endif
      call ecribl(iadrr,kdet,76)
      return
      end
