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

	SUBROUTINE ecrit_static(compt,dt)

c routine PRIVATE du module mod_static
c écriture des variables quasi-statiques et des coefficients pour dessins

c l'absence d'argument signale que l'appel a lieu après convergence et que le TdS
c a donc été actualisé (Kdes_stat=2)

c entrées OPTIONAL, l'absence d'argument signale que l'appel a lieu après convergence
c	compt: indice de l'itération
c	dt : pas temporel

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

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

	USE mod_donnees, ONLY : en_m23, kipp, m_ch, m_qs, m_tds, nchim, ne, ord_qs, secon6
	USE mod_etat, ONLY : etat
	USE mod_kind
	USE mod_nuc, ONLY: nuc
	USE mod_numerique, ONLY : bsp1dn, entre, no_croiss
	USE mod_opa, ONLY: opa
	USE mod_variables, ONLY : bp, bp_t, chim, chim_gram, ctem, ctep,
	1 ctet, cter, inter, jlim, knot, knotc, knot_t, knot_tds, lim, mc,
	2 mct, model_num, m_stat_t, n_ch, n_qs, n_qs_t, n_tds, q, qt, qt_t,
	3 q_t, r_stat_t, tds, x_tds, xt_tds

	REAL(kind=dp), INTENT(in), OPTIONAL :: dt
	INTEGER, INTENT(in), OPTIONAL :: compt

	REAL (kind=dp), DIMENSION(0,0) :: jac
	REAL (kind=dp), DIMENSION(n_qs) :: qi
	REAL (kind=dp), DIMENSION(nchim) :: comp, depsx, dxchim, xchim
	REAL (kind=dp), DIMENSION(ne) :: df, df1, f, f1
	REAL (kind=dp), DIMENSION(1) :: dft, ft
	REAL (kind=dp), DIMENSION(5) ::	epsilon

	REAL (kind=sp), DIMENSION(nchim,n_qs) :: xchimg4
	REAL (kind=sp), DIMENSION(n_qs) :: dmdq, Eg, En, esp, grad,
	1 gradad, gradrad, kappa, l4, l4_t, ps, ps_t, qs, ros,
	2 ts, ts_t, us

	REAL (kind=dp) :: be7, b8, depsro, depst, hh, n13, o15, f17
	REAL (kind=dp) :: dts, m, m23, p, p_t, t, t_t
	REAL (kind=dp) :: ro, drop,drot,drox,u,dup,dut,dux,
	1 delta,deltap,deltat,deltax,cp,dcpp,dcpt,dcpx,
	2 dgradadp,dgradadt,dgradadx,alfa,beta,gamma1
        REAL (kind=dp) :: gradd, gradadd, gradldxd, gradradd, grad_mud

	INTEGER, SAVE :: lq=2
	INTEGER :: i, i_deb, i_fin, n_des

	LOGICAL, SAVE :: init=.TRUE.

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

2000	FORMAT(8es10.3)

c initialisation
	IF(init)THEN
	 init=.FALSE.
	ENDIF

c nombre total de couches
	WRITE(*,3)n_qs
3	FORMAT(/,'nombre total de couches ',i5,/)

c les limites pour le zoom
        DO i=1,lim
	 WRITE(*,2)i,jlim(i)
2	 FORMAT('limite ZR/ZC',i2,' en',i5)
        ENDDO

c pour le zoom
	PRINT*,'entrer i_min, i_max Ex: 2 25'
	READ*,i_deb,i_fin
	i_fin=MIN(i_fin,n_qs)

c nombre de points de plot
	n_des=i_fin-i_deb+1
	PRINT*,'nombre de points pour le plot:',n_des

c abscisses (qi dp) et (qs sp) pour extration des variables et dessins
	qi(1)=q(i_deb) ; qs(1)=q(i_deb)
c	PRINT*,'i_deb,i_fin,n_des,n_inter',i_deb,i_fin,n_des,n_inter
c	WRITE(*,2000)pas,qi(1)
	DO i=2,n_des
	 qi(i)=qi(i-1)+1.d0
	 qs(i)=qs(i-1)+1.d0
	ENDDO

c dt en secondes
	IF(PRESENT(dt))dts=dt*secon6
c	IF(PRESENT(dt))PRINT*,'dt=',dt
c	IF(PRESENT(compt))PRINT*,'compt=',compt

c initialisation
	gradrad=HUGE(1.) ; gradad=TINY(1.)

c extraction des variables quasi-statiques
	Bt: DO i=1,n_des

c au temps t
	 CALL bsp1dn(ne,bp,q,qt,n_qs,ord_qs,knot,.TRUE.,qi(i),lq,f,df)
	 m=f(5) !m1/3 ou m2/3
	 dmdq(i)=df(5)
	 p=f(1) ; t=f(2) ; l4(i)=f(4)

c au temps t-dt
	 CALL inter('m',bp_t,q_t,qt_t,n_qs_t,knot_t,m,f1,df1,r_stat_t,m_stat_t)
	 p_t=f1(1) ; t_t=f1(2) ; l4_t(i)=f1(4)

c P, T, L
	 p=EXP(p) ; t=EXP(t) ;  ps(i)=p ; ts(i)=t
	 p_t=EXP(p_t) ; t_t=EXP(t_t) ;  ps_t(i)=p_t ; ts_t(i)=t_t
	 IF(en_m23)THEN
	  l4(i)=SQRT(ABS(l4(i)))**3 ; l4_t(i)=SQRT(ABS(l4_t(i)))**3
	  m23=m
	 ELSE
	  m23=m**2
	 ENDIF

c les gradients (gradldx ledoux)
	 CALL calc_grad(qi(i),gradd,gradadd,gradldxd,gradradd,grad_mud)
	 grad(i)=gradd
	 gradad(i)=gradadd
	 gradrad(i)=gradradd

c	 WRITE(*,2000)REAL(i,sp),qs(i),qi(i),grad(i),gradad(i),gradrad(i)

c la fonction d'espacement
	 esp(i)=espmt(qi(i))

c énergie nucléaire
	 CALL bsp1dn(nchim,chim,mc,mct,n_ch,m_ch,
	1 knotc,.TRUE.,MIN(m23,mc(n_ch)),lq,xchim,dxchim)
	 IF(no_croiss)PRINT*,'Pb. en 10 dans ecrit_static'
	 comp=xchim
	 CALL chim_gram(xchim,dxchim)
	 xchimg4(:,i)=xchim(:)
	 CALL etat(p,t,xchim,.FALSE.,ro,drop,drot,drox,u,dup,dut,dux,
	1 delta,deltap,deltat,deltax,cp,dcpp,dcpt,dcpx,
	2 gradadd,dgradadp,dgradadt,dgradadx,alfa,beta,gamma1)
	 ros(i)=ro ; us(i)=u
	 CALL nuc(t,ro,comp,dxchim,jac,.FALSE.,3,
	1 epsilon,depst,depsro,depsx,hh,be7,b8,n13,o15,f17)
	 En(i)=epsilon(1)

c opacité (b8,et,ero,hh	: vT)
	 CALL opa(xchim,t,ro,b8,be7,n13,hh)	!b8:kappa
	 kappa(i)=b8

c le modèle n'a pas encore convergé calcul du tds, cas kipp=.TRUE.
	 I0: IF(PRESENT(dt))THEN
	  Eg(i)=-(cp*(t-t_t)-delta/ro*(p-p_t))/dts

c l'absence d'argument signale que le modèle a convergé et que le tds a été actualisé
	 ELSE I0
	  CALL bsp1dn(1,tds,x_tds,xt_tds,n_tds,m_tds,knot_tds,.TRUE.,m,lq,ft,dft)
	  Eg(i)=-ft(1)/secon6
	 ENDIF I0
c         PRINT*,'i=',i
c	 WRITE(*,2000)xchim(:)
c	 WRITE(*,2000)xchimg4(:,i)

	ENDDO Bt

c grad
	IF(i_deb == 1)grad(1)=grad(2)

c dessins
	CALL plot_static

c	PAUSE 'ecrit_static'

	RETURN

	CONTAINS
	 INCLUDE 'plot_static.f'

	END SUBROUTINE ecrit_static