      subroutine mulccccd(x1,y1,z1,t1,aa1)
      use module
      use mod_ena
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer a,x1,y1,z1,b,b1,x,y,z,t1,t
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      ! x1,y1,z1,t1,aa1 = indices et valeur de l'integrale
      ! appels a mulccccd2 pour differentes valeurs de nca,ncb
      ! (2 derniers indices)
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      x=num_oav(x1)
      y=num_oav(y1)
      z=num_oav(z1)
      t=num_oav(t1)
      call mulccccd2(x,y,z,t,aa1,0,0)
      if(igener==0) return
      if(itest(22)==1.and.iter==1) return
      call mulccccd2(x,y,z,t,aa1,0,1)
      call mulccccd2(x,y,z,t,aa1,0,-1)
      call mulccccd2(x,y,z,t,aa1,1,0)
      call mulccccd2(x,y,z,t,aa1,-1,0)
      call mulccccd2(x,y,z,t,aa1,1,1)
      call mulccccd2(x,y,z,t,aa1,1,-1)
      call mulccccd2(x,y,z,t,aa1,-1,1)
      call mulccccd2(x,y,z,t,aa1,-1,-1)
      if(igener<2) return
      call mulccccd2(x,y,z,t,aa1,2,0)
      call mulccccd2(x,y,z,t,aa1,-2,0)
      call mulccccd2(x,y,z,t,aa1,0,2)
      call mulccccd2(x,y,z,t,aa1,0,-2)
      if(igener<3) return
      call mulccccd2(x,y,z,t,aa1,2,-1)
      call mulccccd2(x,y,z,t,aa1,-2,1)
      call mulccccd2(x,y,z,t,aa1,1,-2)
      call mulccccd2(x,y,z,t,aa1,-1,2)
      if(igener<4) return
      call mulccccd2(x,y,z,t,aa1,2,-2)
      call mulccccd2(x,y,z,t,aa1,-2,2)
      return
      end
       subroutine mulccccd2(x,y,z,t,aa1,nca,ncb)
      use module
      use mod_ena
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer x,y,z,t
      dimension nbc(0:2)
      !////////////////////////////////////////////////
      if(w)print'(a,10i4)','mulccccd2 ',x,y,z,t,nca,ncb
      !////////////////////////////////////////////////
      ! classe du determinant CAS
      iclc=iclasc(nca,ncb)
      if(iclc.eq.0) return
      ! llongc=nb de strings du CAS correspondant a la classe
      j1=idebc(iclc)-1
      j2=idebc(iclc)-1
      llongc=ifinc(iclc)-idebc(iclc)+1
      ! appel a cast, ou on trouve tous les elements d'interaction
      ! entre les determinants CAS. On a elimine tous les elements
      ! d'interaction incompatibles avec l'integrale. A la sortie
      ! de cast, il en reste longc
      call cast(msgnc,j1,j2,iclc,iclc,x,y+16,z,t+16,longc,mdetc1
     *,mdetc2,llongc,nbc,nca,ncb)
      if(sel==2) then
         ! calcul selectionne
         !
         ! Dans cast, on a assigne a chaque element d'interaction
         ! une distance, = la distance max des 2 det CAS.
         !
         ! si on n'a pas (nca==0.and.ncb==0), les choses sont simples,
         ! il n'y a jamais de dist 0, donc soit 1 soit 2. Les 1 ont ete
         ! places en tete de mdetc et msgnc, les dist 2 en bout.
         !
         ! Selon les valeurs de nt et np, on va prendre toutes les
         ! interactions CAS, ou seulement celles de distance plus petite
         ! (mulcccc_sel)
         call mulcccc_sel(nca,ncb,longc,aa1,nbc,iclc)
      else
         n=idetc(idebc(iclc)+1)-idetc(idebc(iclc))
         if(w)print*,'N',iclc,idebc(iclc),idetc(idebc(iclc)),
     *   idetc(idebc(iclc)+1),n
         if(igener==0) n=1
         ! Appel a la boucle interne
         if(longc/=0.or.n/=0) itest(24)=1
         call ena_ccccd(aa1,longc,mdetc1(1:longc),mdetc2(1:longc),
     *   n,isgn=msgnc)
      endif
      return
      end
 
       subroutine cast(isgnc,j1,j2,iclc1,iclc2,x,y,z,t,longc,idetc1
     *,idetc2,llongc,nbc,nca,ncb)
      use module
      integer x,y,z,t
      integer idetc1(llongc),idetc2(llongc),isgnc(llongc)
      dimension nbc(0:2)
      longc=0
      isgnc=1
      nbc=0
      if(w)print*,'idebc1,ifinc1',idebc(iclc1),ifinc(iclc1)
      if(w)print*,'idebc2,ifinc2',idebc(iclc2),ifinc(iclc2)
      rewind 98
      do
         j1=j1+1
         if(j1>ifinc(iclc1)) exit
         ! tests
         if(.not.btest(ibinc(j1),x-1)) cycle
         if(.not.btest(ibinc(j1),y-1)) cycle
         if(x/=z.and.btest(ibinc(j1),z-1)) cycle
         if(y/=t.and.btest(ibinc(j1),t-1)) cycle
         if(sel==2) idist1=icaldist(j1,ibin,ibinc,noac)
         if(w)print*,'j1,idist1',j1,idist1
         do
! Remarque : on n'est pas dans une vraie boucle.
! Le premier j2 qu'on va trouver
! correspondra au det CAS j1.
! On arrivera alors a la fin de la boucle, et il
! y a un exit pour revenir au j1 suivant.
            j2=j2+1
            if(j2>ifinc(iclc2)) exit
            ! tests
            if(x/=z.and.btest(ibinc(j2),x-1)) cycle
            if(y/=t.and.btest(ibinc(j2),y-1)) cycle
            if(.not.btest(ibinc(j2),z-1)) cycle
            if(.not.btest(ibinc(j2),t-1)) cycle
            longc=longc+1
            if(sel==2) then
               idist2=icaldist(j2,ibin,ibinc,noac)
               mdist=max(idist1,idist2)
               if(mdist>2) exit
               nbc(mdist)=nbc(mdist)+1
               if(mdist==1) then
                  ll=nbc(1)
               else if(mdist==2) then
                  ll=llongc-nbc(2)+1
               endif
            else
               ll=longc
            endif
         if(w)print*,'j2,idist2',j2,idist2
            isgnctmp=1
      !signe
            if (z>x+1) then
               do k=x+1,z-1
                  if(btest(ibinc(j1),k-1)) isgnctmp=-isgnctmp
               enddo
            elseif (x>z+1) then
               do k=z+1,x-1
                  if(btest(ibinc(j1),k-1)) isgnctmp=-isgnctmp
               enddo
            endif
            if (y>t+1) then
               do k=t+1,y-1
                  if(btest(ibinc(j2),k-1)) isgnctmp=-isgnctmp
               enddo
            elseif (t>y+1) then
               do k=y+1,t-1
                  if(btest(ibinc(j2),k-1)) isgnctmp=-isgnctmp
               enddo
            endif
      ! fin signe
 
         if(w)print*,'sel,mdist',sel,mdist
 
            if(sel==2.and.mdist==0) then
               write(98,*) idetc(j1),idetc(j2),isgnctmp
               !print'(a,10i6)','dist0',nca,ncb,x,y,z,t
               if(w)write(6,*)'idetc(j1),idetc(j2)',idetc(j1),idetc(j2)
            else
               idetc1(ll)=idetc(j1)
               idetc2(ll)=idetc(j2)
               isgnc(ll)=isgnctmp
            endif
            exit
         enddo
      enddo
      ! - si (nca+ncb==0), il y a 3 dist possibles (0,1,2). Les
      ! dist 2 sont en bout, les 1 en tete, et les 0 sont ecrites
      ! sur 98
      ! il faut alors retrier
      ! - sinon, il y a les distances 1 et 2, ou seulement 2
      ! 1 est en place, 2 est a la fin. Il faut remettre 2 juste apres 1
      if(sel==2) then
         longc=sum(nbc)
         if(nca+ncb==0) then
            idetc1(nbc(0)+1:nbc(0)+nbc(1))=idetc1(1:nbc(1))
            idetc1(nbc(0)+nbc(1)+1:longc)=idetc1(llongc-nbc(2)+1:llongc)
            idetc2(nbc(0)+1:nbc(0)+nbc(1))=idetc2(1:nbc(1))
            idetc2(nbc(0)+nbc(1)+1:longc)=idetc2(llongc-nbc(2)+1:llongc)
            isgnc(nbc(0)+1:nbc(0)+nbc(1))=isgnc(1:nbc(1))
            isgnc(nbc(0)+nbc(1)+1:longc)=isgnc(llongc-nbc(2)+1:llongc)
            rewind 98
            do k=1,nbc(0)
               read(98,*) idetc1(k),idetc2(k),isgnc(k)
            enddo
         else
            idetc1(nbc(1)+1:longc)=idetc1(llongc-nbc(2)+1:llongc)
            idetc2(nbc(1)+1:longc)=idetc2(llongc-nbc(2)+1:llongc)
            isgnc(nbc(1)+1:longc)=isgnc(llongc-nbc(2)+1:llongc)
         endif
      endif
      if(w)print*,'longc,idetc',longc,idetc1(1:longc),idetc2(1:longc)
      return
      end
       subroutine mulcccc_sel(nca,ncb,longc,aa1,nbc,iclc)
      use module
      use mod_ena
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      dimension nbc(0:2)
      yw=.false.
      nc=nca+ncb
      ntp=0
      do nt=0,2
         np=nt-nc
         if(np<0) cycle
         if(np>2) cycle
         do nta=0,nt
            npa=nta-nca
            if(npa<0) cycle
            if(npa>2) cycle
            ntb=nt-nta
            npb=np-npa
            if(npb<0) cycle
            if(npb>2) cycle
            if(yw)print'(a,6i3)','nca,ncb,nta,ntb,npa,npb',
     *      nca,ncb,nta,ntb,npa,npb
            ! distance max du det CAS
            call caldfc(jdist,nt,np)
            ! la longueur des parties CAS du couple de determinants
            ! depend de jdist
            lc=sum(nbc(0:jdist))
            ! la longueur de la partie TP depend de nta,ntb,npa,npb
            ltp=idimtp(icltp(nta,ntb,npa,npb))
            if(lc/=0.and.ltp/=0) itest(24)=1
            call ena_ccccd2(aa1,lc,mdetc1(1:lc),mdetc2(1:lc),
     *      ltp,ntp,isgn=msgnc)
            ntp=ntp+ltp
         enddo
      enddo
      return
      end
