      subroutine mulcvcvd(x1,a,y1,b,aa1,aa2)
      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,d
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! 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...](a) --> (a)      det2 : [y...](b) --> (b)
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      ! on n'ajoute rien
      ! conditions : a lie au CAS et b lie au CAS
      !
 
 
 
      !print*,'coucou'
      x=num_oav(x1)
      y=num_oav(y1)
      !symetrie de spin
      if(x==y.and.a==b) then
         ysp1=.false.
         ysp0=.true.
      else
         ysp1=itest(21)==1
 
         ysp0=itest(21)==0
      endif
      call mulcvcvd_1(x,a,y,b,aa1,aa2,ysp0,ysp1)
      if(igener<2) return
      call mulcvcvd_2(x,a,y,b,aa1,aa2,ysp0,ysp1)
      if(igener<3) return
      call mulcvcvd_3(x,a,y,b,aa1,aa2,ysp0,ysp1)
      call mulcvcvd_5(x,a,y,b,aa1,aa2,ysp0,ysp1)
      if(igener<4) return
      call mulcvcvd_4(x,a,y,b,aa1,aa2,ysp0,ysp1)
 
 
 
 
      return
      end
       subroutine mulcvcvd_1(x,a,y,b,aa1,aa2,ysp0,ysp1)
      use module
      use mod_ena
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer a,x1,y1,z1,b1,x,y,z,b,d
      character(31) elmat(1)
 
 
      !//////////////////////////////////
      if(w)print*,'mulcvcvd 0',x,a,y,b
      !//////////////////////////////////
      if((ilc1(a).ne.0).and.(ilc1(b).ne.0)) then
         call caldfc(idist,0,1)
         idist2=idist
         itp1(1)=ilc1(a)
         itp2(1)=ilc1(b)
         n=1
         ltp1(1)=1
         nntp(1)=1
         if(w)print'(a,20i4)','a,b,n',a,b,n,
     *   ltp1(n),nntp(ltp1(n)),
     *   itp1(n),itp2(n)
         elmat(1)='      -> A+    |       -> B+   '
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         !
         if(a/=b.or.x/=y) then
            !
            call mula0(x,0,y,0)
            !
            aa3=aa1
            if(ysp1) aa3=aa3*2
            if(w)print*,'icas1'
            call mula(aa3,'+v+v',elmat,1,1,1,'A-','B-')
            if(ysp0)call mula(aa3,'-v-v',elmat,1,1,1)
            !
            !=======================
            !
            aa3=aa1-aa2
            if(ysp1) aa3=aa3*2
            if(w)print*,'icas3'
            call mula(aa3,'+v+v',elmat,1,1,1)
            if(ysp0)call mula(aa3,'-v-v',elmat,1,1,1,'A-','B-')
            !
         endif
         !=======================
         !
         call mula0(x,0,0,y)
         aa3=aa2
         if(ysp1) aa3=aa3*2
         if(w)print*,'icas5'
         call mula(aa3,'+vv-',elmat,1,1,1,'A-')
         if(ysp0.and.(a/=b.or.x/=y))
     *   call mula(aa3,'-vv+',elmat,1,1,1,'B-')
         !
      endif
 
      !On va rajouter un trou i
      !////////////////////////////////////////////////
      if(w)print*,'mulcvcvd on ajoute un trou',x,a,y,b
      !////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,1)
         idist2=idist
      do ipair=idebliscond(a),idebliscond(a+1)-1
         i=ilpair(1,liscond(ipair))
         if (il(i,b)==0) cycle
         n=n+1
         itp1(n)=il(i,a)
         itp2(n)=il(i,b)
         ltp1(n)=1
         nntp(1)=nntp(1)+1
         if(w)print'(a,20i4)','a,b,i,n',a,b,i,n,
     *   ltp1(n),nntp(ltp1(n)),
     *   itp1(n),itp2(n)
      enddo
      if(n==0) return
      if(w)print'(a,20i3)','ITP',itp1(1:n)
      if(w)print'(a,20i3)','ITP',itp2(1:n)
      elmat(1)='i+    -> A+    | i+    -> B+   '
      if(a/=b.or.x/=y) then
         aa3=aa1
         if(ysp1) aa3=aa3*2
         call mula0(x,0,y,0)
         !
         if(w)print*,'icas1'
         call mula(aa3,'+v+v',elmat,n,1,1,'A-','B-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,1,1,'i-')
         !
         if(w)print*,'icas3'
         call mula(aa3,'+v+v',elmat,n,1,1,'A-','B-','i-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,1,1)
         !
         !===============
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         if(w)print*,'icas21'
         call mula(aa3,'+v+v',elmat,n,1,1)
         if(ysp0)call mula(aa3,'-v-v',elmat,n,1,1,'A-','B-','i-')
         !
         if(w)print*,'icas23'
         call mula(aa3,'+v+v',elmat,n,1,1,'i-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,1,1,'A-','B-')
         !
      endif
      !
      !============
      !
      call mula0(x,0,0,y)
      aa3=aa2
      if(ysp1) aa3=aa3*2
      if(w)print*,'icas31'
      call mula(aa3,'+vv-',elmat,n,1,1,'A-')
      if(ysp0)call mula(aa3,'-vv+',elmat,n,1,1,'B-','i-')
      !
      if(a/=b.or.x/=y) then
         if(w)print*,'icas34'
         call mula(aa3,'+vv-',elmat,n,1,1,'A-','i-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,1,1,'B-')
      endif
 
      return
      end
       subroutine mulcvcvd_2(x,a,y,b,aa1,aa2,ysp0,ysp1)
      use module
      use mod_ena
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer a,x1,y1,z1,b1,x,y,z,b,d
      character(31) elmat(9)
 
      !On va rajouter une particule d
      !det1 [x....](a)--->a d det2 [y...](b)--->b d
      !////////////////////////////////////////////////
      if(w)print*,'mulcvcvd on ajoute une particule',x,a,y,b
      !////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,0,2)
         idist2=idist
      ilca=ilc1(a)
      ilcb=ilc1(b)
      if(ilca/=0.and.ilcb/=0) then
         do b1=1,nlcv
            d=ilc(nlco+b1)
            n=n+1
            if (d>b) then
               itp2(n)=num1(ilc1(d))+ilc1(b)
               ltp1(n)=1
            elseif (d<b) then
               itp2(n)=num1(ilc1(b))+ilc1(d)
               ltp1(n)=2
            else
               itp2(n)=ilc1(d)
               ltp1(n)=3
            endif
            if (d>a) then
               itp1(n)=num1(ilc1(d))+ilc1(a)
            elseif (d<a) then
               itp1(n)=num1(ilc1(a))+ilc1(d)
               ltp1(n)=ltp1(n)+3
            else
               itp1(n)=ilc1(d)
               ltp1(n)=ltp1(n)+6
            endif
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','a,b,d',a,b,d,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         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)=(/'      -> A+ d+ |       -> B+ d+',
     *      '      -> A+ d+ |       -> d+ B+',
     *      '      -> A+ d+ |       -> B+=d+',
     *      '      -> d+ A+ |       -> B+ d+',
     *      '      -> d+ A+ |       -> d+ B+',
     *      '      -> d+ A+ |       -> B+=d+',
     *      '      -> A+=d+ |       -> B+ d+',
     *      '      -> A+=d+ |       -> d+ B+',
     *      '      -> A+=d+ |       -> B+=d+'/)
            if(a/=b.or.x/=y) then
               call mula0(x,0,y,0)
               !
               aa3=aa1
               if(ysp1) aa3=aa3*2
               if(w)print*,'icas1'
               call mula(aa3,'+v+v',elmat,n,9,1,'A-','B-')
               if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'d-')
               !
               if(w)print*,'icas2'
               call mula(aa3,'+v+v',elmat,n,9,1,'A-','B-','d-')
               if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1)
               !
               !=======================
               !
               aa3=aa1-aa2
               if(ysp1) aa3=aa3*2
               if(w)print*,'icas3'
               call mula(aa3,'+v+v',elmat,n,9,1)
               if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-','d-')
               !
               if(w)print*,'icas4'
               call mula(aa3,'+v+v',elmat,n,9,1,'d-')
               if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-')
               !
            endif
            !=======================
            !
            call mula0(x,0,0,y)
            aa3=aa2
            if(ysp1) aa3=aa3*2
            if(w)print*,'icas5'
            call mula(aa3,'+vv-',elmat,n,9,1,'A-')
            if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-','d-')
            !
            if(a/=b.or.x/=y) then
               if(w)print*,'icas6'
               call mula(aa3,'+vv-',elmat,n,9,1,'A-','d-')
               if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-')
            endif
            !
         endif
      endif
 
      return
      end
       subroutine mulcvcvd_3(x,a,y,b,aa1,aa2,ysp0,ysp1)
      use module
      use mod_ena
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer a,x1,y1,z1,b1,x,y,z,b,d
      character(31) elmat(27)
      !On va rajouter deux trous i et j
      !det1 ij--->[x....]a---->a det2 ij--->[y...]b--->b
      !///////////////////////////////////////////////////
      if(w)print*,'mulcvcvd on ajoute deux trous',x,a,y,b
      !///////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,2,1)
         idist2=idist
      do ipaira=idebliscond(a),ifinliscond(a)
         i=ilpair(1,liscond(ipaira))
         do jj=1,nlco
            j=ilc(jj)
            if(ilc1(i)/=0.and.ilp(j,a)/=0.and.j<i) cycle
            if ((ilp(i,b)/=0)) then
               if(ipc(ilp(i,a),ilc1(j))==0) cycle
               if(ipc(ilp(i,b),ilc1(j))==0) cycle
               n=n+1
               itp1(n)=abs(ipc(ilp(i,a),ilc1(j)))
               itp2(n)=abs(ipc(ilp(i,b),ilc1(j)))
               if(i<j) then
                  ltp1(n)=1
               else if(i==j) then
                  ltp1(n)=3
               else
                  ltp1(n)=2
               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 (ilp(j,b)/=0.and.ilc1(i)/=0) then
               if(ipc(ilp(i,a),ilc1(j))==0) cycle
               if(ipc(ilp(j,b),ilc1(i))==0) cycle
               n=n+1
               itp1(n)=abs(ipc(ilp(i,a),ilc1(j)))
               itp2(n)=abs(ipc(ilp(j,b),ilc1(i)))
               if(i<j) then
                  ltp1(n)=1
               else if(i==j) then
                  ltp1(n)=3
               else
                  ltp1(n)=2
               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,3,nntp)
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         elmat(1:3)=(/'i+ j+ -> A+    | i+ j+ -> B+   ',
     *   'j+ i+ -> A+    | j+ i+ -> B+   ',
     *   'i+=j+ -> A+    | i+=j+ -> B+   '/)
         if(a/=b.or.x/=y) then
            call mula0(x,0,y,0)
            aa3=aa1
            if(ysp1) aa3=aa3*2
         !
            if(w)print*,'icas1'
            call mula(aa3,'+v+v',elmat,n,3,1,'A-','B-')
            if(ysp0)call mula(aa3,'-v-v',elmat,n,3,1,'i-','j-')
         !
            if(w)print*,'icas2'
            call mula(aa3,'+v+v',elmat,n,3,1,'A-','B-','j-')
            if(ysp0)call mula(aa3,'-v-v',elmat,n,3,1,'i-')
         !
            if(w)print*,'icas3'
            call mula(aa3,'+v+v',elmat,n,2,1,'A-','B-','i-')
            if(ysp0)call mula(aa3,'-v-v',elmat,n,2,1,'j-')
         !
            if(w)print*,'icas4'
            call mula(aa3,'+v+v',elmat,n,3,1,'A-','B-','i-','j-')
            if(ysp0)call mula(aa3,'-v-v',elmat,n,3,1)
         !
         !==============
         !
            aa3=aa1-aa2
            if(ysp1) aa3=aa3*2
            if(w)print*,'icas21'
            call mula(aa3,'+v+v',elmat,n,3,1)
            if(ysp0)call mula(aa3,'-v-v',elmat,n,3,1,'A-','B-','i-','j-'
     &      )
         !
            if(w)print*,'icas22'
            call mula(aa3,'+v+v',elmat,n,3,1,'j-')
            if(ysp0)call mula(aa3,'-v-v',elmat,n,3,1,'A-','B-','i-')
         !
            if(w)print*,'icas23'
            call mula(aa3,'+v+v',elmat,n,2,1,'i-')
            if(ysp0)call mula(aa3,'-v-v',elmat,n,2,1,'A-','B-','j-')
         !
            if(w)print*,'icas24'
            call mula(aa3,'+v+v',elmat,n,3,1,'i-','j-')
            if(ysp0)call mula(aa3,'-v-v',elmat,n,3,1,'A-','B-')
         endif
         !
         !==============
         !
         aa3=aa2
         if(ysp1) aa3=aa3*2
         call mula0(x,0,0,y)
         if(w)print*,'icas31'
         call mula(aa3,'+vv-',elmat,n,3,1,'A-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,3,1,'B-','i-','j-')
         !
         if(w)print*,'icas32'
         call mula(aa3,'+vv-',elmat,n,3,1,'A-','j-')
         if(x/=y.or.a/=b) then
            if(ysp0)call mula(aa3,'-vv+',elmat,n,3,1,'B-','i-')
         else
            if(ysp0)call mula(aa3,'-vv+',elmat,n,2,1,'B-','i-')
         endif
         !
         if(a/=b.or.x/=y) then
            if(w)print*,'icas33'
            call mula(aa3,'+vv-',elmat,n,2,1,'A-','i-')
            if(ysp0)call mula(aa3,'-vv+',elmat,n,2,1,'B-','j-')
            !
            if(w)print*,'icas34'
            call mula(aa3,'+vv-',elmat,n,3,1,'A-','i-','j-')
            if(ysp0)call mula(aa3,'-vv+',elmat,n,3,1,'B-')
         endif
         !
      endif
 
 
 
 
      return
      end
       subroutine mulcvcvd_5(x,a,y,b,aa1,aa2,ysp0,ysp1)
      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,x,y,z,b,d,cc
!      dimension ntp(0:10),aal(4),isec1(4),isec2(4)
      character(31) elmat(27)
 
      !On va rajouter un trou i et une particule d
      !det1 i--->[x....]ad--->ad det2 i--->[z...]bd--->bd
      !//////////////////////////////////////////////////////////////
      if(w)print*,'mulcvcvd on ajoute un trou et une particule',x,a,y,b
      !//////////////////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,2)
         idist2=idist
      ic1=ilc1(a)+nlco
      ic2=ilc1(b)+nlco
      do kpair=1,nlpairp
         i=ilpair(1,kpair)
         d=ilpair(2,kpair)
         if(ilc1(b)/=0) then
            icc2=ilc1(b)+nlco
            ipair2=kpair
!         else if(ilc1(d)/=0.and.ilp(i,b)/=0) then
!            icc2=ilc1(d)
!            ipair2=ilp(i,b)
         else
            cycle
         endif
         if(ilc1(a)/=0.and.ilp(i,d)/=0) then
            icc1=ilc1(a)+nlco
            ipair1=ilp(i,d)
         else if(ilc1(d)/=0.and.ilp(i,a)/=0) then
            icc1=ilc1(d)+nlco
            ipair1=ilp(i,a)
         else
            cycle
         endif
         if(w)print*,'kpair',kpair,ipair1,ipair2,icc1,icc2
         call mulcvcvd_7(ipair1,ipair2,icc1,icc2,n,i,a,b,d,nntp)
      enddo
      do ipair=idebliscond(b),ifinliscond(b)
         ipair2=liscond(ipair)
         i=ilpair(1,ipair2)
         do icc2=1,nlcv
            d=ilc(nlco+icc2)
            if(ilp(i,d)/=0.and.ilc1(b)/=0) cycle  !deja
            if(ilc1(a)/=0.and.ilp(i,d)/=0) then
               icc1=ilc1(a)+nlco
               ipair1=ilp(i,d)
               if(w)print*,'i,d,ipair1',i,d,ipair1,ilc1(a)
            else if(ilc1(d)/=0.and.ilp(i,a)/=0) then
               icc1=ilc1(d)+nlco
               ipair1=ilp(i,a)
               if(w)print*,'i,a,ipair1',i,a,ipair1,ilc1(d)
            else
               cycle
            endif
            if(w)print*,'Kpair',kpair,ipair1,ipair2,icc1,icc2
            call mulcvcvd_7(ipair1,ipair2,icc1,icc2+nlco,n,i,a,b,d,nntp)
         enddo
      enddo
      if(n==0) return
      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)=(/'i+    -> A+ d+ | i+    -> B+ d+',
     *'i+    -> d+ A+ | i+    -> d+ B+',
     *'i+    -> A+ d+ | i+    -> d+ B+',
     *'i+    -> d+ A+ | i+    -> B+ d+',
     *'i+    -> A+=d+ | i+    -> d+ B+',
     *'i+    -> A+ d+ | i+    -> B+=d+',
     *'i+    -> d+ A+ | i+    -> B+=d+',
     *'i+    -> A+=d+ | i+    -> B+ d+',
     *'i+    -> A+=d+ | i+    -> B+=d+'/)
      if(a/=b.or.x/=y) then
         aa3=aa1
         if(ysp1) aa3=aa3*2
         call mula0(x,0,y,0)
         !
         if(w)print*,'icas1'
         call mula(aa3,'+v+v',elmat,n,9,1,'A-','B-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'i-','d-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+v+v',elmat,n,9,1,'A-','B-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'i-')
         !
         if(w)print*,'icas3'
         call mula(aa3,'+v+v',elmat,n,9,1,'A-','B-','i-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'d-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+v+v',elmat,n,9,1,'A-','B-','i-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1)
         !
         !===============
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         if(w)print*,'icas21'
         call mula(aa3,'+v+v',elmat,n,9,1)
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-','i-','d-')
         !
         if(w)print*,'icas22'
         call mula(aa3,'+v+v',elmat,n,9,1,'d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-','i-')
         !
         if(w)print*,'icas23'
         call mula(aa3,'+v+v',elmat,n,9,1,'i-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-','d-')
         !
         if(w)print*,'icas24'
         call mula(aa3,'+v+v',elmat,n,9,1,'i-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-')
         !
      endif
      !
      !============
      !
      call mula0(x,0,0,y)
      aa3=aa2
      if(ysp1) aa3=aa3*2
      if(w)print*,'icas31'
      call mula(aa3,'+vv-',elmat,n,9,1,'A-')
      if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-','i-','d-')
      !
      if(w)print*,'icas32'
      call mula(aa3,'+vv-',elmat,n,9,1,'A-','d-')
      if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-','i-')
      !
      if(a/=b.or.x/=y) then
         if(w)print*,'icas33'
         call mula(aa3,'+vv-',elmat,n,9,1,'A-','i-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-','d-')
      !
         if(w)print*,'icas34'
         call mula(aa3,'+vv-',elmat,n,9,1,'A-','i-','d-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-')
      endif
 
      return
      end
       subroutine mulcvcvd_4(x,a,y,b,aa1,aa2,ysp0,ysp1)
      use module
      use mod_ena
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer a,x1,y1,z1,b1,x,y,z,b,d
      character(31) elmat(27)
           !On va rajouter deux trous i et j et une particule d
      !det1 ij--->[x....]a--->d a det2 ij--->[z...]b--->d b
      if(w)print*,'1mulcvcvd on ajoute deux trous et une particule',
     *x,a,y,b
 
      n=0
      nntp=0
      call caldfc(idist,2,2)
         idist2=idist
      do ipair21=1,nlpairp
         i=ilpair(1,ipair21)
         d=ilpair(2,ipair21)
         do ipaira=idebliscond(b),ifinliscond(b)
            ipair22=liscond(ipaira)
            j=ilpair(1,ipair22)
            !
            if(ilp(i,b)/=0.and.ilp(j,d)/=0.and.i<j) cycle    !deja
            !
            ipair11=ipair21
            ipair12=ilp(j,a)
            if(ipair12==0) then
               ipair11=ilp(j,d)
               ipair12=ilp(i,a)
            endif
            if(ipair11==0.or.ipair12==0) cycle
            n=n+1
            iimax=max(ipair11,ipair12)
            iimin=min(ipair11,ipair12)
            ii1=iimax*(iimax-1)/2+iimin
            if(ipp(ii1)==0) then
               n=n-1
               cycle
            endif
            itp1(n)=abs(ipp(ii1))
            iimax=max(ipair21,ipair22)
            iimin=min(ipair21,ipair22)
            ii1=iimax*(iimax-1)/2+iimin
            if(ipp(ii1)==0) then
               n=n-1
               cycle
            endif
            itp2(n)=abs(ipp(ii1))
            call muladd_v_vv(d,b,a,ltp1(n))
            if(i==j) ltp1(n)=ltp1(n)+9
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i6)','a,b,i,j,d',a,b,i,j,d,n,
     *      ltp1(n),nntp(ltp1(n)),itp1(n),itp2(n)
         enddo
      enddo
      if(n==0) return
      call reoitp(n,18,nntp)
      if(w)print'(a,20(20i6,/))','ITP',itp1(1:n)
      if(w)print'(a,20(20i6,/))','ITP',itp2(1:n)
      elmat(1:18)=(/'i+ j+ -> A+ d+ | i+ j+ -> B+ d+',
     *'i+ j+ -> d+ A+ | i+ j+ -> d+ B+',
     *'i+ j+ -> A+ d+ | i+ j+ -> d+ B+',
     *'i+ j+ -> d+ A+ | i+ j+ -> B+ d+',
     *'i+ j+ -> A+=d+ | i+ j+ -> d+ B+',
     *'i+ j+ -> A+ d+ | i+ j+ -> B+=d+',
     *'i+ j+ -> d+ A+ | i+ j+ -> B+=d+',
     *'i+ j+ -> A+=d+ | i+ j+ -> B+ d+',
     *'i+ j+ -> A+=d+ | i+ j+ -> B+=d+',
     *'i+=j+ -> A+ d+ | i+=j+ -> B+ d+',
     *'i+=j+ -> d+ A+ | i+=j+ -> d+ B+',
     *'i+=j+ -> A+ d+ | i+=j+ -> d+ B+',
     *'i+=j+ -> d+ A+ | i+=j+ -> B+ d+',
     *'i+=j+ -> A+=d+ | i+=j+ -> d+ B+',
     *'i+=j+ -> A+ d+ | i+=j+ -> B+=d+',
     *'i+=j+ -> d+ A+ | i+=j+ -> B+=d+',
     *'i+=j+ -> A+=d+ | i+=j+ -> B+ d+',
     *'i+=j+ -> A+=d+ | i+=j+ -> B+=d+'/)
      if(a/=b.or.x/=y) then
         aa3=aa1
         if(ysp1) aa3=aa3*2
         call mula0(x,0,y,0)
         !
         if(w)print*,'icas1'
         call mula(aa3,'+v+v',elmat,n,9,1,'A-','B-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'j-','i-','d-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+v+v',elmat,n,9,1,'A-','B-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'j-','i-')
         !
         if(w)print*,'icas3'
         call mula(aa3,'+v+v',elmat,n,18,1,'A-','B-','i-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,18,1,'j-','d-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+v+v',elmat,n,18,1,'A-','B-','i-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,18,1,'j-')
         !
         if(w)print*,'icas5'
         call mula(aa3,'+v+v',elmat,n,9,1,'j-','A-','B-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'i-','d-')
         !
         if(w)print*,'icas6'
         call mula(aa3,'+v+v',elmat,n,9,1,'j-','A-','B-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'i-')
         !
         if(w)print*,'icas7'
         call mula(aa3,'+v+v',elmat,n,9,1,'j-','A-','B-','i-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'d-')
         !
         if(w)print*,'icas8'
         call mula(aa3,'+v+v',elmat,n,9,1,'j-','A-','B-','i-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1)
         !
         !================
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         if(w)print*,'icas21'
         call mula(aa3,'+v+v',elmat,n,9,1)
         if(ysp0)call mula
     *   (aa3,'-v-v',elmat,n,9,1,'A-','B-','j-','i-','d-')
         !
         if(w)print*,'icas22'
         call mula(aa3,'+v+v',elmat,n,9,1,'d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-','j-','i-')
         !
         if(w)print*,'icas23'
         call mula(aa3,'+v+v',elmat,n,18,1,'i-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,18,1,'A-','B-','j-','d-')
         !
         if(w)print*,'icas24'
         call mula(aa3,'+v+v',elmat,n,18,1,'i-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,18,1,'A-','B-','j-')
         !
         if(w)print*,'icas25'
         call mula(aa3,'+v+v',elmat,n,9,1,'j-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-','i-','d-')
         !
         if(w)print*,'icas26'
         call mula(aa3,'+v+v',elmat,n,9,1,'j-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-','i-')
         !
         if(w)print*,'icas27'
         call mula(aa3,'+v+v',elmat,n,9,1,'j-','i-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-','d-')
         !
         if(w)print*,'icas28'
         call mula(aa3,'+v+v',elmat,n,9,1,'j-','i-','d-')
         if(ysp0)call mula(aa3,'-v-v',elmat,n,9,1,'A-','B-')
      endif
      !
      !================
      !
      call mula0(x,0,0,y)
      aa3=aa2
      if(ysp1) aa3=aa3*2
      !
      if(w)print*,'icas31'
      call mula(aa3,'+vv-',elmat,n,9,1,'A-')
      if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'j-','B-','i-','d-')
      !
      if(w)print*,'icas32'
      call mula(aa3,'+vv-',elmat,n,9,1,'A-','d-')
      if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'j-','B-','i-')
      !
      if(w)print*,'icas33'
      call mula(aa3,'+vv-',elmat,n,18,1,'j-','A-')
      if(ysp0)call mula(aa3,'-vv+',elmat,n,18,1,'B-','i-','d-')
      !
      if(w)print*,'icas34'
      if(a/=b.or.x/=y) then
         call mula(aa3,'+vv-',elmat,n,18,1,'j-','A-','d-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,18,1,'B-','i-')
      else
         call mula(aa3,'+vv-',elmat,n,9,1,'j-','A-','d-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-','i-')
      endif
      !
      if(a/=b.or.x/=y) then
         if(w)print*,'icas35'
         call mula(aa3,'+vv-',elmat,n,9,1,'A-','i-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'j-','B-','d-')
         if(w)print*,'icas36'
         call mula(aa3,'+vv-',elmat,n,9,1,'j-','A-','i-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-','d-')
         !
         if(w)print*,'icas37'
         call mula(aa3,'+vv-',elmat,n,9,1,'A-','i-','d-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-','j-')
         !
         if(w)print*,'icas38'
         call mula(aa3,'+vv-',elmat,n,9,1,'A-','j-','i-','d-')
         if(ysp0)call mula(aa3,'-vv+',elmat,n,9,1,'B-')
      endif
      return
      end
 
 
       subroutine mulcvcvd_7(ipair1,ipair2,ic1,ic2,n,i,a,b,d,ntp)
      use module
      use mod_ena
      use mod_ena2
      use mod_itp
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer a,b,d
      dimension ntp(0:10)
      if(ipc(ipair1,ic1)==0) return
      if(ipc(ipair2,ic2)==0) return
      n=n+1
      if(w)print*,'n',n,ipair1,ic1
      if(w)print*,'n',n,ipair2,ic2
      if(w)print*,size(ipc)
      if(w)print*,ipc(ipair1,ic1)
      if(w)print*,ipc(ipair2,ic2)
      itp1(n)=abs(ipc(ipair1,ic1))
      itp2(n)=abs(ipc(ipair2,ic2))
      minab=min(a,b)
      maxab=max(a,b)
      call muladd_v_vv(d,b,a,ltp1(n))
      ntp(ltp1(n))=ntp(ltp1(n))+1
      if(w)print'(a,20i4)','a,b,i,d',a,b,i,d,n,ltp1(n),ntp(ltp1(n)),
     *itp1(n),itp2(n),ipair1,ipair2,ic1,ic2,num_oav(i),
     *ninac
      return
      end
