      subroutine mulcocvd(x1,i,y1,a,aa1,aa2)
      use module
      use mod_ena
      use mod_ena2
      use mod_itp
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer a,x1,y1,z1,b,b1,x,y,z,i,i1,a1,bb
      integer,allocatable,dimension(:) :: idetc1,idetc2,isgnc
      dimension ntp(0:6),aal(4),isec1(4),isec2(4)
      character(31) elmat(27)
      integer(1) li,la
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! 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 : [x...] -->       det2 :i[y] -->a
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !i et a doivent etre lies
      ! on n'ajoute rien
      !
 
      ! Habillage : tester si on vient de calmat3 -> ycalmat3=true
      ! donc pas d'habillage car c'est une monoexcitation
!      if(iter>=iterh)print*,'subr mulcocvd classhab(1,1)'
      if (iter>=iterh.and..not.ycalmat3) call classhab(1,1)
      !
      !signe : I --> A
      jsgna=1-2*mod(nocac0+ninac-num_oav(i),2)
      jsgnb=1-2*mod(nocbc0+ninac-num_oav(i),2)
      if(w)print*,'jsgna',i,num_oav(i),ninac,jsgna
      if(w)print*,'jsgnb',i,num_oav(i),ninac,jsgnb
      !signe : I --> C
      ksgn=1-2*mod(ninac-num_oav(i),2)
      if(w)print*,'ksgn',i,num_oav(i),ninac,jsgna
      !
      ysp1=itest(21)==1
      ysp0=itest(21)==0
      x=num_oav(x1)
      y=num_oav(y1)
      a1=num_oav(a)
      i1=num_oav(i)
 
      !//////////////////////////////////////////////////
      if(w)print*,'mulcocvd 0',x1,i,y1,a,aa1,aa2
      !//////////////////////////////////////////////////
      if (il(i,a)/=0) then
         call caldfc(idist,0,0)
         call caldfc(idist2,1,1)
         itp1(1)=1
         itp2(1)=il(i,a)
         ltp1(1)=1
         nntp(1)=1
         n=1
         if(w)print'(a,20i4)','i,a,n',i,a,n,
     *   ltp1(n),nntp(ltp1(n)),
     *   itp1(n),itp2(n)
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         elmat(1)='               | I+    -> A+   '
         call mula0(x,0,y,0)
         aa3=aa1
         if(ysp1) aa3=aa3*2
         !
         if(w)print*,'icas1'
         call mula(aa3,'+o+v',elmat,n,1,jsgnb,'A-','I-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,1,jsgna)
         !
         !==========================
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         !
         !signe: saut I->A: i
         !(ninac-I), nocac0
         if(w)print*,'icas3'
         call mula(aa3,'+o+v',elmat,n,1,jsgna)
         if(ysp0)call mula(aa3,'-o-v',elmat,n,1,jsgnb,'A-','I-')
         !
         !==========================
         !
         call mula0(x,0,0,y)
         aa3=aa2
         if(ysp1) aa3=aa3*2
         jsgn=1-mod(ninac-num_oav(i),2)*2
         !
         if(w)print*,'icas5'
         call mula(aa3,'+ov-',elmat,n,1,jsgn,'I-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,1,jsgn,'A-')
         !
      endif
 
      hab=0
 
      if(igener<3) return
      if(itest(22)==1.and.iter==1) return
      !///////////////////////////////////////////////////
      if(w)print*,'mulcocvd on ajoute un trou',x1,i,y1,a
      !///////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,0)
      call caldfc(idist2,2,1)
      do jj=1,nlco
         j=ilc(jj)
         if (ilp(i,a)/=0) then
            if(ipc(ilp(i,a),ilc1(j))==0) cycle
            n=n+1
            itp1(n)=ilc1(j)
            itp2(n)=abs(ipc(ilp(i,a),ilc1(j)))
            if(j<i) then
               ltp1(n)=1
            else if(j>i) then
               ltp1(n)=2
            else if(j==i) then
               ltp1(n)=3
            endif
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','a,j,i',a,j,i,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         elseif((ilp(j,a)/=0).and.(ilc1(i)/=0)) then
            if(ipc(ilp(j,a),ilc1(i))==0) cycle
            n=n+1
            itp1(n)=ilc1(j)
            itp2(n)=abs(ipc(ilp(j,a),ilc1(i)))
            if(j<i) then
               ltp1(n)=1
            else if(j>i) then
               ltp1(n)=2
            else if(j==i) then
               ltp1(n)=3
            endif
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','a,j,i',a,j,i,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         endif
      enddo
      if(n>0) then
         call reoitp(n,3,nntp)
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         if(w)print*,'aa1,aa2',aa1,aa2
         !
         elmat(1:3)=(/'j+             | j+ I+ -> A+   ',
     *                'j+             | I+ j+ -> A+   ',
     *                'j+             | I+=j+ -> A+   '/)
         call mula0(x,0,y,0)
         aa3=aa1
         if(ysp1) aa3=aa3*2
         jsgna=1-mod(nocac0+ninac-num_oav(i),2)*2
         jsgnb=1-mod(nocbc0+ninac-num_oav(i),2)*2
         !
         if(w)print*,'icas1'
         call mula(aa3,'+o+v',elmat,n,3,jsgnb,'A-','I-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,3,jsgna,'j-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+o+v',elmat,n,3,-jsgnb,'A-','I-','j-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,3,-jsgna)
         !
         !==========================
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         !
         !signe: saut I->A: i
         !(ninac-I), nocac0+1 (il y a 1 el suppl ds le CAS)
         if(w)print*,'icas3'
         if(w)print*,'nocac0,ninac,num_oav(i),jsgna',
     *   nocac0,ninac,num_oav(i),jsgna,aa3
         if(w)print*,'aa1,aa2',aa1,aa2
         call mula(aa3,'+o+v',elmat,n,3,-jsgna)
         if(ysp0)call mula(aa3,'-o-v',elmat,n,3,-jsgnb,'A-','I-','j-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+o+v',elmat,n,3,jsgna,'j-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,3,jsgnb,'A-','I-')
         !
         !==========================
         !
         call mula0(x,0,0,y)
         aa3=aa2
         if(ysp1) aa3=aa3*2
         jsgn=1-mod(ninac-num_oav(i),2)*2
         !
         if(w)print*,'icas5'
         call mula(aa3,'+ov-',elmat,n,3,jsgn,'I-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,3,jsgn,'A-','j-')
         !
         if(w)print*,'icas6'
         call mula(aa3,'+ov-',elmat,n,3,jsgn,'I-','j-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,3,jsgn,'A-')
         !
      endif
 
 
 
 
      !On va rajouter une particule b
      !det1 [x....]--->b det2 i--->[y]--->ab
      !///////////////////////////////////////////////////////////
      if(w)print*,'mulcocvd on ajoute une particule',x,i,y,a
      !///////////////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,0,1)
      call caldfc(idist2,1,2)
      do bb=1,nlcv
         b=ilc(nlco+bb)
         if (ilp(i,a)/=0) then
            if(ipc(ilp(i,a),nlco+ilc1(b))==0) cycle
            n=n+1
            itp1(n)=ilc1(b)
            itp2(n)=abs(ipc(ilp(i,a),nlco+ilc1(b)))
            if (b>a) then
               ltp1(n)=1
            elseif(b==a) then
               ltp1(n)=3
            else
               ltp1(n)=2
            endif
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,10i4)','i,a,b',i,a,b,n,ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         elseif((ilp(i,b)/=0).and.(ilc1(a)/=0)) then
            if(ipc(ilp(i,b),nlco+ilc1(a))==0) cycle
            n=n+1
            itp1(n)=ilc1(b)
            itp2(n)=abs(ipc(ilp(i,b),nlco+ilc1(a)))
            if (b>a) then
               ltp1(n)=1
            elseif(b==a) then
               ltp1(n)=3
            else
               ltp1(n)=2
            endif
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,10i4)','i,a,b',i,a,b,n,ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         endif
      enddo
      if(n>0) then
         call reoitp(n,3,nntp)
         if(w)print'(a,80i3)','ITP',itp1(1:n)
         if(w)print'(a,80i3)','ITP',itp2(1:n)
         !
         elmat(1:3)=(/'      -> b+    | I+    -> A+ b+',
     *                '      -> b+    | I+    -> b+ A+',
     *                '      -> b+    | I+    -> A+=b+'/)
         call mula0(x,0,y,0)
         aa3=aa1
         if(ysp1) aa3=aa3*2
         jsgna=1-mod(nocac0+ninac-num_oav(i),2)*2
         jsgnb=1-mod(nocbc0+ninac-num_oav(i),2)*2
         !
         if(w)print*,'icas1'
         call mula(aa3,'+o+v',elmat,n,3,jsgnb,'A-','I-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,3,jsgna,'b-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+o+v',elmat,n,3,-jsgnb,'A-','I-','b-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,3,-jsgna)
         !
         !==========================
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         !
         if(w)print*,'icas3'
         if(w)print*,'aa1,aa2',aa1,aa2
         ! Signe
         ! A) x/=y
         !1)       I------------------------------>A
         !                   x<---->y                    (-)
!         if(x/=y) then
!            jsgna=-jsgna
!            jsgnb=-jsgnb
!         endif
         !2) si A,I,b de meme spin :
         !         I-----ninac-i+nocac0-1--------->A     (-)
         !   sinon I-----ninac-i+nocac0----------->A
         !
         ! B) x=y
         !   si A,I,b de meme spin :
         !         I-----ninac-i+nocac0-1--------->A     (-)
         !   sinon I-----ninac-i+nocac0----------->A
         call mula(aa3,'+o+v',elmat,n,3,-jsgna)
         if(ysp0)call mula(aa3,'-o-v',elmat,n,3,-jsgnb,'A-','I-','b-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+o+v',elmat,n,3,jsgna,'b-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,3,jsgnb,'A-','I-')
         !
         !==========================
         !
         call mula0(x,0,0,y)
         aa3=aa2
         if(ysp1) aa3=aa3*2
         jsgn=1-mod(ninac-num_oav(i),2)*2
         !
         if(w)print*,'icas5'
         call mula(aa3,'+ov-',elmat,n,3,jsgn,'I-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,3,jsgn,'A-','b-')
         !
         if(w)print*,'icas6'
         call mula(aa3,'+ov-',elmat,n,3,jsgn,'I-','b-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,3,jsgn,'A-')
         !
      endif
 
 
      !On va rajouter une particule b et un trou j
      !det1 j--->[x....]--->b det2 ij--->[y]--->ab
      if(igener<4) return
      !////////////////////////////////////////////////////////////
      if(w)print*,'mulcocvd on ajoute une particule et un trou',x,i,y,a
      !////////////////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,1)
      call caldfc(idist2,2,2)
      do jpair=1,nlpair
         j=ilpair(1,jpair)
         b=ilpair(2,jpair)
         if (ilp(i,a)/=0.and.ilp(j,b)/=0) then
            n=n+1
            ipair=ilp(i,a)
            itp1(n)=ilp(j,b)
            iimax=max(ipair,jpair)
            iimin=min(ipair,jpair)
            ii1=iimax*(iimax-1)/2+iimin
            if(ipp(ii1)==0) then
               n=n-1
               cycle
            endif
            itp2(n)=abs(ipp(ii1))
            call muladd_o_o(j,i,li)
            call muladd_o_o(a,b,la)
            ltp1(n)=li+(la-1)*3
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,10i4)','I,j,a,b',
     *      i,j,a,b,n,ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         elseif((ilp(i,b)/=0).and.(ilp(j,a)/=0)) then
            n=n+1
            ipair=ilp(j,a)
            kpair=ilp(i,b)
            itp1(n)=il(j,b)
            iimax=max(kpair,ipair)
            iimin=min(kpair,ipair)
            ii1=iimax*(iimax-1)/2+iimin
            if(ipp(ii1)==0) then
               n=n-1
               cycle
            endif
            itp2(n)=abs(ipp(ii1))
            call muladd_o_o(j,i,li)
            call muladd_o_o(a,b,la)
            ltp1(n)=li+(la-1)*3
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,10i4)','i,j,a,b',
     *      i,j,a,b,n,ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         endif
      enddo
      if(n>0) then
         call reoitp(n,9,nntp)
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         !
         !
         elmat(1:9)=(/'j+    -> b+    | j+ I+ -> A+ b+',
     *                'j+    -> b+    | I+ j+ -> A+ b+',
     *                'j+    -> b+    | j+=I+ -> A+ b+',
     *                'j+    -> b+    | j+ I+ -> b+ A+',
     *                'j+    -> b+    | I+ j+ -> b+ A+',
     *                'j+    -> b+    | j+=I+ -> b+ A+',
     *                'j+    -> b+    | j+ I+ -> b+=A+',
     *                'j+    -> b+    | I+ j+ -> b+=A+',
     *                'j+    -> b+    | j+=I+ -> b+=A+'/)
         !
         jsgna=1-mod(ninac+nocac0+num_oav(i),2)*2
         jsgnb=1-mod(ninac+nocbc0+num_oav(i),2)*2
         if(w)print*,'aa1,aa2',aa1,aa2,noac,num_oav(i),jsgna,jsgnb
         call mula0(x,0,y,0)
         !
         aa3=aa1
         if(ysp1) aa3=aa3*2
         if(w)print*,'icas1'
         call mula(aa3,'+o+v',elmat,n,9,jsgnb,'I-','A-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,9,jsgna,'j-','b-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+o+v',elmat,n,9,-jsgnb,'I-','A-','b-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,9,-jsgna,'j-')
         !
         if(w)print*,'icas3'
         call mula(aa3,'+o+v',elmat,n,9,-jsgnb,'I-','A-','j-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,9,-jsgna,'b-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+o+v',elmat,n,9,jsgnb,'I-','A-','j-','b-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,9,jsgna)
         !
         !=================
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         if(w)print*,'icas5'
         call mula(aa3,'+o+v',elmat,n,9,jsgna)
         if(ysp0)
     *   call mula(aa3,'-o-v',elmat,n,9,jsgnb,'I-','A-','j-','b-')
         !
         if(w)print*,'icas6'
         call mula(aa3,'+o+v',elmat,n,9,-jsgna,'b-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,9,-jsgnb,'I-','A-','j-')
         !
         if(w)print*,'icas7'
         call mula(aa3,'+o+v',elmat,n,9,-jsgna,'j-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,9,-jsgnb,'I-','A-','b-')
         !
         if(w)print*,'icas8'
         call mula(aa3,'+o+v',elmat,n,9,jsgna,'j-','b-')
         if(ysp0)call mula(aa3,'-o-v',elmat,n,9,jsgnb,'I-','A-')
         !
         !=================
         !
         jsgn=1-mod(ninac-num_oav(i),2)*2
         aa3=aa2
         if(ysp1) aa3=aa3*2
         call mula0(x,0,0,y)
         if(w)print*,'icas9'
         call mula(aa3,'+ov-',elmat,n,9,jsgn,'I-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,9,jsgn,'A-','j-','b-')
         !
         if(w)print*,'icasa'
         call mula(aa3,'+ov-',elmat,n,9,jsgn,'I-','b-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,9,jsgn,'A-','j-')
         !
         if(w)print*,'icasb'
         call mula(aa3,'+ov-',elmat,n,9,jsgn,'I-','j-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,9,jsgn,'A-','b-')
         !
         if(w)print*,'icasc'
         call mula(aa3,'+ov-',elmat,n,9,jsgn,'I-','j-','b-')
         if(ysp0)call mula(aa3,'-ov+',elmat,n,9,jsgn,'A-')
         !
      endif
 
      return
      end
 
