c*************************************************************************

	SUBROUTINE lisse_sumd(npt,id,nd,n,f,x,xt,m,nx,knot)

c Lissage des discontinuités, par moyennes glissantes intégrées avec sum_n
c subroutine PUBLIC du module mod_numérique

c !!! ATTENTION le tableau des splines f est modifié !!!!

c Auteur: P. Morel, Département J.D. Cassini, O.C.A.

c entrées
c	npt: 2npt+1=nb. de points pour la moyenne glissante
c	id : indices des discontinuités
c	nd : nombre de discontinuités
c	n: nombre de fonctions dans f
c	m: ordre des splines
c	nx: nombre d'abscisses

c entrées/sorties
c	knot: dimension du vecteur nodal = knot-m
c	f: coefficients des splines lissées
c	xt: vecteur nodal dimension=knot-m

c---------------------------------------------------------------------

	USE mod_kind

	IMPLICIT NONE

	REAL (kind=dp), INTENT(in), DIMENSION(:) :: x
	INTEGER, INTENT(in), DIMENSION(0:) :: id
	INTEGER, INTENT(in) :: m, n, nd, npt, nx
	REAL (kind=dp), ALLOCATABLE, INTENT(inout), DIMENSION(:,:) :: f
	REAL (kind=dp), ALLOCATABLE, INTENT(inout), DIMENSION(:) :: xt
	INTEGER, INTENT(inout) :: knot

	REAL (kind=dp), DIMENSION(n,nx) :: f0, sum_i
	REAL (kind=dp), DIMENSION(n) :: fx, dfdx, sum
	REAL (kind=dp):: bid

	INTEGER, SAVE :: l=1
	INTEGER :: i, imax, imin, j

c---------------------------------------------------------------------

2000	FORMAT(8es10.3)

c extraction des fonctions
	DO i=1,nx
	 CALL bsp1dn(n,f,x,xt,nx,m,knot,.TRUE.,x(i),l,fx,dfdx)
	 f0(:,i)=fx(:)
	ENDDO
c	PRINT*,'f0'
c	WRITE(*,2000)f0(1,:) ; WRITE(*,2000)f0(2,:)

c l'intégrale de la spline est une spline d'ordre m+1
c calcul des ci !!!! mis dans f !!!! algorithme 5.19 de Schumaker
	 DO j=1,n
	  bid=0.d0
	  DO i=1,knot-m
	   bid=bid+(xt(i+m)-xt(i))*f(j,i) ; f(j,i)=bid
	  ENDDO
	 ENDDO

c calcul des intégrales de x(1) à x(i <= nx)
	sum_i(:,1)=0.d0
	DO i=2,nx
	 CALL linf(x(i),xt,knot,l)
	 CALL schu58_n(n,f,x(i),xt,m+1,l,sum)
	 sum_i(:,i)=sum(:)/REAL(m,dp)
	ENDDO
c	WRITE(*,2000)sum_i(1,:) ; WRITE(*,2000)sum_i(2,:) ;PAUSE'sum_i'

c Allocation de f et xt pour la base de bsp1dn
	DEALLOCATE(f,xt) ; ALLOCATE(f(n,nx),xt(nx+m))
c	PRINT*,'id,nd,nx,npt',id,nd,nx,npt ; PAUSE'id'

c lissage sur 2npt+1=nb points centrés sur chaque discontinuité
	B1: DO j=1,nd

c pour chaque discontinuité à une distance > 2*npt du centre et de la surface
c	 PRINT*,id(j) < 2*npt,nx-id(j) < 2*npt ; PRINT*,id(j),npt
	 IF(id(j) < 2*npt .OR. nx-id(j) < 2*npt)CYCLE B1

c lissage par moyenne glissante intégrée
c	 PRINT*,'id(j)-npt,id(j)+npt',id(j)-npt,id(j)+npt
	 DO i=id(j)-npt,id(j)+npt
	  imin=i-npt ; imax=i+npt !; PRINT*,'i,imin,imax',i,imin,imax
	  f(:,i)=(sum_i(:,imax)-sum_i(:,imin))/(x(imax)-x(imin))
c	  WRITE(*,2000)f(1,i)
	 ENDDO
	ENDDO B1

c pour les autres points f0 --> f
	j=1 ; i=1
	B2: DO
c	 PRINT*,'avant=,id(j),id(j)-npt,i,j',id(j),id(j)-npt,i,j
	 IF(i == id(j)-npt)THEN
	  i=id(j)+npt+1 ; j=MIN(nd,j+1) !; PRINT*,'id(j), i,j',id(j),i,j
	 ELSE
c	  PRINT*,'i',i
	  f(:,i)=f0(:,i) ; i=i+1 ; IF(i > nx)EXIT B2
	 ENDIF
	ENDDO B2

c initalisation de la spline lissée
	CALL bsp1dn(n,f,x,xt,nx,m,knot,.FALSE.,x(1),l,fx,dfdx)

	RETURN

	END SUBROUTINE lisse_sumd