      subroutine mulcoovd(x1,i,j,a,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,i,i1,a1,j,j3
      !
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      ! 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-->a
      !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      x=num_oav(x1)
      a1=num_oav(a)
      j3=num_oav(j)
      i1=num_oav(i)
      call mulcoovd_1(x1,i,j,a,aa1,aa2,x,a1,j3,i1)
      if(iter==1.and.itest(22)==1) return
      call mulcoovd_2(x1,i,j,a,aa1,aa2,x,a1,j3,i1)
      call mulcoovd_3(x1,i,j,a,aa1,aa2,x,a1,j3,i1)
      return
      end
       subroutine mulcoovd_1(x1,i,j,a,aa1,aa2,x,a1,j3,i1)
      use module
      use mod_ena
      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,j,j3
      character(31) elmat(27)
      !///////////////////////////
      if(w)print*,'mulcoovd 0',x1,i,j,a
      !///////////////////////////
      call caldfc(idist,1,0)
      call caldfc(idist2,1,1)
      jlc1=ilc1(j)
      jl=il(i,a)
      ysp1=itest(21)==1
      ysp0=itest(21)==0
      if(jlc1/=0.and.jl/=0) then
         jsgna=1-mod(nocac0+num_oav(j)+num_oav(i),2)*2
         jsgnb=1-mod(nocbc0+num_oav(j)+num_oav(i),2)*2
         itp1(1)=jlc1
         itp2(1)=jl
         ltp1(1)=1
         nntp(1)=1
         n=1
         if(w)print'(a,20i4)','a,i,j',a,i,j,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)='J+    ->       | I+    -> A+   '
         aa3=aa1
         if(ysp1) aa3=aa3*2
         call mula0(x,0,0,0)
         !
         if(w)print*,'icas1',jsgna,jsgnb,aa3
         call mula(aa3,'+oov',elmat,1,1,jsgnb,'I-','A-')
         if(ysp0)call mula(aa3,'-oov',elmat,1,1,jsgna,'J-')
         !
         !================
         !
         aa3=aa1-aa2
         ! inclusion du fock dans le cas particulier nelac=1
         if(nelac==1.and.i==j) aa3=aa3+corrf2
         if(ysp1) aa3=aa3*2
         if(w)print*,'corrf2',corrf2
         if(w)print*,'icas3'
         call mula(aa3,'+oov',elmat,1,1,jsgna)
         if(ysp0)call mula(aa3,'-oov',elmat,1,1,jsgnb,'I-','A-','J-')
         !
         !================
         !
         aa3=aa2
         ! inclusion du fock dans le cas particulier nelac=1
         if(nelac==1.and.i==j) aa3=aa3-corrf2
         if(ysp1) aa3=aa3*2
         if(w)print*,'corrf2',corrf2
         if(w)print*,'icas5'
         jsgn=1-mod(num_oav(j)+num_oav(i),2)*2
         call mula(aa3,'+ovo',elmat,1,1,-jsgn,'I-','J-')
         if(ysp0)call mula(aa3,'-ovo',elmat,1,1,-jsgn,'A-','k-')
         !
      endif
 
 
 
      if(igener<3) return
      if(iter==1.and.itest(22)==1) return
      !/////////////////////////////////////////////////
      if(w)print*,'mulcoovd On va rajouter un trou k',x,i,j,a
      !/////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,2,0)
      call caldfc(idist2,2,1)
      jj=ilc1(j)
      if(jj/=0) then
         do kk=1,nlco
            k=ilc(kk)
            ipair2=ilp(i,a)
            icc2=kk
            if(ipair2==0) then
               icc2=ilc1(i)
               ipair2=ilp(k,a)
               if(ipair2==0.or.icc2==0) cycle
            endif
            if(ipc(ipair2,icc2)==0) cycle
            n=n+1
            if(j/=k) then
               itp1(n)=num1(max(kk,jj))+min(kk,jj)
            else
               itp1(n)=kk
            endif
            itp2(n)=abs(ipc(ipair2,icc2))
            call muladd_o_oo(k,j,i,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)
         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+ -> A+   ',
     *                   'J+ k+ ->       | I+ k+ -> A+   ',
     *                   'k+ J+ ->       | I+ k+ -> A+   ',
     *                   'J+ k+ ->       | k+ I+ -> A+   ',
     *                   'k+ J+ ->       | I+=k+ -> A+   ',
     *                   'J+=k+ ->       | I+ k+ -> A+   ',
     *                   'J+=k+ ->       | k+ I+ -> A+   ',
     *                   'J+ k+ ->       | I+=k+ -> A+   ',
     *                   'J+=k+ ->       | I+=k+ -> A+   '/)
 
         !
            jsgna=1-mod(nocac0+num_oav(j)+num_oav(i),2)*2
            jsgnb=1-mod(nocbc0+num_oav(j)+num_oav(i),2)*2
            aa3=aa1
            if(ysp1) aa3=aa3*2
            call mula0(x,0,0,0)
         !
            if(w)print*,'icas1',jsgna,jsgnb,aa3
            call mula(aa3,'+oov',elmat,n,9,jsgnb,'I-','A-')
            if(ysp0)call mula(aa3,'-oov',elmat,n,9,jsgna,'J-','k-')
         !
            if(w)print*,'icas2',jsgna,jsgnb,aa3
            call mula(aa3,'+oov',elmat,n,9,-jsgnb,'I-','A-','k-')
            if(ysp0)call mula(aa3,'-oov',elmat,n,9,-jsgna,'J-')
         !
         !
            aa3=aa1-aa2
            if(ysp1) aa3=aa3*2
            if(w)print*,'icas3'
            call mula(aa3,'+oov',elmat,n,9,-jsgna)
            if(ysp0)
     *      call mula(aa3,'-oov',elmat,n,9,-jsgnb,'I-','A-','J-','k-')
         !
            if(w)print*,'icas4'
            call mula(aa3,'+oov',elmat,n,9,jsgna,'k-')
            if(ysp0)call mula(aa3,'-oov',elmat,n,9,jsgnb,'I-','A-','J-')
         !
         !
            aa3=aa2
            if(ysp1) aa3=aa3*2
            if(w)print*,'icas5'
            jsgn=1-mod(num_oav(j)+num_oav(i),2)*2
            call mula(aa3,'+ovo',elmat,n,9,-jsgn,'I-','J-')
            if(ysp0)call mula(aa3,'-ovo',elmat,n,9,-jsgn,'A-','k-')
         !
            if(w)print*,'icas6'
            call mula(aa3,'+ovo',elmat,n,9,-jsgn,'I-','J-','k-')
            if(ysp0)call mula(aa3,'-ovo',elmat,n,9,-jsgn,'A-')
         !
         endif
      endif
      return
      end
       subroutine mulcoovd_2(x1,i,j,a,aa1,aa2,x,a1,j3,i1)
      use module
      use mod_ena
      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,j,j3
      character(31) elmat(27)
 
 
      if(igener<3) return
      !/////////////////////////////////////////////////
      if(w)print*,'mulcoovd on ajoute une particule',x1,i,j,a
      !/////////////////////////////////////////////////
      n=0
      nntp=0
      call caldfc(idist,1,1)
      call caldfc(idist2,1,2)
      ysp1=itest(21)==1
      ysp0=itest(21)==0
      do ipair=idebliscond(j),idebliscond(j+1)-1
         b=ilpair(2,liscond(ipair))
         if ((ilp(i,a)/=0).and.(ilc1(b)/=0)) then
            if(ipc(il(i,a),nlco+ilc1(b))==0) cycle
            n=n+1
            itp2(n)=abs(ipc(il(i,a),nlco+ilc1(b)))
            if (b<a) then
               ltp1(n)=2
            elseif(b==a) then
               ltp1(n)=3
            else
               ltp1(n)=1
            endif
            itp1(n)=il(j,b)
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','a,b,i,j',a,b,i,j,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         elseif((ilp(i,b)/=0).and.(ilc1(a)/=0)) then
            if(ipc(il(i,b),nlco+ilc1(a))==0) cycle
            n=n+1
            itp2(n)=abs(ipc(il(i,b),nlco+ilc1(a)))
            if (b<a) then
               ltp1(n)=2
            elseif(b==a) then
               ltp1(n)=3
            else
               ltp1(n)=1
            endif
            itp1(n)=il(j,b)
            nntp(ltp1(n))=nntp(ltp1(n))+1
            if(w)print'(a,20i4)','a,b,i,j',a,b,i,j,n,
     *      ltp1(n),nntp(ltp1(n)),
     *      itp1(n),itp2(n)
         endif
      enddo
      if(n==0) return
      call reoitp(n,27,nntp)
      if(w)print'(a,20i3)','ITP',itp1(1:n)
      if(w)print'(a,20i3)','ITP',itp2(1:n)
      elmat(1:3)=(/'J+    -> b+    | I+    -> A+ b+',
     *             'J+    -> b+    | I+    -> b+ A+',
     *             'J+    -> b+    | I+    -> b+=A+'/)
      call mula0(x,0,0,0)
      !
      jsgna=1-mod(nocac0+num_oav(j)+num_oav(i),2)*2
      jsgnb=1-mod(nocbc0+num_oav(j)+num_oav(i),2)*2
      if(w)print*,'jsgna',jsgna,aa1
      if(w)print*,'jsgnb',jsgnb,aa1
      aa3=aa1
      if(ysp1) aa3=aa3*2
      !
      if(w)print*,'icas1'
      call mula(aa3,'+oov',elmat,n,3,jsgnb,'A-','I-')
      if(ysp0)call mula(aa3,'-oov',elmat,n,3,jsgna,'b-','J-')
      !
      !
      if(w)print*,'icas2'
      call mula(aa3,'+oov',elmat,n,3,-jsgnb,'A-','I-','b-')
      if(ysp0)call mula(aa3,'-oov',elmat,n,3,-jsgna,'J-')
      !
      !==========================
      jsgn=1-mod(num_oav(j)+num_oav(i),2)*2
      !
      aa3=(aa1-aa2)
      ! inclusion du fock dans le cas particulier nelac=1
      if(nelac==1.and.i==j) aa3=aa3+corrf2
      if(ysp1) aa3=aa3*2
      !
      if(w)print*,'icas3'
      call mula(aa3,'+ovo',elmat,n,3,jsgn)
      if(ysp0)call mula(aa3,'-ovo',elmat,n,3,jsgn,'b-','J-','A-','I-')
      !
      !
      if(w)print*,'icas4'
      call mula(aa3,'+ovo',elmat,n,3,jsgn,'b-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,3,jsgn,'J-','A-','I-')
      !
      !==========================
      !
      jsgn=-1+mod(num_oav(j)+num_oav(i),2)*2
      if(w)print*,'i,j,jsgn,aa1,aa2',i,j,jsgn,aa1,aa2
      aa3=aa2
      ! inclusion du fock dans le cas particulier nelac=1
      if(nelac==1.and.i==j) aa3=aa3-corrf2
      if(ysp1) aa3=aa3*2
      !
      if(w)print*,'icas5'
      call mula(aa3,'+ovo',elmat,n,3,jsgn,'I-','J-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,3,jsgn,'b-','A-')
      !
      if(w)print*,'icas6'
      call mula(aa3,'+ovo',elmat,n,3,jsgn,'I-','J-','b-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,3,jsgn,'A-')
      !
      return
      end
       subroutine mulcoovd_3(x1,i,j,a,aa1,aa2,x,a1,j3,i1)
      use module
      use mod_ena
      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,j,j3
      character(31) elmat(27)
 
 
      !/////////////////////////////////////////////
      !On va rajouter une particule b et un trou k
      !det1 jk-->[x....]--->b det2 ik--->ab
      !/////////////////////////////////////////////
      if(igener<4) return
      if(w)print*,'mulcoovd on ajoute une particule et un trou',x,i,j,a
      if(w)print*,'aa1,aa2,aa1-aa2',aa1,aa2,aa1-aa2
      n=0
      nntp=0
      call caldfc(idist,2,1)
      call caldfc(idist2,2,2)
      ysp1=itest(21)==1
      ysp0=itest(21)==0
      if (ilc1(j)/=0) then
         do kpair=1,nlpairp
            k=ilpair(1,kpair)
            b=ilpair(2,kpair)
            if ((ilp(i,a)/=0)) then
               ipair=ilp(i,a)
               iimax=max(kpair,ipair)
               iimin=min(kpair,ipair)
               ii1=iimax*(iimax-1)/2+iimin
               if(ipp(ii1)==0) cycle
               if(ipc(kpair,ilc1(j))==0) cycle
               n=n+1
               itp2(n)=abs(ipp(ii1))
               itp1(n)=abs(ipc(kpair,ilc1(j)))
               call mulcoovd2(i,j,k,a,b,ltp1(n))
               nntp(ltp1(n))=nntp(ltp1(n))+1
               if(w)print'(a,20i4)','a,b,i,j,k',a,b,i,j,k,n,
     *         ltp1(n),nntp(ltp1(n)),
     *         itp1(n),itp2(n)
            elseif((ilp(i,b)/=0).and.(ilp(k,a)/=0)) then
               ipair=ilp(i,b)
               jpair=ilp(k,a)
               iimax=max(jpair,ipair)
               iimin=min(jpair,ipair)
               ii1=iimax*(iimax-1)/2+iimin
               if(ipp(ii1)==0) cycle
               if(ipc(ilp(k,b),ilc1(j))==0) cycle
               n=n+1
               itp1(n)=abs(ipc(ilp(k,b),ilc1(j)))
               itp2(n)=abs(ipp(ii1))
               call mulcoovd2(i,j,k,a,b,ltp1(n))
               nntp(ltp1(n))=nntp(ltp1(n))+1
               if(w)print'(a,20i4)','a,b,i,j,k',a,b,i,j,k,n,
     *         ltp1(n),nntp(ltp1(n)),
     *         itp1(n),itp2(n)
            endif
         enddo
      endif
      do jpair1=idebliscond(j),ifinliscond(j)
         jpair=liscond(jpair1)
         b=ilpair(2,jpair)
         do kk=1,nlco
            k=ilc(kk)
            if ((ilc1(j)/=0).and.(ilp(k,b)/=0)) cycle
            if ((ilp(i,a)/=0).and.(ilp(k,b)/=0)) then
               ipair=ilp(i,a)
               kpair=ilp(k,b)
               iimax=max(ipair,kpair)
               iimin=min(ipair,kpair)
               ii1=iimax*(iimax-1)/2+iimin
               if(ipp(ii1)==0) cycle
               if(ipc(ilp(j,b),ilc1(k))==0) cycle
               n=n+1
               itp1(n)=abs(ipc(ilp(j,b),ilc1(k)))
               itp2(n)=abs(ipp(ii1))
               call mulcoovd2(i,j,k,a,b,ltp1(n))
               nntp(ltp1(n))=nntp(ltp1(n))+1
               if(w)print'(a,20i4)','a,b,i,j,k',a,b,i,j,k,n,
     *         ltp1(n),nntp(ltp1(n)),
     *         itp1(n),itp2(n)
            elseif((ilp(k,a)/=0).and.(ilp(i,b)/=0)) then
               ipair=ilp(k,a)
               kpair=ilp(i,b)
               iimax=max(ipair,kpair)
               iimin=min(ipair,kpair)
               ii1=iimax*(iimax-1)/2+iimin
               if(ipp(ii1)==0) cycle
               if(ipc(ilp(j,b),ilc1(k))==0) cycle
               n=n+1
               itp1(n)=abs(ipc(ilp(j,b),ilc1(k)))
               itp2(n)=abs(ipp(ii1))
               call mulcoovd2(i,j,k,a,b,ltp1(n))
               nntp(ltp1(n))=nntp(ltp1(n))+1
               if(w)print'(a,20i4)','a,b,i,j,k',a,b,i,j,k,n,
     *         ltp1(n),nntp(ltp1(n)),
     *         itp1(n),itp2(n)
            endif
         enddo
      enddo
      call reoitp(n,27,nntp)
      if(w)print'(a,20i3)','ITP',itp1(1:n)
      if(w)print'(a,20i3)','ITP',itp2(1:n)
      !!
      !
      elmat(1:9)=(/'k+ J+ -> b+    | k+ I+ -> A+ b+',
     *             'J+ k+ -> b+    | I+ k+ -> A+ b+',
     *             'k+ J+ -> b+    | I+ k+ -> A+ b+',
     *             'J+ k+ -> b+    | k+ I+ -> A+ b+',
     *             'k+ J+ -> b+    | I+=k+ -> A+ b+',
     *             'J+=k+ -> b+    | I+ k+ -> A+ b+',
     *             'J+=k+ -> b+    | k+ I+ -> A+ b+',
     *             'J+ k+ -> b+    | I+=k+ -> A+ b+',
     *             'J+=k+ -> b+    | I+=k+ -> A+ b+'/)
      elmat(10:18)=elmat(1:9)
      elmat(19:27)=elmat(1:9)
      elmat(10:18)(27:31)='b+ A+'
      elmat(19:27)(27:31)='A+=b+'
      call mula0(x,0,0,0)
      !
      call debiil1(5)
      !
      aa3=aa1
      if(ysp1) aa3=aa3*2
      jsgna=1-mod(nocac0+num_oav(j)+num_oav(i),2)*2
      jsgnb=1-mod(nocbc0+num_oav(j)+num_oav(i),2)*2
      !
      if(w)print*,'icas1'
      call mula(aa3,'+oov',elmat,n,27,jsgnb,'A-','I-')
      if(ysp0)call mula(aa3,'-oov',elmat,n,27,jsgna,'J-','k-','b-')
      !
      !
      if(w)print*,'icas2'
      call mula(aa3,'+oov',elmat,n,27,-jsgnb,'A-','I-','b-')
      if(ysp0)call mula(aa3,'-oov',elmat,n,27,-jsgna,'J-','k-')
      !
      !
      if(w)print*,'icas3'
      call mula(aa3,'+oov',elmat,n,27,-jsgnb,'A-','I-','k-')
      if(ysp0)call mula(aa3,'-oov',elmat,n,27,-jsgna,'J-','b-')
      !
      !
      if(w)print*,'icas4'
      call mula(aa3,'+oov',elmat,n,27,jsgnb,'A-','I-','k-','b-')
      if(ysp0)call mula(aa3,'-oov',elmat,n,27,jsgna,'J-')
      !
      !============
      !
      !
      aa3=aa1-aa2
      if(ysp1) aa3=aa3*2
!      if(I==J) then
!         jsgna=-jsgna
!         jsgnb=-jsgnb
!      endif
      jsgn=1-mod(num_oav(i)+num_oav(j),2)*2
      if(w)print*,'icas5'
      call mula(aa3,'+ovo',elmat,n,27,jsgn)
      if(ysp0)
     *call mula(aa3,'-ovo',elmat,n,27,jsgn,'I-','A-','J-','k-','b-')
      !
      !
      if(w)print*,'icas6'
      call mula(aa3,'+ovo',elmat,n,27,jsgn,'b-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,27,jsgn,'I-','A-','J-','k-')
      !
      !
      if(w)print*,'icas7'
      call mula(aa3,'+ovo',elmat,n,27,jsgn,'k-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,27,jsgn,'I-','A-','J-','b-')
      !
      !
      if(w)print*,'icas8'
      call mula(aa3,'+ovo',elmat,n,27,jsgn,'k-','b-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,27,jsgn,'I-','A-','J-')
      !
      !============
      !
      aa3=aa2
      if(ysp1) aa3=aa3*2
      jsgn=-1+mod(num_oav(i)+num_oav(j),2)*2
      if(w)print*,'icas9'
      call mula(aa3,'+ovo',elmat,n,27,jsgn,'I-','J-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,27,jsgn,'A-','k-','b-')
      !
      !
      if(w)print*,'icasa'
      call mula(aa3,'+ovo',elmat,n,27,jsgn,'I-','J-','b-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,27,jsgn,'A-','k-')
      !
      !
      if(w)print*,'icasb'
      call mula(aa3,'+ovo',elmat,n,27,jsgn,'I-','J-','k-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,27,jsgn,'A-','b-')
      !
      !
      if(w)print*,'icasc'
      call mula(aa3,'+ovo',elmat,n,27,jsgn,'I-','J-','k-','b-')
      if(ysp0)call mula(aa3,'-ovo',elmat,n,27,jsgn,'A-')
      !
      call finiil1(5)
      !
 
      return
      end
       subroutine mulcoovd2(i,j,k,a,b,ltp1)
      integer(1) ltp1
      integer a,b
      if(i<j) then
         if(k<i) then
            ltp1=1
         else if(k==i) then
            ltp1=5
         else if(k<j) then
            ltp1=3
         else if(k==j) then
            ltp1=6
         else
            ltp1=2
         endif
      else if(i>j) then
         if(k<j) then
            ltp1=1
         else if(k==j) then
            ltp1=7
         else if(k<i) then
            ltp1=4
         else if(k==i) then
            ltp1=8
         else
            ltp1=2
         endif
      else
         if(k<j) then
            ltp1=1
         else if(k==j) then
            ltp1=9
         else
            ltp1=2
         endif
      endif
      if(b<a) ltp1=ltp1+9
      if(b==a) ltp1=ltp1+18
      return
      end
