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

	SUBROUTINE tabul_TdS(dt,modif)

c routine Private du module mod_static

c tabulation du TdS appelée de resout à l'issue de la convergence

c entrée
c	dt: pas temporel

c sortie:
c	modif=.FALSE. : difficulté (abscisses non strictement croissantes)

c initialisation de l'interpolation de TdS/dt=-epsilon_g en fonction de m^1/3 ou m^2/3
c lors de l'utilisation, en raison de la perte/gain de masse, pour les couches externes,
c on ne tient pas compte des variations du TdS
c on ne tient pas compte de la diffèrence Pgaz, Ptot pour l'ènergie graviphique,

c croissante, r_stat et m_stat sont formés et rèactualisès dans coll_qs

c dans update tds ---> tds_t qui sert à l'initialisation les itérations NR du modèle
c quasi-statique et à l'estimation de la luminosité de répartition

c Auteur: P.Morel, laboratoire Lagrange, O.C.A., CESAM2k

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

	USE mod_donnees, ONLY : en_m23,	kipp, lisse, l_pertm, l_pertmt,
	1 m_ch, m_ptm, m_qs, m_tds, nchim, ne, npt_lisse, nucleo, ord_qs,  pturb
	USE mod_etat, ONLY: etat
	USE mod_kind
	USE mod_numerique, ONLY: bsp1dn, lisse_sum, no_croiss
        USE mod_variables, ONLY: bp, bp_t, chim, chim_gram,
	1 chim_t, inter, knot, knotc, knotc_t, knot_t, knot_ptm, knot_tds,
	2  mc, mc_t, mct, mct_t, mrot, mrott, mstar, m_zc, M_iner, m_stat, m_stat_t,
	3 n_ch, n_ch_t, n_ptm, n_qs, n_qs_t, n_tds, n_tds_t, old_ptm, q, qt, q_t, qt_t,
	4 r_stat_t, tds, x_ptm,	xt_ptm, x_tds, xt_tds_t, xt_tds

 	IMPLICIT NONE

	REAL (kind=dp), INTENT(in) :: dt
        LOGICAL, INTENT(out) :: modif

	REAL (kind=dp), DIMENSION(nchim) :: dxchim, xchim
	REAL (kind=dp), DIMENSION(ne) :: dfdq, f, f_t
	REAL (kind=dp), DIMENSION(1) :: dfm, fm

	REAL (kind=dp) :: alfa, beta, cp,
	1 dcpp, dcpt, dcpx, delta, deltap, deltat, deltax,
	2 dgradadp, dgradadt, dgradadx, dlnp, dlnt,
	3 drop, drot, drox, dup, dut, dux, gamma1, gradad, ma,
	5 pp, pp_t, ro, ro_t, tp, tp_t, u, u_t

	INTEGER, SAVE ::  lq=1
	INTEGER :: i, j

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

2000	FORMAT(8es10.3)

c	PRINT*,ALLOCATED(tds),ALLOCATED(x_tds),n_tds,n_tds_t
	n_tds=n_qs
	IF(n_tds /= n_tds_t)THEN
	 DEALLOCATE(tds,x_tds,xt_tds)
	 ALLOCATE(tds(1,n_tds),x_tds(n_tds),xt_tds(n_tds+m_tds))
	ENDIF

c TdS aux x_tds
	DO i=1,n_qs

c variables au temps âge+dt
	 CALL bsp1dn(ne,bp,q,qt,n_qs,ord_qs,knot,.TRUE.,q(i),lq,f,dfdq)
	 IF(no_croiss)PRINT*,'Pb. en 9 dans tabul_TdS'
	 IF(pturb)THEN	!avec pression turbulente 8 inconnues
	  pp=EXP(f(7))	!variable ln Pgaz
	 ELSE		!sans pression turbulente 7 inconnues
	  pp=EXP(f(1))
	 ENDIF
	 tp=EXP(f(2))	!variable ln T
	 x_tds(i)=f(5)	!variable m^2/3 ou m^1/3
	 IF(en_m23)THEN
	  ma=f(5)		!m^2/3
	 ELSE
	  ma=f(5)**2		!m^2/3
	 ENDIF

	 CALL bsp1dn(nchim,chim,mc,mct,n_ch,m_ch,
	1 knotc,.TRUE.,MAX(mct(1),MIN(ma,mc(n_ch))),lq,xchim,dxchim)
	 IF(no_croiss)PRINT*,'Pb. en 10 dans tabul_TdS'
	 CALL chim_gram(xchim,dxchim)
	 CALL etat(pp,tp,xchim,.FALSE.,ro,drop,drot,drox,u,dup,dut,dux,
	1 delta,deltap,deltat,deltax,cp,dcpp,dcpt,dcpx,
	2 gradad,dgradadp,dgradadt,dgradadx,alfa,beta,gamma1)

c s'il y a perte de masse
	 IF(l_pertm .OR. l_pertmt)THEN
	  CALL bsp1dn(1,old_ptm,x_ptm,xt_ptm,n_ptm,m_ptm,knot_ptm,
	1 .TRUE.,MIN(f(5),xt_ptm(knot_ptm)),lq,fm,dfm)		!masse au temps t
	  IF(no_croiss)PRINT*,'Pb. at 14 dans tabul_TdS'
	 ELSE
	  fm(1)=f(5)
	 ENDIF

c variables quasi-statiques au temps t
	 CALL inter('m',bp_t,q_t,qt_t,n_qs_t,knot_t,fm(1),f_t,
	1 dfdq,r_stat_t,m_stat_t)
	 IF(pturb)THEN	!avec pression turbulente 7 inconnues
	  dlnp=f(7)-f_t(7)
	  pp_t=EXP(f_t(7))
	 ELSE			!sans pression turbulente 6 inconnues
	  dlnp=f(1)-f_t(1)
	  pp_t=EXP(f_t(1))
	 ENDIF
	 dlnt=f(2)-f_t(2)
	 tp_t=EXP(f_t(2))

c approx. de Kippenhahan epsilon_g = -TdS
	 IF(kipp)THEN

c TdS, Kipp forme 2 : cp T ( dlnT - grad_ad dlnP ) / dt  4-27
	  tds(1,i)=cp*tp*(dlnt-gradad*dlnp)/dt

c TdS forme dU+PdV
	 ELSE
	  CALL bsp1dn(nchim,chim_t,mc_t,mct_t,n_ch_t,m_ch,
	1 knotc_t,.TRUE.,MAX(mc_t(1),MIN(ma,mc_t(n_ch_t))),lq,xchim,dxchim)
	  IF(no_croiss)PRINT*,'Pb. en 11 dans tabul_TdS'
	  CALL chim_gram(xchim,dxchim)		!X, Y, Z
	  CALL etat(pp_t,tp_t,xchim,.FALSE.,
	1 ro_t,drop,drot,drox,u_t,dup,dut,dux,
	2 delta,deltap,deltat,deltax,cp,dcpp,dcpt,dcpx,
	3 gradad,dgradadp,dgradadt,dgradadx,alfa,beta,gamma1)
	  tds(1,i)=(u-u_t-pp/ro**2*(ro-ro_t))/dt
	 ENDIF	!kipp
c	 WRITE(*,2000)tds(1,i),u,u_t,pp,pp_t,tp_t,ro,ro_t ; Pause'TdS'
	ENDDO

c vèrif. de la stricte croissance des abscisses pour les 40 dernières couches
	j=n_tds
	Btds: DO
	 IF(j <= n_qs-40)EXIT Btds
	 IF(x_tds(j) <= x_tds(j-1))n_tds=j-1
	 j=j-1
	ENDDO Btds
c	PRINT*,'tabul_TdS',n_qs,n_tds
c	WRITE(*,2000)tds(1,1:8) ; tds(1,1)=tds(1,2)
c	WRITE(*,2000)tds(1,1:8) !; PAUSE'tabul_TdS'

c tabulation du TdS au temps âge+dt et soft lissage, la tabulation du TdS ne servant
c qu'à amorcer le processus itératif
	CALL bsp1dn(1,tds,x_tds,xt_tds,n_tds,m_tds,knot_tds,.FALSE.,
	1 x_tds(1),lq,f,dfdq,.TRUE.)
	IF(no_croiss)PRINT*,'Pb. at 0 in tabul_TdS'
	modif=no_croiss

c lissage du TdS par moyennes glissantes intégrées
	IF(lisse)CALL lisse_sum(npt_lisse,1,tds,x_tds,xt_tds,m_tds,n_tds,knot_tds)

	RETURN

	END SUBROUTINE tabul_TdS