      subroutine mulcccvd(x1,y1,z1,a,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,a1
      integer,allocatable,dimension(:) :: idetc1,idetc2,isgnc
      character(31) elmat(27)
      logical :: roger
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! 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...](kl) --> (b)      det2 : [z...](kl) --> a(b)
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
      ! on n'ajoute rien
      ! conditions : a lie au CAS
      !
      x=num_oav(x1)
      y=num_oav(y1)
      z=num_oav(z1)
      !symetrie de spin
      aa1=aaa1
      aa2=aaa2
      ysp1=itest(21)==1
      ysp0=itest(21)==0
      if(ysp1) then
         aa1=aa1*2
         aa2=aa2*2
      endif
      ! Signe
      jsgn=1
      if(x>y.and.x/=z) jsgn=-1
      !
      if(w)print*,'mulcccvd 0',x1,y1,z1,a
      call caldfc(idist,0,0)
      call caldfc(idist2,0,1)
      if(ilc1(a).ne.0) then
!         if(iter>=iterh)print*,'subr mulcccvd classhab(0,1)'
         if (iter>=iterh.and..not.ycalmat3) call classhab(0,1)
         itp1(1)=1
         itp2(1)=ilc1(a)
         n=1
         nntp(1)=1
         ltp1(1)=1
         if(w)print'(a,20i4)','a',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)='      ->       |       -> A+   '
         !
         aa3=aa1
         call mula0(x,y,z,0)
         !
         if(w)print*,'icas1'
         call mula(aa3,'+-+v',elmat,1,1,1,'A-')
         if(ysp0)call mula(aa3,'-+-v',elmat,1,1,1)
         !
         !================
         !
         if(x/=y) then
            aa3=aa1-aa2
            if(w)print*,'icas3'
            ydir=.false.
            yoci((/x,y,z/))=.true.
            if(x==z)yoci(z)=.false.
            call mula(aa3,'+++v',elmat,1,1,jsgn)
            if(ysp0)call mula(aa3,'---v',elmat,1,1,jsgn,'A-')
            ydir=.true.
            yoci((/x,y,z/))=.false.
            !
            !===============
            !
            call mula0(x,y,0,z)
            aa3=aa2
            if(w)print*,'icas5'
            call mula(aa3,'+-v-',elmat,1,1,1)
            if(ysp0)call mula(aa3,'-+v+',elmat,1,1,1,'A-')
            !
         endif
      endif
 
      hab=0
 
      if(itest(22)==1.and.iter==1) return
      !
      !On va rajouter un trou i
      !det1 i--->[xy....] det2 i--->[z...]a--->a
      !////////////////////////////////////////////
      if(w)print*,'mulcccvd on ajoute un trou',x,y,z,a
      !////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,0)
      call caldfc(idist2,1,1)
      do ii=1,nlco
         i=ilc(ii)
         if (il(i,a)==0) cycle
         n=n+1
         itp1(n)=ii
         itp2(n)=il(i,a)
      enddo
      if(n/=0) then
         nntp(1)=n
         ltp1(1:n)=1
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         elmat(1)='i+    ->       | i+    -> A+   '
         call mula0(x,y,z,0)
         !
         call mula(aa1,'+-+v',elmat,n,1,1,'A-')
         if(ysp0)call mula(aa1,'-+-v',elmat,n,1,1,'i-')
         !
         call mula(aa1,'+-+v',elmat,n,1,1,'A-','i-')
         if(ysp0)call mula(aa1,'-+-v',elmat,n,1,1)
         !
         !===============
         !
         if(x/=y) then
                 ydir=.false.
               yoci((/x,y,z/))=.true.
               if(x==z)yoci(z)=.false.
            call mula(aa1-aa2,'+++v',elmat,n,1,jsgn)
            if(ysp0)call mula(aa1-aa2,'---v',elmat,n,1,jsgn,'A-','i-')
            !
            call mula(aa1-aa2,'+++v',elmat,n,1,jsgn,'i-')
            if(ysp0)call mula(aa1-aa2,'---v',elmat,n,1,jsgn,'A-')
               ydir=.true.
               yoci((/x,y,z/))=.false.
            !
            !===============
            !
            call mula0(x,y,0,z)
            call mula(aa2,'+-v-',elmat,n,1,1)
            if(ysp0)call mula(aa2,'-+v+',elmat,n,1,1,'A-','i-')
            !
            call mula(aa2,'+-v-',elmat,n,1,1,'i-')
            if(ysp0)call mula(aa2,'-+v+',elmat,n,1,1,'A-')
         endif
         !
      endif
 
      !On va rajouter une particule b
      !det1 [xy....]--->(b) det2 [z...]a--->(b)a
      if(igener<2) return
      !/////////////////////////////////////////////////////
      if(w)print*,'mulcccvd on ajoute une particule',x,y,z,a
      !/////////////////////////////////////////////////////
      a1=ilc1(a)
      if (a1.ne.0) then
         n=0
         nntp=0
         call caldfc(idist,0,1)
         call caldfc(idist2,0,2)
         do b1=1,nlcv
            b=ilc(nlco+b1)
            n=n+1
            itp1(n)=b1
            if (b1>a1) then
               itp2(n)=num1(b1)+a1
            else if (b1<a1) then
               itp2(n)=num1(a1)+b1
            else
               itp2(n)=b1
            endif
            call muladd_o_o(a,b,ltp1(n))
            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)
         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)=(/'      -> b+    |       -> A+ b+',
     *                   '      -> b+    |       -> b+ A+',
     *                   '      -> b+    |       -> b+=A+'/)
            aa3=aa1
            call mula0(x,y,z,0)
            !
            if(w)print*,'icas1'
            call mula(aa3,'+-+v',elmat,n,3,1,'A-')
            if(ysp0)call mula(aa3,'-+-v',elmat,n,3,1,'b-')
            !
            if(w)print*,'icas2'
            call mula(aa3,'+-+v',elmat,n,3,1,'A-','b-')
            if(ysp0)call mula(aa3,'-+-v',elmat,n,3,1)
            !
            !================
            !
            if(x/=y) then
               aa3=aa1-aa2
               if(w)print*,'icas3'
               ydir=.false.
               yoci((/x,y,z/))=.true.
               if(x==z)yoci(z)=.false.
               call mula(aa3,'+++v',elmat,n,3,jsgn)
               if(ysp0)call mula(aa3,'---v',elmat,n,3,jsgn,'A-','b-')
               !
               if(w)print*,'icas4'
               call mula(aa3,'+++v',elmat,n,3,jsgn,'b-')
               if(ysp0)call mula(aa3,'---v',elmat,n,3,jsgn,'A-')
               ydir=.true.
               yoci((/x,y,z/))=.false.
               !
               !===============
               !
               call mula0(x,y,0,z)
               aa3=aa2
               if(w)print*,'icas5'
               call mula(aa3,'+-v-',elmat,n,3,1)
               if(ysp0)call mula(aa3,'-+v+',elmat,n,3,1,'A-','b-')
               !
               if(w)print*,'icas6'
               call mula(aa3,'+-v-',elmat,n,3,1,'b-')
               if(ysp0)call mula(aa3,'-+v+',elmat,n,3,1,'A-')
               !
            endif
         endif
      endif
 
      !
      !On va rajouter deux trous i et j
      !det1 ij--->[xy....] det2 ij--->[z...]a--->a
      !//////////////////////////////////////////////
      if(igener<3) return
      if(w)print*,'mulcccvd on ajoute deux trous',x,y,z,a
      !//////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,2,0)
      call caldfc(idist2,2,1)
      do ii=1,nlco
         do jj=ii,nlco
            i=ilc(ii)
            j=ilc(jj)
            if ((ilp(i,a)/=0).or.(ilp(j,a)/=0)) then
               n=n+1
               if(ii==jj) then
                  itp1(n)=jj
                  ltp1(n)=2
               else
                  itp1(n)=num1(jj)+ii
                  ltp1(n)=1
               endif
               if (ilp(i,a)/=0) then
                  if(ipc(ilp(i,a),ilc1(j))==0) then
                     n=n-1
                     cycle
                  endif
                  itp2(n)=abs(ipc(ilp(i,a),ilc1(j)))
               else
                  if(ipc(ilp(j,a),ilc1(i))==0) then
                     n=n-1
                     cycle
                  endif
                  itp2(n)=abs(ipc(ilp(j,a),ilc1(i)))
               endif
               nntp(ltp1(n))=nntp(ltp1(n))+1
               if(w)print'(a,20i4)','a,i,j',a,i,j,n,
     *         ltp1(n),nntp(ltp1(n)),
     *         itp1(n),itp2(n)
            endif
         enddo
      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+ j+ ->       | i+ j+ -> A+   ',
     *                'i+=j+ ->       | i+=j+ -> A+   '/)
         !
         call mula0(x,y,z,0)
         aa3=aa1
         !
         if(w)print*,'icas1'
         call mula(aa3,'+-+v',elmat,n,1,1,'A-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,1,1,'i-','j-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+-+v',elmat,n,2,1,'A-','j-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,2,1,'i-')
         !
         if(w)print*,'icas3'
         call mula(aa3,'+-+v',elmat,n,1,1,'A-','i-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,1,1,'j-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+-+v',elmat,n,1,1,'A-','i-','j-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,1,1)
         !
         !============
         !
         if(x/=y) then
            aa3=aa1-aa2
            !
            ydir=.false.
            yoci((/x,y,z/))=.true.
            if(x==z)yoci(z)=.false.
            if(w)print*,'icas5'
            call mula(aa3,'+++v',elmat,n,1,jsgn)
            if(ysp0)call mula(aa3,'---v',elmat,n,1,jsgn,'A-','i-','j-')
            !
            if(w)print*,'icas6'
            call mula(aa3,'+++v',elmat,n,2,jsgn,'j-')
            if(ysp0)call mula(aa3,'---v',elmat,n,2,jsgn,'A-','i-')
            !
            if(w)print*,'icas7'
            call mula(aa3,'+++v',elmat,n,1,jsgn,'i-')
            if(ysp0)call mula(aa3,'---v',elmat,n,1,jsgn,'A-','j-')
            !
            if(w)print*,'icas8'
            call mula(aa3,'+++v',elmat,n,1,jsgn,'i-','j-')
            if(ysp0)call mula(aa3,'---v',elmat,n,1,jsgn,'A-')
            ydir=.true.
            yoci((/x,y,z/))=.false.
            !
            !=================
            !
            call mula0(x,y,0,z)
            aa3=aa2
            if(w)print*,'icas9'
            call mula(aa3,'+-v-',elmat,n,1,1)
            if(ysp0)call mula(aa3,'-+v+',elmat,n,1,1,'A-','i-','j-')
            !
            if(w)print*,'icasa'
            call mula(aa3,'+-v-',elmat,n,2,1,'i-')
            if(ysp0)call mula(aa3,'-+v+',elmat,n,2,1,'A-','j-')
            !
            if(w)print*,'icasb'
            call mula(aa3,'+-v-',elmat,n,1,1,'j-')
            if(ysp0)call mula(aa3,'-+v+',elmat,n,1,1,'A-','i-')
            !
            if(w)print*,'icasc'
            call mula(aa3,'+-v-',elmat,n,1,1,'i-','j-')
            if(ysp0)call mula(aa3,'-+v+',elmat,n,1,1,'A-')
            !
         endif
      endif
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !On va rajouter un trou i et une particule b
      !det1 i--->[xy....]--->b det2 i--->[z...]a--->a(b)
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !//////////////////////////////////////////////////////////////
      if(w)print*,'mulcccvd on ajoute un trou et une particule'
     *,x1,y1,z1,a
      !//////////////////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,1)
      call caldfc(idist2,1,2)
      do j=1,nlpair
         i=ilpair(1,j)
         b=ilpair(2,j)
         if (ilc1(a)/=0.and.ilp(i,b)/=0) then
            if(ipc(ilp(i,b),nlco+ilc1(a))==0) cycle
            n=n+1
            if(b<a) then
               ltp1(n)=2
            else if(b>a) then
               ltp1(n)=1
            else
               ltp1(n)=3
            endif
            itp1(n)=il(i,b)
            itp2(n)=abs(ipc(ilp(i,b),nlco+ilc1(a)))
            nntp(ltp1(n))=nntp(ltp1(n))+1
         else
            ipairia=ilp(i,a)
            if(ipairia/=0) then
               ilc1b=ilc1(b)
               if(ilc1b/=0) then
                  if(ipc(ipairia,nlco+ilc1b)==0) cycle
                  n=n+1
                  if(b<a) then
                     ltp1(n)=2
                  else if(b>a) then
                     ltp1(n)=1
                  else
                     ltp1(n)=3
                  endif
                  itp1(n)=il(i,b)
                  itp2(n)=abs(ipc(ipairia,nlco+ilc1b))
                  nntp(ltp1(n))=nntp(ltp1(n))+1
               endif
            endif
         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)
         !
         elmat(1:3)=(/'i+    -> b+    | i+    -> A+ b+',
     *                'i+    -> b+    | i+    -> b+ A+',
     *                'i+    -> b+    | i+    -> b+=A+'/)
         !
         call mula0(x,y,z,0)
         aa3=aa1
         !
         if(w)print*,'icas1'
         if(ysp0)call mula(aa3,'+-+v',elmat,n,3,1,'A-')
         call mula(aa3,'-+-v',elmat,n,3,1,'i-','b-')
         !
         if(w)print*,'icas2'
         if(ysp0)call mula(aa3,'+-+v',elmat,n,3,1,'A-','i-')
         call mula(aa3,'-+-v',elmat,n,3,1,'b-')
         !
         if(w)print*,'icas3'
         if(ysp0)call mula(aa3,'+-+v',elmat,n,3,1,'A-','b-')
         call mula(aa3,'-+-v',elmat,n,3,1,'i-')
         !
         if(w)print*,'icas4'
         if(ysp0)call mula(aa3,'+-+v',elmat,n,3,1,'A-','i-','b-')
         call mula(aa3,'-+-v',elmat,n,3,1)
         !
         !============
         !
         if(x/=y) then
            aa3=aa1-aa2
            !
            ydir=.false.
            yoci((/x,y,z/))=.true.
            if(x==z)yoci(z)=.false.
            if(w)print*,'icas5'
            if(ysp0)call mula(aa3,'+++v',elmat,n,3,jsgn)
            call mula(aa3,'---v',elmat,n,3,jsgn,'A-','i-','b-')
            !
            if(w)print*,'icas6'
            if(ysp0)call mula(aa3,'+++v',elmat,n,3,jsgn,'b-')
            call mula(aa3,'---v',elmat,n,3,jsgn,'A-','i-')
            !
            if(w)print*,'icas7'
            if(ysp0)call mula(aa3,'+++v',elmat,n,3,jsgn,'i-')
            call mula(aa3,'---v',elmat,n,3,jsgn,'A-','b-')
            !
            if(w)print*,'icas8'
            if(ysp0)call mula(aa3,'+++v',elmat,n,3,jsgn,'i-','b-')
            call mula(aa3,'---v',elmat,n,3,jsgn,'A-')
            ydir=.true.
            yoci((/x,y,z/))=.false.
            !
            !=================
            !
            call mula0(x,y,0,z)
            aa3=aa2
            !w=.true.
            if(w)print*,'icas9'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,3,1)
            call mula(aa3,'-+v+',elmat,n,3,1,'A-','i-','b-')
            !w=.false.
            !
            if(w)print*,'icasa'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,3,1,'i-')
            call mula(aa3,'-+v+',elmat,n,3,1,'A-','b-')
            !
            if(w)print*,'icasb'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,3,1,'b-')
            call mula(aa3,'-+v+',elmat,n,3,1,'A-','i-')
            !
            if(w)print*,'icasc'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,3,1,'i-','b-')
            call mula(aa3,'-+v+',elmat,n,3,1,'A-')
            !
         endif
      endif
 
 
 
      !On va rajouter deux trous i et j et une particule b
      !det1 ij--->[xy....]--->b det2 ij--->[z...]a--->a(b)
      if(igener<4) return
      !/////////////////////////////////////////////////////////////////
      if(w)print*,'mulcccvd on ajoute deux trous et une particule'
     *,x1,y1,z1,a
      !/////////////////////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,2,1)
      call caldfc(idist2,2,2)
      do iipair2=idebliscond(a),ifinliscond(a)
         ipair21=liscond(iipair2)
         i=ilpair(1,ipair21)
         do ipair22=1,nlpairp
            j=ilpair(1,ipair22)
            b=ilpair(2,ipair22)
            if ((ilp(j,a)/=0).and.(ilp(i,b)/=0).and.(j<i)) cycle
            ipair1=ipair22
            icc1=ilc1(i)
            roger=.true.
            if(icc1==0) then
               icc1=ilc1(j)
               ipair1=ilp(i,b)
               roger=.false.
            endif
            if(icc1==0.or.ipair1==0) cycle
            n=n+1
            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))
            if (roger) then
               if(ipc(il(j,b),icc1)==0) then
                  n=n-1
                  cycle
               endif
               itp1(n)=abs(ipc(il(j,b),icc1))
            else
               if(ipc(il(i,b),icc1)==0) then
                  n=n-1
                  cycle
               endif
               itp1(n)=abs(ipc(il(i,b),icc1))
            endif
            if(b>a) then
               ltp1(n)=1
            else if(b<a) then
               ltp1(n)=2
            else
               ltp1(n)=3
            endif
            if(i==j) ltp1(n)=ltp1(n)+3
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','j,i,a,b',
     *      j,i,a,b,n,ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         enddo
      enddo
      if(n/=0) then
         call reoitp(n,6,nntp)
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         !
         elmat(1:6)=(/'i+ j+ -> b+    | i+ j+ -> A+ b+',
     *                'i+ j+ -> b+    | i+ j+ -> b+ A+',
     *                'i+ j+ -> b+    | i+ j+ -> A+=b+',
     *                'i+=j+ -> b+    | i+=j+ -> A+ b+',
     *                'i+=j+ -> b+    | i+=j+ -> b+ A+',
     *                'i+=j+ -> b+    | i+=j+ -> A+=b+'/)
         call mula0(x,y,z,0)
         aa3=aa1
         !
         if(w)print*,'icas1'
         call mula(aa3,'+-+v',elmat,n,6,1,'A-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,6,1,'i-','j-','b-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+-+v',elmat,n,6,1,'A-','i-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,6,1,'j-','b-')
         !
         if(w)print*,'icas3'
         call mula(aa3,'+-+v',elmat,n,3,1,'A-','j-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,3,1,'i-','b-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+-+v',elmat,n,6,1,'A-','b-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,6,1,'i-','j-')
         !
         if(w)print*,'icas5'
         call mula(aa3,'+-+v',elmat,n,6,1,'A-','i-','j-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,6,1,'b-')
         !
         if(w)print*,'icas6'
         call mula(aa3,'+-+v',elmat,n,6,1,'A-','i-','b-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,6,1,'j-')
         !
         if(w)print*,'icas7'
         call mula(aa3,'+-+v',elmat,n,3,1,'A-','j-','b-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,3,1,'i-')
         !
         if(w)print*,'icas8'
         call mula(aa3,'+-+v',elmat,n,6,1,'A-','i-','j-','b-')
         if(ysp0)call mula(aa3,'-+-v',elmat,n,6,1)
         !
         !==========================
         !
         if(x/=y) then
            aa3=aa1-aa2
            ydir=.false.
            yoci((/x,y,z/))=.true.
            if(x==z)yoci(z)=.false.
            !
            if(w)print*,'icas21'
            if(ysp0)call mula(aa3,'+++v',elmat,n,6,jsgn)
            call mula(aa3,'---v',elmat,n,6,jsgn,'A-','i-','j-','b-')
            !
            if(w)print*,'icas22'
            if(ysp0)call mula(aa3,'+++v',elmat,n,6,jsgn,'i-')
            call mula(aa3,'---v',elmat,n,6,jsgn,'A-','j-','b-')
            !
            if(w)print*,'icas23'
            if(ysp0)call mula(aa3,'+++v',elmat,n,3,jsgn,'j-')
            call mula(aa3,'---v',elmat,n,3,jsgn,'A-','i-','b-')
            !
            if(w)print*,'icas24'
            if(ysp0)call mula(aa3,'+++v',elmat,n,6,jsgn,'b-')
            call mula(aa3,'---v',elmat,n,6,jsgn,'A-','i-','j-')
            !
            if(w)print*,'icas25'
            if(ysp0)call mula(aa3,'+++v',elmat,n,6,jsgn,'i-','j-')
            call mula(aa3,'---v',elmat,n,6,jsgn,'A-','b-')
            !
            if(w)print*,'icas26'
            if(ysp0)call mula(aa3,'+++v',elmat,n,6,jsgn,'i-','b-')
            call mula(aa3,'---v',elmat,n,6,jsgn,'A-','j-')
            !
            if(w)print*,'icas27'
            if(ysp0)call mula(aa3,'+++v',elmat,n,3,jsgn,'j-','b-')
            call mula(aa3,'---v',elmat,n,3,jsgn,'A-','i-')
            !
            if(w)print*,'icas28'
            if(ysp0)call mula(aa3,'+++v',elmat,n,6,jsgn,'i-','j-','b-')
            call mula(aa3,'---v',elmat,n,6,jsgn,'A-')
            ydir=.true.
            yoci((/x,y,z/))=.false.
            !
            !==========================
            !
            call mula0(x,y,0,z)
            aa3=aa2
            !
            if(w)print*,'icas31'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,6,1)
            call mula(aa3,'-+v+',elmat,n,6,1,'A-','i-','j-','b-')
            !
            if(w)print*,'icas32'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,6,1,'i-')
            call mula(aa3,'-+v+',elmat,n,6,1,'A-','j-','b-')
            !
            if(w)print*,'icas33'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,3,1,'j-')
            call mula(aa3,'-+v+',elmat,n,3,1,'A-','i-','b-')
            !
            if(w)print*,'icas34'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,6,1,'b-')
            call mula(aa3,'-+v+',elmat,n,6,1,'A-','i-','j-')
            !
            if(w)print*,'icas35'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,6,1,'i-','j-')
            call mula(aa3,'-+v+',elmat,n,6,1,'A-','b-')
            !
            if(w)print*,'icas36'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,6,1,'i-','b-')
            call mula(aa3,'-+v+',elmat,n,6,1,'A-','j-')
            !
            if(w)print*,'icas37'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,3,1,'j-','b-')
            call mula(aa3,'-+v+',elmat,n,3,1,'A-','i-')
            !
            if(w)print*,'icas38'
            if(ysp0)call mula(aa3,'+-v-',elmat,n,6,1,'i-','j-','b-')
            call mula(aa3,'-+v+',elmat,n,6,1,'A-')
            !
         endif
      endif
      return
      end
 
 
