
  SUBROUTINE eclat(c,xeuv)
! reprendre cette ligne        subroutine eclat(c,xeuv)

!&E---------------------------------------------------------------------
!&E                 ***  ROUTINE eclat  ***
!&E
!&E ** Purpose : distribute the amount of matter transported by
!&E              each particle in the near-field procedure
!&E              within the meshes covered by the spot represented by the particle
!&E              and the meshes connected to its centre.
!&E
!&E ** Description :
!&E
!&E ** Called by : step2dxy, step2dyx
!&E
!&E ** External calls :
!&E
!&E ** Used ij-arrays : age, xprx, yprx, qte, dxu, h0, xeuv, surf
!&E
!&E ** Modified variables : c
!&E
!&E ** Reference :
!&E
!&E ** History :
!&E       !  2004-06-14
!&E       !  2011-11  (V. Garnier) Spatial extension of ssh(liminm2:limaxp2,ljminm2:ljmaxp2)
!&E
!&E---------------------------------------------------------------------
!! * Modules used
   USE parameters
   USE comvars2d

   IMPLICIT NONE

!! * Arguments
   REAL(kind=rsh),DIMENSION(liminm2:limaxp2,ljminm2:ljmaxp2),INTENT(in)     :: xeuv
   REAL(kind=rsh),DIMENSION(nb_var,kmax,liminm1:limaxp2,ljminm1:ljmaxp2),INTENT(inout) :: c

!! * Local declarations
   INTEGER                                                   :: i,j,ip,jp,i0,j0,ifois,idd,n,kount
   INTEGER,DIMENSION(-4:4,-4:4)                              :: kod,kxx,kyy
   REAL(kind=rsh)                                            :: cipjp,alfa,distx,disty,dist2,som,dsigma2
   REAL(kind=rsh),DIMENSION(-4:4,-4:4)                       :: prof
   REAL(kind=rsh),DIMENSION(-3:3,-3:3)                       :: dc

!!----------------------------------------------------------------------
!! * Executable part


   PRINT*,'this routine is not ready with MPI2D yet'
   PRINT*,'The simulation is stopped'
   STOP

   agemax=1800.0
   kount=ntot

   DO n=ntot,1,-1
     IF(age(n) >= agemax) THEN
       kount=ntot-1
       i0=NINT(xprx(n))
       j0=NINT(yprx(n))
       dsigma2=2.0*1.08e-6*(age(n)**2.34)/surf(i0,j0)

       DO jp=-4,4
         DO ip=-4,4
           kod(ip,jp)=0
           kxx(ip,jp)=0
           kyy(ip,jp)=0
           i=MAX(1,MIN(ip+i0,imax))
           j=MAX(1,MIN(jp+j0,jmax))
           IF(htx(i,j) > 0.0) kxx(ip,jp)=1
           IF(hty(i,j) > 0.0) kyy(ip,jp)=1
           prof(ip,jp)=h0(i,j)+xeuv(i,j)
         ENDDO
       ENDDO

       DO ifois=1,5
         idd=MIN(3,ifois)
         DO jp=-idd,idd
           DO ip=-idd,idd
             kod(0,0)=1
             kod(ip,jp)=kod(ip-1,jp)*kxx(ip-1,jp)+kod(ip+1,jp)*kxx(ip,jp) &
               +kod(ip,jp+1)*kyy(ip,jp)+kod(ip,jp-1)*kyy(ip,jp-1)
             kod(ip,jp)=MIN(1,kod(ip,jp))
           ENDDO
         ENDDO
       ENDDO

       kod(-3,3)=0
       kod(3,3)=0
       kod(3,-3)=0
       kod(-3,-3)=0

       som=0.0
       DO jp=-3,3
         DO ip=-3,3
           distx=xprx(n)-ip+1-i0
           disty=yprx(n)-jp+1-j0
           dist2=distx*distx+disty*disty
           alfa=dist2/dsigma2
           dc(ip,jp)=0.0
           IF(alfa < 80.0) THEN
             cipjp=REAL(kod(ip,jp))*EXP(-alfa)
             dc(ip,jp)=cipjp
             som=som+cipjp
           ENDIF
         ENDDO
       ENDDO

       IF(som < 1.0e-20)THEN
         dc(0,0)=qte(n)/(prof(0,0)*surf(i0,j0))
       ELSE
         DO jp=-3,3
           DO ip=-3,3
             dc(ip,jp)=dc(ip,jp)*qte(n)/(som*surf(ip+i0,jp+j0)*prof(ip,jp))
           ENDDO
         ENDDO
       ENDIF

       DO jp=j0-3,j0+3
         DO ip=i0-3,i0+3
           c(numcon(n),1,ip,jp)=c(numcon(n),1,ip,jp)+dc(ip-i0,jp-j0)
         ENDDO
       ENDDO

     ENDIF
   ENDDO

   ntot=kount



  END SUBROUTINE eclat

!!======================================================================

  SUBROUTINE particule(u,v)



   USE parameters, ONLY : rsh,liminm2,limaxp2,ljminm2,ljmaxp2

   IMPLICIT NONE

!! * Arguments
   REAL(kind=rsh),DIMENSION(liminm2:limaxp2,ljminm2:ljmaxp2), INTENT(in) :: u,v



  END SUBROUTINE particule
