      subroutine mulcocod(x1,i,y1,j,aa1,aa2)
      use module
      use mod_ena
      use mod_dim
      use mod_itp
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer i,x1,y1,j,i1,x,y,j3,a,b,bb
      integer,allocatable,dimension(:) :: idetc1,idetc2,isgnc
      dimension ntp(0:6),aal(4),isec1(4),isec2(4)
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! 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 : j[x...] -->       det2 : i[y...] -->
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      !
 
      !///////////////////////////////////////////
      if(w)print*,'entree mulcocod x1,i,y1,j',x1,i,y1,j
      !///////////////////////////////////////////
 
      x=num_oav(x1)
      y=num_oav(y1)
      i1=num_oav(i)
      j3=num_oav(j)
      !
      ! signe : saut i-j
      !symetrie de spin
      if(x==y.and.i==j) then
         ysp1=.false.
         ysp0=.true.
      else
         ysp1=itest(21)==1
         ysp0=itest(21)==0
      endif
      call mulcocod_1(x,i,y,j,aa1,aa2,i1,j3,ysp0,ysp1)
      if(igener<2) return
      call caldfc(idist,2,0)
      idist2=idist
      call mulcocod_2(x,i,y,j,aa1,aa2,i1,j3,ysp0,ysp1)
      if(igener<3) return
      call caldfc(idist,1,2)
      idist2=idist
      call mulcocod_3(x,i,y,j,aa1,aa2,i1,j3,ysp0,ysp1)
      call caldfc(idist,2,1)
      idist2=idist
      call mulcocod_6(x,i,y,j,aa1,aa2,i1,j3,ysp0,ysp1)
      if(igener<4) return
      call caldfc(idist,2,2)
      idist2=idist
      call mulcocod_5_2(x,i,y,j,aa1,aa2,i1,j3,ysp0,ysp1)
 
 
 
      return
      end
       subroutine mulcocod_1(x,i,y,j,aa1,aa2,i1,j3,ysp0,ysp1)
      use module
      use mod_ena
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer i,x1,y1,j,i1,x,y,j3,a,b,bb
      integer,allocatable,dimension(:) :: idetc1,idetc2,isgnc
      character(31) elmat(27)
 
      if(w)print*,'mulcocod 0',x,i,y,j
      ilci=ilc1(i)
      ilcj=ilc1(j)
      jsgn=-1+mod(num_oav(j)+num_oav(i),2)*2
      if ((ilci.ne.0).and.(ilcj.ne.0)) then
         call caldfc(idist,1,0)
         idist2=idist
         n=1
         nntp=0
         itp2(1)=ilc1(i)
         itp1(1)=ilc1(j)
         ltp1(1)=1
         nntp(1)=1
         if(w)print'(a,20i4)','i,j,k',i,j,n,
     *   ltp1(n),nntp(ltp1(n)),
     *   itp1(n),itp2(n)
         elmat(1)='J+    ->       | I+    ->      '
         if(i/=j.or.x/=y) then
            aa3=aa1
            if(ysp1) aa3=aa3*2
            ! inclusion du fock dans le cas particulier nelac=1
            if(nelac==1.and.i==j) aa3=aa3-corrf2
            call mula0(x,0,y,0)
            !
            if(w)print*,'icas1',jsgn,aa3
            call mula(aa3,'+o+o',elmat,n,1,jsgn,'I-','J-')
            if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn)
            !
            !==================
            !
            aa3=aa1-aa2
            if(ysp1) aa3=aa3*2
            ! inclusion du fock dans le cas particulier nelac=1
            if(nelac==1.and.i==j) aa3=aa3-corrf2
            if(w)print*,'icas3',jsgn,aa3,aa1,aa2
            call mula(aa3,'+o+o',elmat,n,1,jsgn)
            if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn,'I-','J-')
         endif
         !
         !==================
         !
         aa3=aa2
         if(ysp1) aa3=aa3*2
         call mula0(x,0,0,y)
         !
         if(w)print*,'icas5',jsgn,aa3
         call mula(aa3,'+oo-',elmat,n,1,-jsgn,'I-')
         if(ysp0.and.(x/=y.or.i/=j))
     *   call mula(aa3,'-oo+',elmat,n,1,-jsgn,'J-')
         !
      endif
 
      !///////////////////////////////////////////////////////
      if(w)print*,'mulcocod on ajoute une particule',x,i,y,j
      !///////////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,1)
      idist2=idist
      do ipair=idebliscond(i),idebliscond(i+1)-1
         a=ilpair(2,liscond(ipair))
         if (il(j,a)==0) cycle
         n=n+1
         itp1(n)=il(j,a)
         itp2(n)=il(i,a)
         ltp1(n)=1
         nntp(ltp1(n))=nntp(ltp1(n))+1
         if(w)print'(a,20i4)','i,j,a',i,j,a,n,
     *   ltp1(n),nntp(ltp1(n)),
     *   itp1(n),itp2(n)
      enddo
      if(n>0) then
         nntp(1)=n
         jsgn=-1+mod(num_oav(j)+num_oav(i),2)*2
         if(w)print'(a,20i3)','ITP',itp1(1:n)
         if(w)print'(a,20i3)','ITP',itp2(1:n)
         elmat(1)='J+    -> a+    | I+    -> a+   '
         if(i/=j.or.x/=y) then
            aa3=aa1
            if(ysp1) aa3=aa3*2
            ! inclusion du fock dans le cas particulier nelac=1
            if(nelac==1.and.i==j) aa3=aa3-corrf2
            call mula0(x,0,y,0)
            !
            if(w)print*,'icas1'
            call mula(aa3,'+o+o',elmat,n,1,jsgn,'I-','J-')
            if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn,'a-')
            !
            if(w)print*,'icas2'
            call mula(aa3,'+o+o',elmat,n,1,jsgn,'I-','J-','a-')
            if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn)
            !
            !=================
            !
            aa3=aa1-aa2
            if(ysp1) aa3=aa3*2
            ! inclusion du fock dans le cas particulier nelac=1
            if(nelac==1.and.i==j) aa3=aa3-corrf2
            !
            if(w)print*,'icas3'
            call mula(aa3,'+o+o',elmat,n,1,jsgn)
            if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn,'I-','J-','a-')
            !
            if(w)print*,'icas4'
            call mula(aa3,'+o+o',elmat,n,1,jsgn,'a-')
            if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn,'I-','J-')
         endif
         !
         !=================
         !
         aa3=aa2
         if(ysp1) aa3=aa3*2
         jsgn=1-mod(num_oav(j)+num_oav(i),2)*2
         call mula0(x,0,0,y)
         !
         if(w)print*,'icas5'
         call mula(aa3,'+oo-',elmat,n,1,jsgn,'I-')
         if(ysp0)call mula(aa3,'-oo+',elmat,n,1,jsgn,'J-','a-')
         !
         if(i/=j.or.x/=y) then
            if(w)print*,'icas6'
            call mula(aa3,'+oo-',elmat,n,1,jsgn,'I-','a-')
            if(ysp0)call mula(aa3,'-oo+',elmat,n,1,jsgn,'J-')
         endif
         !
      endif
      return
      end
       subroutine mulcocod_2(x,i,y,j,aa1,aa2,i1,j3,ysp0,ysp1)
      use module
      use mod_ena
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer i,x1,y1,j,i1,x,y,j3,a,b,bb
      integer,allocatable,dimension(:) :: idetc1,idetc2,isgnc
      character(31) elmat(27)
      !On va rajouter un trou k
      !det1 jk[x....]---> det2 ik[y...]--->
      !/////////////////////////////////////////////////////
      if(w)print*,'mulcocod on ajoute un trou',x,i,y,j
      !/////////////////////////////////////////////////////
      ilci=ilc1(i)
      ilcj=ilc1(j)
      if (ilci.ne.0.and.ilcj.ne.0) then
         n=0
         nntp=0
         do k1=1,nlco
            k=ilc(k1)
            ilck=ilc1(k)
            n=n+1
            if (ilck>ilci) then
               itp2(n)=num1(ilck)+ilci
            elseif (ilck<ilci) then
               itp2(n)=num1(ilci)+ilck
            else
               itp2(n)=ilck
            endif
            if (ilck>ilcj) then
               itp1(n)=num1(ilck)+ilcj
            else if (ilck<ilcj) then
               itp1(n)=num1(ilcj)+ilck
            else
               itp1(n)=ilck
            endif
            call muladd_o_oo(k,j,i,ltp1(n))
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','i,j,k',i,j,k,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)=(/'k+ J+ ->       | k+ I+ ->      ',
     *                   'J+ k+ ->       | I+ k+ ->      ',
     *                   'k+ J+ ->       | I+ k+ ->      ',
     *                   'J+ k+ ->       | k+ I+ ->      ',
     *                   'k+ J+ ->       | I+=k+ ->      ',
     *                   'J+=k+ ->       | I+ k+ ->      ',
     *                   'J+=k+ ->       | k+ I+ ->      ',
     *                   'J+ k+ ->       | I+=k+ ->      ',
     *                   'J+=k+ ->       | I+=k+ ->      '/)
 
            !
            jsgn=-1+2*mod(num_oav(i)+num_oav(j),2)
            if(i/=j.or.x/=y) then
               aa3=aa1
               if(ysp1) aa3=aa3*2
               call mula0(x,0,y,0)
               !
               if(w)print*,'icas1',jsgn,aa3
               call mula(aa3,'+o+o',elmat,n,9,jsgn,'I-','J-')
               if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn,'k-')
               !
               if(w)print*,'icas2',jsgn,aa3
               call mula(aa3,'+o+o',elmat,n,9,jsgn,'I-','J-','k-')
               if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn)
               !
               !==================
               !
               aa3=aa1-aa2
               if(ysp1) aa3=aa3*2
               if(w)print*,'icas3',jsgn,aa3,aa1,aa2
               call mula(aa3,'+o+o',elmat,n,9,jsgn)
               if(ysp0)
     *         call mula(aa3,'-o-o',elmat,n,9,jsgn,'I-','J-','k-')
               !
               if(w)print*,'icas4',jsgn,aa3,aa1,aa2
               call mula(aa3,'+o+o',elmat,n,9,jsgn,'k-')
               if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn,'I-','J-')
            endif
            !
            !==================
            !
            aa3=aa2
            if(ysp1) aa3=aa3*2
            call mula0(x,0,0,y)
            !
            if(w)print*,'icas5',jsgn,aa3
            call mula(aa3,'+oo-',elmat,n,9,-jsgn,'I-')
            if(ysp0.and.(x/=y.or.i/=j))
     *      call mula(aa3,'-oo+',elmat,n,9,-jsgn,'J-','k-')
            !
            if(w)print*,'icas6',jsgn,aa3
            call mula(aa3,'+oo-',elmat,n,9,-jsgn,'I-','k-')
            if(ysp0.and.(x/=y.or.i/=j))
     *      call mula(aa3,'-oo+',elmat,n,9,-jsgn,'J-')
            !
         endif
      endif
 
      return
      end
       subroutine mulcocod_3(x,i,y,j,aa1,aa2,i1,j3,
     *ysp0,ysp1)
      use module
      use mod_ena
      use mod_itp
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer i,x1,y1,j,i1,x,y,j3,a,b,bb
      integer,allocatable,dimension(:) :: idetc1,idetc2,isgnc
!      dimension ntp(0:6),aal(4),isec1(4),isec2(4)
      character(31) elmat(27)
 
      !On va rajouter deux particules a et b
      !det1 j--->[x....]---->ab det2 i--->[y...]--->ab
      !////////////////////////////////////////////////////////
      if(w)print*,'mulcocod on ajoute deux particules',x,i,y,j
      !////////////////////////////////////////////////////////
      n=0
      nntp=0
      do ipaira=idebliscond(i),ifinliscond(i)
         a=ilpair(2,liscond(ipaira))
         do bb=1,nlcv
            b=ilc(nlco+bb)
            nv=n
            if (ilp(j,a)/=0) then
               if (ilp(j,b)/=0.and.b<a.and.ilc1(a)/=0.and.ilp(i,b)/=0)
     &         cycle
               if(ipc(ilp(j,a),nlco+ilc1(b))==0) cycle
               if(ipc(ilp(i,a),nlco+ilc1(b))==0) cycle
               n=n+1
               itp1(n)=abs(ipc(ilp(j,a),nlco+ilc1(b)))
               itp2(n)=abs(ipc(ilp(i,a),nlco+ilc1(b)))
            elseif ((ilp(j,b)/=0).and.ilp(i,b)==0.and.ilc1(a)/=0) then
               if(ipc(ilp(j,b),nlco+ilc1(a))==0) cycle
               if(ipc(ilp(i,a),nlco+ilc1(b))==0) cycle
               n=n+1
               itp1(n)=abs(ipc(ilp(j,b),nlco+ilc1(a)))
               itp2(n)=abs(ipc(ilp(i,a),nlco+ilc1(b)))
            endif
            if(n/=nv) then
               if(a==b) then
                  ltp1(n)=2
               else
                  ltp1(n)=1
               endif
               nntp(ltp1(n))=nntp(ltp1(n))+1
               if(w)print'(a,20i4)','x,i,y,j,a,b',x,i,y,j,a,b,
     *         n,ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
            endif
         enddo
      enddo
      if(n==0) return
      call reoitp(n,2,nntp)
      if(w)print'(a,80i4)','ITP',itp1(1:n)
      if(w)print'(a,80i4)','ITP',itp2(1:n)
      jsgn=-1+mod(num_oav(j)+num_oav(i),2)*2
      elmat(1:2)=(/'J+    -> a+ b+ | I+    -> a+ b+',
     *             'J+    -> a+=b+ | I+    -> a+=b+'/)
      if(i/=j.or.x/=y) then
         aa3=aa1
         if(ysp1) aa3=aa3*2
         ! inclusion du fock dans le cas particulier nelac=1
         if(nelac==1.and.i==j) aa3=aa3+corrf2
         call mula0(x,0,y,0)
         !
         if(w)print*,'icas1'
         call mula(aa3,'+o+o',elmat,n,1,jsgn,'I-','J-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn,'a-','b-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+o+o',elmat,n,2,jsgn,'I-','J-','b-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,2,jsgn,'a-')
         !
         if(w)print*,'icas3'
         call mula(aa3,'+o+o',elmat,n,1,jsgn,'I-','J-','a-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn,'b-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+o+o',elmat,n,1,jsgn,'I-','J-','a-','b-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn)
         !
         !=================
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         ! inclusion du fock dans le cas particulier nelac=1
         if(nelac==1.and.i==j) aa3=aa3+corrf2
         !
         if(w)print*,'icas21'
         call mula(aa3,'+o+o',elmat,n,1,jsgn)
         if(ysp0)
     *   call mula(aa3,'-o-o',elmat,n,1,jsgn,'I-','J-','a-','b-')
         !
         if(w)print*,'icas22'
         call mula(aa3,'+o+o',elmat,n,2,jsgn,'b-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,2,jsgn,'I-','J-','a-')
         !
         if(w)print*,'icas23'
         call mula(aa3,'+o+o',elmat,n,1,jsgn,'a-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn,'I-','J-','b-')
         !
         if(w)print*,'icas24'
         call mula(aa3,'+o+o',elmat,n,1,jsgn,'a-','b-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,1,jsgn,'I-','J-')
         !
      endif
      !
      !=================
      !
      aa3=aa2
      if(ysp1) aa3=aa3*2
      call mula0(x,0,0,y)
      !
      if(w)print*,'icas31'
      call mula(aa3,'+oo-',elmat,n,1,-jsgn,'I-')
      if(ysp0)call mula(aa3,'-oo+',elmat,n,1,-jsgn,'J-','a-','b-')
      !
      if(w)print*,'icas32'
      call mula(aa3,'+oo-',elmat,n,2,-jsgn,'I-','b-')
      if(i/=j.or.x/=y) then
              if(ysp0)call mula(aa3,'-oo+',elmat,n,2,-jsgn,'J-','a-')
      else
              if(ysp0)call mula(aa3,'-oo+',elmat,n,1,-jsgn,'J-','a-')
      endif
      !
      if(i/=j.or.x/=y) then
         if(w)print*,'icas33'
         call mula(aa3,'+oo-',elmat,n,1,-jsgn,'I-','a-')
         if(ysp0)call mula(aa3,'-oo+',elmat,n,1,-jsgn,'J-','b-')
         !
         if(w)print*,'icas34'
         call mula(aa3,'+oo-',elmat,n,1,-jsgn,'I-','a-','b-')
         if(ysp0)call mula(aa3,'-oo+',elmat,n,1,-jsgn,'J-')
      endif
      !
      return
      end
       subroutine mulcocod_6(x,i,y,j,aa1,aa2,i1,j3,ysp0,ysp1)
      use module
      use mod_ena
      use mod_mula
      IMPLICIT REAL(8)(A-H,O-X,Z),logical(1)(y)
      integer i,x1,y1,j,i1,x,y,j3,a,b,bb
      integer,allocatable,dimension(:) :: idetc1,idetc2,isgnc
      character(31) elmat(27)
 
 
      !On va rajouter un trou k et une particule d
      !det1 jk--->[x....]---->a det2 ik--->[z...]--->a
      !////////////////////////////////////////////////////////////
      if(w)print*,'mulcocod on ajoute un trou et une particule',x,i,y,j
      !////////////////////////////////////////////////////////////
      !
      !signe : I --> J
      n=0
      nntp=0
      do ipair2=1,nlpairp
         k=ilpair(1,ipair2)
         a=ilpair(2,ipair2)
         icc2=ilc1(i)
         if(icc2==0) cycle
         icc1=ilc1(j)
         if(icc1/=0) then
            if(ipc(ipair2,icc1)==0) cycle
            if(ipc(ipair2,icc2)==0) cycle
            n=n+1
            itp1(n)=abs(ipc(ipair2,icc1))
            itp2(n)=abs(ipc(ipair2,icc2))
            call mulcocod62(i,j,k,ltp1(n))
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','a,i,j,k',a,i,j,k,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         else
            icc1=ilc1(k)
            ipair1=ilp(j,a)
            if(icc1==0.or.ipair1==0) cycle
            if(ipc(ipair1,icc1)==0) cycle
            if(ipc(ipair2,icc2)==0) cycle
            n=n+1
            itp1(n)=abs(ipc(ipair1,icc1))
            itp2(n)=abs(ipc(ipair2,icc2))
            call mulcocod62(i,j,k,ltp1(n))
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','1a,i,j,k',a,i,j,k,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         endif
      enddo
      do ipaira=idebliscond(i),ifinliscond(i)
         a=ilpair(2,liscond(ipaira))
         do kk=1,nlco
            k=ilc(kk)
            if(ilp(k,a)/=0.and.ilc1(i)/=0) cycle
            ipair1=ilp(j,a)
            icc1=kk
            if(icc1==0.or.ipair1==0) then
               ipair1=ilp(k,a)
               icc1=ilc1(j)
               if(icc1==0.or.ipair1==0) cycle
            endif
            if(ipc(ipair1,icc1)==0) cycle
            if(ipc(ilp(i,a),ilc1(k))==0)cycle
            n=n+1
            itp1(n)=abs(ipc(ipair1,icc1))
            itp2(n)=abs(ipc(ilp(i,a),ilc1(k)))
            call mulcocod62(i,j,k,ltp1(n))
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','2a,i,j,k',a,i,j,k,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         enddo
      enddo
      !print*,'n',n
      if(n>0) then
         call reoitp(n,9,nntp)
         if(w)print'(a,40i3)','ITP',itp1(1:n)
         if(w)print'(a,40i3)','ITP',itp2(1:n)
         !
         elmat(1:9)=(/'k+ J+ -> a+    | k+ I+ -> a+   ',
     *                'J+ k+ -> a+    | I+ k+ -> a+   ',
     *                'k+ J+ -> a+    | I+ k+ -> a+   ',
     *                'J+ k+ -> a+    | k+ I+ -> a+   ',
     *                'k+ J+ -> a+    | I+=k+ -> a+   ',
     *                'J+ k+ -> a+    | I+=k+ -> a+   ',
     *                'J+=k+ -> a+    | I+ k+ -> a+   ',
     *                'J+=k+ -> a+    | k+ I+ -> a+   ',
     *                'J+=k+ -> a+    | I+=k+ -> a+   '/)
         call mula0(x,0,0,y)
         jsgn=1-2*mod(num_oav(i)+num_oav(j),2)
         !
         aa3=aa2
         if(ysp1) aa3=aa3*2
         if(w)print*,'icas9'
         call mula(aa3,'+oo-',elmat,n,9,jsgn,'I-')
         if(ysp0)call mula(aa3,'-oo+',elmat,n,9,jsgn,'J-','k-','a-')
         !
         if(w)print*,'icasa'
         call mula(aa3,'+oo-',elmat,n,9,jsgn,'I-','a-')
         if(ysp0)call mula(aa3,'-oo+',elmat,n,9,jsgn,'J-','k-')
         !
         if(i/=j.or.x/=y) then
            if(w)print*,'icasb'
            call mula(aa3,'+oo-',elmat,n,9,jsgn,'I-','k-')
            if(ysp0)call mula(aa3,'-oo+',elmat,n,9,jsgn,'J-','a-')
            !
            if(w)print*,'icasc'
            call mula(aa3,'+oo-',elmat,n,9,jsgn,'I-','k-','a-')
            if(ysp0)call mula(aa3,'-oo+',elmat,n,9,jsgn,'J-')
         endif
         !
         !=================
         !
         if(x==y.and.i<=j) return
         if(x<=y.and.i==j) return
         jsgn=-jsgn
         call mula0(x,0,y,0)
         aa3=aa1
         if(ysp1) aa3=aa3*2
         !
         if(w)print*,'icas1'
         call mula(aa3,'+o+o',elmat,n,9,jsgn,'J-','I-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn,'k-','a-')
         !
         if(w)print*,'icas2'
         call mula(aa3,'+o+o',elmat,n,9,jsgn,'J-','I-','a-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn,'k-')
         !
         if(w)print*,'icas3'
         call mula(aa3,'+o+o',elmat,n,9,jsgn,'J-','I-','k-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn,'a-')
         !
         if(w)print*,'icas4'
         call mula(aa3,'+o+o',elmat,n,9,jsgn,'J-','I-','a-','k-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn)
         !
         !==========================
         !
         aa3=aa1-aa2
         if(ysp1) aa3=aa3*2
         if(w)print*,'icas5'
         call mula(aa3,'+o+o',elmat,n,9,jsgn)
         if(ysp0)
     *   call mula(aa3,'-o-o',elmat,n,9,jsgn,'J-','I-','k-','a-')
         !
         if(w)print*,'icas6'
         call mula(aa3,'+o+o',elmat,n,9,jsgn,'a-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn,'J-','I-','k-')
         !
         if(w)print*,'icas7'
         call mula(aa3,'+o+o',elmat,n,9,jsgn,'k-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn,'J-','I-','a-')
         !
         if(w)print*,'icas8'
         call mula(aa3,'+o+o',elmat,n,9,jsgn,'a-','k-')
         if(ysp0)call mula(aa3,'-o-o',elmat,n,9,jsgn,'J-','I-')
         !
      endif
      end
       subroutine mulcocod62(i,j,k,ltp1)
       integer(1) ltp1
      if(k<i) then
         if(k<j) then
            ltp1=1
         else if (k>j) then
            ltp1=4
         else
            ltp1=8
         endif
      else if(k>i) then
         if(k<j) then
            ltp1=3
         else if (k>j) then
            ltp1=2
         else
            ltp1=7
         endif
      else
         if(k<j) then
            ltp1=5
         else if (k>j) then
            ltp1=6
         else
            ltp1=9
         endif
      endif
      return
      end
 
 
