      subroutine gendec(ncae,icae,ncbe,icbe,ntae,itae,ntbe,itbe,
     *npae,ipae,npbe,ipbe,iepv,inddet,iadr,isgn)
      implicit real*8(a-h,o-x,z),logical*1 (y)
      parameter(maxsym=8)
      include 'maxorb.prm'
      parameter(maxorbcas=16,maxdetc=12870)
      common /orb/ enuc,eref,norb,noca,nocb
     *,iorb(2*maxorb),ninac,nvirt,noca0
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      dimension ica(maxorbcas),icb(maxorbcas)
      dimension ita(2),itb(2),ipa(2),ipb(2)
      dimension icae(maxorbcas),icbe(maxorbcas)
      dimension itae(2),itbe(2),ipae(2),ipbe(2)
      dimension it(2),ip(2)
      dimension yoc(-maxorb:maxorb)
      common/gdc/io3,io4
c
c----------------------------------------------------------------
c     generation des determinants incluant des operations sur le CAS
c----------------------------------------------------------------
c
      yw1=.false.
      yw=.false.
      do k=1,ncbe
         icb(k)=icbe(k)
      enddo
      do k=1,ncae
         ica(k)=icae(k)
      enddo
      do k=1,ntbe
         itb(k)=itbe(k)
      enddo
      do k=1,ntae
         ita(k)=itae(k)
      enddo
      do k=1,npbe
         ipb(k)=ipbe(k)
      enddo
      do k=1,npae
         ipa(k)=ipae(k)
      enddo
      nta=ntae
      ntb=ntbe
      npa=npae
      npb=npbe
      nca=ncae
      ncb=ncbe
      if(yw) then
         write(6,*)'ita',(ita(k),k=1,nta)
         write(6,*)'itb',(itb(k),k=1,ntb)
         write(6,*)'ipa',(ipa(k),k=1,npa)
         write(6,*)'ipb',(ipb(k),k=1,npb)
         call wrdet
     *   (nca,ncb,ica,icb,nta,ntb,ita,itb,npa,npb,ipa,ipb)
      endif
c--   traduction en occupation
      do k=-norb,norb
         yoc(k)=.false.
      enddo
      do k=1,nta
         yoc(ita(k))=.true.
      enddo
      do k=1,ntb
         yoc(-itb(k))=.true.
      enddo
      do k=1,npa
         yoc(ipa(k))=.true.
      enddo
      do k=1,npb
         yoc(-ipb(k))=.true.
      enddo
      do k=1,nca
         yoc(ica(k))=.true.
      enddo
      do k=1,ncb
         yoc(-icb(k))=.true.
      enddo
      if(yw)write(6,*)'det avant modif ',(yoc(-k),k=1,norb),'   ',
     *(yoc(k),k=1,norb)
      if(yw)write(6,*)'inddet',inddet
      if(inddet.eq.32.or.inddet.eq.36) then
         isgn3=1
         isgn4=-1
      else if(inddet.eq.33.or.inddet.eq.37) then
         isgn3=-1
         isgn4=1
      else if(inddet.eq.34.or.inddet.eq.38) then
         isgn3=-1
         isgn4=-1
      else if(inddet.eq.35.or.inddet.eq.39) then
         isgn3=1
         isgn4=1
      endif
      if(inddet.ge.32.and.inddet.le.39) then
c--      EPV ?
         iepv=0
         if(yw)write(6,*)'io3,io4',io3,io4
         if(yoc(isgn3*io3)) then
            iepv=1
            if(yw)print*,'EPV'
            return
         endif
c--      on supprime l'occupation des particules
         do k=1,npa
            yoc(ipa(k))=.false.
         enddo
         do k=1,npb
            yoc(-ipb(k))=.false.
         enddo
c--      nouvelles occupations
         yoc(isgn3*io3)=.true.
         yoc(isgn4*io4)=.true.
      endif
      if(yw)write(6,*)'det apres modif ',(yoc(-k),k=1,norb),'   ',
     *(yoc(k),k=1,norb)
c--   retraduction
      nca=0
      ncb=0
      nta=0
      npa=0
      ntb=0
      npb=0
      do k=1,norb
         if(yoc(k)) then
            if(itype(k).eq.1) then
               nta=nta+1
               ita(nta)=k
            else if(itype(k).eq.3) then
               npa=npa+1
               ipa(npa)=k
            else if(itype(k).eq.2) then
               nca=nca+1
               ica(nca)=k
            endif
         endif
      enddo
      do k=-1,-norb,-1
         if(yoc(k)) then
            if(itype(-k).eq.1) then
               ntb=ntb+1
               itb(ntb)=-k
            else if(itype(-k).eq.3) then
               npb=npb+1
               ipb(npb)=-k
            else if(itype(-k).eq.2) then
               ncb=ncb+1
               icb(ncb)=-k
            endif
         endif
      enddo
      if(yw1) then
         write(6,*)'--------gendec deter apres modif---------'
         call wrdet
     *   (nca,ncb,ica,icb,nta,ntb,ita,itb,npa,npb,ipa,ipb)
      endif
      nt=0
      np=0
      ispt=0
      ispp=0
      do k=1,nta
         nt=nt+1
         ispt=ispt+1
         it(nt)=ita(k)
      enddo
      do k=1,ntb
         nt=nt+1
         ispt=ispt-1
         it(nt)=itb(k)
      enddo
      do k=1,npa
         np=np+1
         ispp=ispp+1
         ip(np)=ipa(k)
      enddo
      do k=1,npb
         np=np+1
         ispp=ispp-1
         ip(np)=ipb(k)
      enddo
      call adrdet(nca,ica,ncb,icb,
     *nt,it,ispt,np,ip,ispp,iadr,
     *      mhdum,mtdum)
c--   signe
      if(inddet.eq.32.or.inddet.eq.35
     *.or.inddet.eq.36.or.inddet.eq.39) then
c        on deplace une particule alpha dans le CAS en io3
c        on a donc saute par dessus tous les el du CAS qui
c        sont superieurs a io3
         do k=1,nca
            if(ica(k).eq.io3) then
               isgn=(-1)**(nca-k)
               goto 5
            endif
         enddo
      endif
      if(inddet.eq.33.or.inddet.eq.34
     *.or.inddet.eq.37.or.inddet.eq.38) then
c        on deplace une particule beta dans le CAS en io3
c        on a donc saute par dessus tous les el du CAS qui
c        sont superieurs a io3
         do k=1,ncb
            if(icb(k).eq.io3) then
               isgn=(-1)**(ncb-k)
               goto 5
            endif
         enddo
      endif
 5    continue
      if(yw)write(6,*)'adresse,isgn',iadr,isgn
      return
      end
       subroutine prdec1(iesp,idebd,iadrr,nor1,nor2,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            |
c
c
c------------------------------------------------------------
c     inddet=32  generation des |(i j)| ...I...| a> |+->    par I,a
c     inddet=33  generation des |(i j)| ...I...| a> |-+>    par I,a
c     inddet=34  generation des |(i j)| ...I...| a> |++>    par I,a
c     inddet=35  generation des |(i j)| ...I...| a> |-->    par I,a
c     inddet=33  generation des | i j | ...I...|(a b)>  par i,j,I
c     inddet=34  generation des |i (j)| ...I...| (a)>   par i,I
c     inddet=35  generation des | i j | ...I...| a (b)> par i,j,I,a
c     inddet=36  generation des |j (i)| ...I...| a (b)> par j,I,a
c     inddet=37  generation des |(i j)| ...I...| >      par i,j,I
c     inddet=32 <Iabc>  -->    Ia +-       bc
c     inddet=33 <Iabc>  -->    Ia -+       bc
c     inddet=34 <Iabc>  -->    Ia ++       bc
c     inddet=35 <Iabc>  -->    Ia --       bc
c     inddet=33 <Iijk>  -->    jkI         i
c     inddet=34 <Iija>  -->    jI          ia
c     inddet=35 <Iaij>  -->    ijIa        -
c     inddet=36 <Iajb>  -->    jIa         b
c     inddet=37 <Ijab>  -->    I           jab
c------------------------------------------------------------
c
      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/orb2/numina(maxorb),numvir(maxorb),iordo(maxorb*2)
      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),num1(*),num2(*)
      dimension ysym(maxsym)
      common /cs/ noac,nelac,numac(maxorbcas),itype(maxorb),is0,ms2
      common/gdc/io3,io4
      integer(8) :: ndet8
cdcor
ccor      common/bidvr/ibidv(10000),ibidr(10000,20),icor
cfcor
      yw=.false.
      yw1=.false.
      if(yw1)print*,'entree prdec1',inddet
      do k=1,norb
         do l=1,norb
            idebd(l,k)=0
         enddo
      enddo
      ndet8=ndet
      do k=1,min(ndet8*2,iadri*4)
         iadrr(k)=0
      enddo
      kdet=0
      kdeb=1
      do k=1,nsym
         ysym(k)=.false.
      enddo
 1    do k=kdeb,nor1
         io1=num1(k)
         ldeb=1
         if(nordeb.eq.-1) ldeb=k+1
         do 2 l=ldeb,nor2
         io2=num2(l)
         ise=its(itsym(io1),itsym(io2))
         if(ysym(ise)) goto 2
         ysym(ise)=.true.
c            idebd(io1,io2)=kdet+1
cc           si is=1 on symetrise idebd
c            if(is.eq.1) idebd(io2,io1)=kdet+1
c            if(yw1)write(6,'('' ----prdec1 orb,k,l,io1,io2'',4i5)')
c     *      k,l,io1,io2
c--         boucles sur les indices remplacants
         do 3 kr=1,noac
         io3=numac(kr)
         isr=itsym(io3)
         do 4 lr=1,nvirt
         io4=numvir(lr)
         if(yw1)write(6,'('' ----prdec1 orb,kr,lr,io3,io4'',4i5)')
     *   kr,lr,io3,io4
         if(its(isr,itsym(io4)).ne.ise) goto 4
         idebd(io3,io4)=kdet+1
c           si is=1 on symetrise idebd
         if(is.eq.1) idebd(io4,io3)=kdet+1
         if(yw)write(6,*)'isr',isr
         call gendet(iesp,
     *   iesp(maxorbcas*maxdetc+1),iadrr,io1,io2,ispi1,ispi2
     *   ,kdet,inddet,mhdum,mtdum)
         if(kdet.gt.iadri*4) then
            write(6,*)'kdet,iadri',kdet,iadri
            stop 29
         endif
 4       continue
 3       continue
         ilond(ise)=kdet-idebd(io1,io2)
 2       continue
         kdet0=kdet
      enddo
      mdet(inddet)=kdet
      if(yw) then
         do k=1,norb
            write(75,*)'prdec1 idebd',(idebd(k,l),l=1,norb),'$'
            call scril
         enddo
         write(6,*)'ilond',(ilond(k),k=1,nsym)
         do k=1,kdet
            write(6,*)'prdec1 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
