      subroutine mulccvvd(x1,y1,a,b,aaa1,aaa2)
      use module
      use mod_ena
      use mod_mula
      use mod_itp
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer a,x1,y1,z1,b,b1,x,y,z
      integer,allocatable,dimension(:) :: idetc1,idetc2,isgnc
      character(31) elmat(27)
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! Preparation des listes d'adresses du CAS et des TP
      !
      ! i,j,k,l,aa = indices et valeur de l'integrale
      ! itp1,itp2,itp3,itp4 : adresses de la partie T/P
      ! ntp,ntp1,ntp2       : nombre d'adresses T/P
      !  det1 : [xy...] -->       det2 : -->ab
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !a et b doivent etre lies au cas
      ! on n'ajoute rien
      !
      if(igener<2) return
!      if(iter>=iterh)print*,'subr mulccvvd classhab(0,2)'
      if (iter>=iterh) call classhab(0,2)
      aa1=aaa1
      aa2=aaa2
      call caldfc(idist,0,0)
      call caldfc(idist2,0,2)
      !symetrie de spin
      if(x1==y1.and.a==b) then
         ysp1=.false.
         ysp0=.true.
      else
         ysp1=itest(21)==1
         ysp0=itest(21)==0
      endif
      if(ysp1) then
         aa1=aa1*2
         aa2=aa2*2
      endif
      x=num_oav(x1)
      y=num_oav(y1)
      a1=num_oav(a)
      b1=num_oav(b)
      !symetrie de spin
      if(x==y.and.a==b) then
         ysp1=.false.
         ysp0=.true.
      else
         ysp1=itest(21)==1
         ysp0=itest(21)==0
      endif
      !//////////////////////////////////
      if(w)print*,'mulccvvd 0',x1,y1,a,b
      !//////////////////////////////////
      ! Signe
      jsgn=1
!      if((x-y)*(a-b)>0) jsgn=-1
!      if((x-y)*(a-b)<0) stop
      ilca=ilc1(a)
      ilcb=ilc1(b)
      n=0
      nntp=0
      if (ilca.ne.0.and.ilcb.ne.0)then
         n=1
         itp1(1)=1
         if (a>b) then
            itp2(1)=num1(ilca)+ilcb
            ltp1(1)=1
         elseif (a<b) then
            itp2(1)=num1(ilcb)+ilca
            ltp1(1)=1
         elseif (a==b) then
            itp2(1)=ilca
            ltp1(1)=2
         endif
         nntp(ltp1(n))=nntp(ltp1(n))+1
         if(w)print'(a,20i4)','a,b',a,b,n,
     *   ltp1(n),nntp(ltp1(n)),
     *   itp1(n),itp2(n)
         !
         call reoitp(n,2,nntp)
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         !
         elmat(1:2)=(/'      ->       |       -> B+ A+',
     *   '      ->       |       -> B+=A+'/)
         call mula0(x,y,0,0)
         !
         if(w)print*,'icas1'
         call mula(aa1,'+-vv',elmat,1,2,1,'B-')
         if(ysp0.and.(a/=b.or.x/=y))
     *   call mula(aa1,'-+vv',elmat,1,2,1,'A-')
         !
         if(a/=b.and.x/=y) then
            if(w)print*,'icas2'
            ydir=.false.
            yoci((/x,y/))=.true.
            call mula(aa1-aa2,'++vv',elmat,1,1,jsgn)
            if(ysp0)call mula(aa1-aa2,'--vv',elmat,1,1,jsgn,'A-','B-')
            ydir=.true.
            yoci((/x,y/))=.false.
            !
            if(w)print*,'icas3'
            call mula(aa2,'+-vv',elmat,1,2,1,'A-')
            if(ysp0)call mula(aa2,'-+vv',elmat,1,2,1,'B-')
            !
         endif
      endif
 
      hab=0
 
      if(igener<3) return
      if(itest(22)==1.and.iter==1) return
      !/////////////////////////////////////////////////
      if(w)print*,'mulccvvd on ajoute un trou',x1,y1,a,b
      !/////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,0)
      call caldfc(idist2,1,2)
      do ii=1,nlco
         i=ilc(ii)
         apair=ilp(i,a)
         bpair=ilp(i,b)
         if ((apair/=0).and.(ilc1(b)/=0)) then
            if(ipc(ilp(i,a),nlco+ilc1(b))==0) cycle
            n=n+1
            itp1(n)=ilc1(i)
            itp2(n)=abs(ipc(ilp(i,a),nlco+ilc1(b)))
            if (a>b) then
               ltp1(n)=1
            elseif (a==b) then
               ltp1(n)=2
            endif
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','Aa,b,i',a,b,i,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         elseif ((bpair/=0).and.(ilc1(a)/=0)) then
            if(ipc(ilp(i,b),nlco+ilc1(a))==0) cycle
            n=n+1
            itp1(n)=ilc1(i)
            itp2(n)=abs(ipc(ilp(i,b),nlco+ilc1(a)))
            if (a>b) then
               ltp1(n)=1
            elseif (a==b) then
               ltp1(n)=2
            endif
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','Aa,b,i',a,b,i,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         endif
      enddo
      if(n/=0) then
         call reoitp(n,2,nntp)
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         elmat(1:2)=(/'i+    ->       | i+    -> B+ A+',
     *   'i+    ->       | i+    -> B+=A+'/)
         call mula0(x,y,0,0)
         !
         if(w)print*,'icas1'
         call mula(aa1,'+-vv',elmat,n,2,1,'B-')
         if(ysp0)call mula(aa1,'-+vv',elmat,n,2,1,'A-','i-')
         !
         if(a/=b.or.x/=y) then
            if(w)print*,'icas2'
            call mula(aa1,'+-vv',elmat,n,2,1,'B-','i-')
            if(ysp0)call mula(aa1,'-+vv',elmat,n,2,1,'A-')
         endif
         !
         !==================
         !
         if(a/=b.and.x/=y) then
            if(w)print*,'icas3'
            ydir=.false.
            yoci((/x,y/))=.true.
            call mula(aa1-aa2,'++vv',elmat,n,1,jsgn)
            if(ysp0)
     *      call mula(aa1-aa2,'--vv',elmat,n,1,jsgn,'A-','B-','i-')
            !
            if(w)print*,'icas4'
            call mula(aa1-aa2,'++vv',elmat,n,1,jsgn,'i-')
            if(ysp0)call mula(aa1-aa2,'--vv',elmat,n,1,jsgn,'A-','B-')
            ydir=.true.
            yoci((/x,y/))=.false.
            !
            !==================
            !
            if(w)print*,'icas5'
            call mula(aa2,'+-vv',elmat,n,1,1,'A-')
            if(ysp0)call mula(aa2,'-+vv',elmat,n,1,1,'B-','i-')
            !
            if(w)print*,'icas5'
            call mula(aa2,'+-vv',elmat,n,1,1,'A-','i-')
            if(ysp0)call mula(aa2,'-+vv',elmat,n,1,1,'B-')
            !
         endif
      endif
      !
      if(igener<4) return
      !/////////////////////////////////////////////////
      if(w)print*,'mulccvvd on ajoute deux trous',x1,y1,a,b
      !/////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,2,0)
      call caldfc(idist2,2,2)
      do ii=1,nlco
         do jj=1,ii
            i=ilc(ii)
            j=ilc(jj)
            apair_1=ilp(i,a)
            apair_2=ilp(j,a)
            bpair_1=ilp(i,b)
            bpair_2=ilp(j,b)
            if ((apair_1/=0).and.(bpair_2/=0)) then
               n=n+1
               ii1=ilp(i,a)
               ii2=ilp(j,b)
               iimax=max(ii1,ii2)
               iimin=min(ii1,ii2)
               iio=iimax*(iimax-1)/2+iimin
               if(ipp(iio)==0) then
                  n=n-1
                  cycle
               endif
               itp2(n)=abs(ipp(iio))
               if (a>b) then
                  ltp1(n)=1
               elseif (a==b) then
                  ltp1(n)=2
               endif
               if (i==j) then
                  ltp1(n)=ltp1(n)+2
                  itp1(n)=jj
               else
                  itp1(n)=num1(ii)+jj
               endif
               nntp(ltp1(n))=nntp(ltp1(n))+1
               if(w)print'(a,20i4)','Aa,b,i,j',a,b,i,j,n,
     *         ltp1(n),nntp(ltp1(n)),
     *         itp1(n),itp2(n)
            elseif ((apair_2/=0).and.(bpair_1/=0)) then
               n=n+1
               ii1=ilp(i,b)
               ii2=ilp(j,a)
               iimax=max(ii1,ii2)
               iimin=min(ii1,ii2)
               iio=iimax*(iimax-1)/2+iimin
               if(ipp(iio)==0) then
                  n=n-1
                  cycle
               endif
               itp2(n)=abs(ipp(iio))
               if (a>b) then
                  ltp1(n)=1
               elseif (a==b) then
                  ltp1(n)=2
               endif
               if (i==j) then
                  ltp1(n)=ltp1(n)+2
                  itp1(n)=jj
               else
                  itp1(n)=num1(ii)+jj
               endif
               nntp(ltp1(n))=nntp(ltp1(n))+1
               if(w)print'(a,20i4)','Ba,b,i,j',a,b,i,j,n,
     *         ltp1(n),nntp(ltp1(n)),
     *         itp1(n),itp2(n)
            endif
         enddo
      enddo
      if(n/=0) then
         call reoitp(n,4,nntp)
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         elmat(1:4)=(/'j+ i+ ->       | j+ i+ -> B+ A+',
     *   'j+ i+ ->       | j+ i+ -> B+=A+',
     *   'j+=i+ ->       | j+=i+ -> B+ A+',
     *   'j+=i+ ->       | j+=i+ -> B+=A+'/)
         call mula0(x,y,0,0)
         !
         if(w)print*,'icas1'
         call mula(aa1,'+-vv',elmat,n,2,1,'B-')
         if(ysp0)call mula(aa1,'-+vv',elmat,n,2,1,'A-','i-','j-')
         !
         if(w)print*,'icas2'
         call mula(aa1,'+-vv',elmat,n,4,1,'B-','j-')
         if(a/=b.or.x/=y) then
            if(ysp0)call mula(aa1,'-+vv',elmat,n,4,1,'A-','i-')
         else
            if(ysp0)call mula(aa1,'-+vv',elmat,n,2,1,'A-','i-')
         endif
         !
         if(a/=b.or.x/=y) then
            if(w)print*,'icas3'
            call mula(aa1,'+-vv',elmat,n,2,1,'B-','i-')
            if(ysp0)call mula(aa1,'-+vv',elmat,n,2,1,'A-','j-')
            !
            if(w)print*,'icas4'
            call mula(aa1,'+-vv',elmat,n,2,1,'B-','i-','j-')
            if(ysp0)call mula(aa1,'-+vv',elmat,n,2,1,'A-')
         endif
         !
         !==================
         !
         if(a/=b.and.x/=y) then
            if(w)print*,'icas5'
            ydir=.false.
            yoci((/x,y/))=.true.
            call mula(aa1-aa2,'++vv',elmat,n,1,jsgn)
            if(ysp0)
     *      call mula(aa1-aa2,'--vv',elmat,n,1,jsgn,'A-','B-','i-','j-')
            !
            if(w)print*,'icas6'
            call mula(aa1-aa2,'++vv',elmat,n,4,jsgn,'i-')
            if(ysp0)
     *      call mula(aa1-aa2,'--vv',elmat,n,4,jsgn,'A-','B-','j-')
            !
            if(w)print*,'icas7'
            call mula(aa1-aa2,'++vv',elmat,n,1,jsgn,'j-')
            if(ysp0)
     *      call mula(aa1-aa2,'--vv',elmat,n,1,jsgn,'A-','B-','i-')
            !
            if(w)print*,'icas8'
            call mula(aa1-aa2,'++vv',elmat,n,1,jsgn,'i-','j-')
            if(ysp0)call mula(aa1-aa2,'--vv',elmat,n,1,jsgn,'A-','B-')
            ydir=.true.
            yoci((/x,y/))=.false.
            !
            !==================
            !
            if(w)print*,'icas9'
            call mula(aa2,'+-vv',elmat,n,2,1,'A-')
            if(ysp0)call mula(aa2,'-+vv',elmat,n,2,1,'B-','i-','j-')
            !
            if(w)print*,'icasa'
            call mula(aa2,'+-vv',elmat,n,4,1,'A-','i-')
            if(ysp0)call mula(aa2,'-+vv',elmat,n,4,1,'B-','j-')
            !
            if(w)print*,'icasb'
            call mula(aa2,'+-vv',elmat,n,2,1,'A-','j-')
            if(ysp0)call mula(aa2,'-+vv',elmat,n,2,1,'B-','i-')
            !
            if(w)print*,'icasc'
            call mula(aa2,'+-vv',elmat,n,2,1,'A-','i-','j-')
            if(ysp0)call mula(aa2,'-+vv',elmat,n,2,1,'B-')
            !
         endif
      endif
 
 
      return
      end
