*=*=*=*= vdif_esa.html =*=*=*=*
SUBROUTINE vdif_esa

SUBROUTINE vdif_esa


      SUBROUTINE vdif_esa(dt,g,zlev,zlay,u,v,teta,cd,q2,long,km,kn)
      IMPLICIT NONE
c.......................................................................
#include "dimensions.h"
#include "dimphys.h"
c.......................................................................
c
c dt : pas de temps
c g  : g
c zlev : altitude a chaque niveau (interface inferieure de la couche
c        de meme indice)
c zlay : altitude au centre de chaque couche
c u,v : vitesse au centre de chaque couche
c       (en entree : la valeur au debut du pas de temps)
c teta : temperature potentielle au centre de chaque couche
c        (en entree : la valeur au debut du pas de temps)
c cd : cdrag
c      (en entree : la valeur au debut du pas de temps)
c q2 : $q^2$ au bas de chaque couche
c      (en entree : la valeur au debut du pas de temps)
c      (en sortie : la valeur a la fin du pas de temps)
c long : longueur de melange au bas de chaque couche
c        (en sortie : la valeur a la fin du pas de temps)
c km : diffusivite turbulente de quantite de mouvement (au bas de chaque
c      couche)
c      (en sortie : la valeur a la fin du pas de temps)
c kn : diffusivite turbulente des scalaires (au bas de chaque couche)
c      (en sortie : la valeur a la fin du pas de temps)
c
c.......................................................................
      REAL dt,g
      REAL zlev(ngridmx,nlayermx+1)
      REAL zlay(ngridmx,nlayermx)
      REAL u(ngridmx,nlayermx)
      REAL v(ngridmx,nlayermx)
      REAL teta(ngridmx,nlayermx)
      REAL cd(ngridmx)
      REAL q2(ngridmx,nlayermx+1)
      REAL long(ngridmx,nlayermx+1)
      REAL km(ngridmx,nlayermx+1)
      REAL kn(ngridmx,nlayermx+1)
c.......................................................................
c
c nlay : nombre de couches
c nlev : nombre de niveaux
c ngrid : nombre de points de grille
c unsdz : 1 sur l'epaisseur de couche
c unsdzdec : 1 sur la distance entre le centre de la couche et le
c            centre de la couche inferieure
c q : echelle de vitesse au bas de chaque couche
c     (valeur a la fin du pas de temps)
c
c.......................................................................
      INTEGER nlay,nlev,ngrid
      REAL unsdz(ngridmx,nlayermx)
      REAL unsdzdec(ngridmx,nlayermx+1)
      REAL q(ngridmx,nlayermx+1)
c.......................................................................
c
c qpre : q (valeur au debut du pas de temps)
c q2pre : $q^2$ (valeur au debut du pas de temps)
c qmys : q : solution stationnaire MY_2.0
c          (valeur a la fin du pas de temps)
c q2mys : q2 : solution stationnaire MY_2.0
c           (valeur a la fin du pas de temps)
c qcstat : q : solution stationnaire du probleme couple
c          (valeur a la fin du pas de temps)
c q2cstat : q2 : solution stationnaire du probleme couple
c           (valeur a la fin du pas de temps)
c
c.......................................................................
      REAL qpre(ngridmx,nlayermx+1)
      REAL q2pre(ngridmx,nlayermx+1)
      REAL qmys(ngridmx,nlayermx+1)
      REAL q2mys(ngridmx,nlayermx+1)
      REAL qcstat(ngridmx,nlayermx+1)
      REAL q2cstat(ngridmx,nlayermx+1)
c.......................................................................
c
c longblack : long calcule selon Blackadar
c             (valeur au debut du pas de temps)
c longstab : valeur de long utilisee dans les fonctions de stabilite
c            (valeur au debut du pas de temps)
c longdis : valeur de long utilisee dans le terme de dissipation
c            (valeur au debut du pas de temps)
c
c.......................................................................
      REAL longblack(ngridmx,nlayermx+1)
      REAL longstab(ngridmx,nlayermx+1)
      REAL longdis(ngridmx,nlayermx+1)
c.......................................................................
c
c kmpre : km (valeur au debut du pas de temps)
c kmq3 : terme en q^3 dans le developpement de kmpre
c        (valeur au debut du pas de temps)
c kmcstat : valeur de km solution stationnaire du systeme {q2 ; du/dz}
c           (valeur a la fin du pas de temps)
c knpre : kn (valeur au debut du pas de temps)
c knq3 : terme en q^3 dans le developpement de knpre
c mpre : frequence de cisaillement
c        (valeur au debut du pas de temps)
c m2pre : carre de la frequence de cisaillement
c         (valeur au debut du pas de temps)
c mcstat : valeur de m solution stationnaire du systeme {q2 ; du/dz}
c          (valeur a la fin du pas de temps)
c m2cstat : valeur de m2 solution stationnaire du systeme {q2 ; du/dz}
c           (valeur a la fin du pas de temps)
c m : valeur a la fin du pas de temps
c m2 : valeur a la fin du pas de temps
c n2pre : carre de la frequence de Brunt-Vaisala
c         (valeur au debut du pas de temps)
c n2 : valeur a la fin du pas de temps
c
c.......................................................................
      REAL kmpre(ngridmx,nlayermx+1)
      REAL kmq3(ngridmx,nlayermx+1)
      REAL kmcstat(ngridmx,nlayermx+1)
      REAL knpre(ngridmx,nlayermx+1)
      REAL knq3(ngridmx,nlayermx+1)
      REAL mpre(ngridmx,nlayermx+1)
      REAL m2pre(ngridmx,nlayermx+1)
      REAL mcstat(ngridmx,nlayermx+1)
      REAL m2cstat(ngridmx,nlayermx+1)
      REAL m(ngridmx,nlayermx+1)
      REAL m2(ngridmx,nlayermx+1)
      REAL n2pre(ngridmx,nlayermx+1)
      REAL n2(ngridmx,nlayermx+1)
c.......................................................................
c
c gn : intermediaire pour les coefficients de stabilite
c gnmin : borne inferieure de gn (-0.23 ou -0.28)
c gnmax : borne superieure de gn (0.0233)
c gninf : vrai si gn est en dessous de sa borne inferieure
c gnsup : vrai si gn est en dessus de sa borne superieure
c gm : drole d'objet bien utile
c ri : nombre de Richardson
c sn : coefficient de stabilite pour n
c snq2 : premier terme du developement limite de sn en q2
c sm : coefficient de stabilite pour m
c smq2 : premier terme du developement limite de sm en q2
c
c.......................................................................
      REAL gn(ngridmx,nlayermx+1)
      REAL gnmin
      REAL gnmax
      LOGICAL gninf(ngridmx,nlayermx+1)
      LOGICAL gnsup(ngridmx,nlayermx+1)
      REAL gm(ngridmx,nlayermx+1)
      REAL ri(ngridmx,nlayermx+1)
      REAL sn(ngridmx,nlayermx+1)
      REAL snq2(ngridmx,nlayermx+1)
      REAL sm(ngridmx,nlayermx+1)
      REAL smq2(ngridmx,nlayermx+1)
c.......................................................................
c
c kappa : consatnte de Von Karman (0.4)
c long0 : longueur de reference pour le calcul de long (160)
c a1,a2,b1,b2,c1 : constantes d'origine pour les  coefficients
c                  de stabilite (0.92/0.74/16.6/10.1/0.08)
c cn1,cn2 : constantes pour sn
c cm1,cm2,cm3,cm4 : constantes pour sm
c
c.......................................................................
      REAL kappa
      REAL long0
      REAL a1,a2,b1,b2,c1
      REAL cn1,cn2
      REAL cm1,cm2,cm3,cm4
c.......................................................................
c
c termq : termes en $q$ dans l'equation de q2
c termq3 : termes en $q^3$ dans l'equation de q2
c termqm2 : termes en $q*m^2$ dans l'equation de q2
c termq3m2 : termes en $q^3*m^2$ dans l'equation de q2
c
c.......................................................................
      REAL termq(ngridmx,nlayermx+1)
      REAL termq3(ngridmx,nlayermx+1)
      REAL termqm2(ngridmx,nlayermx+1)
      REAL termq3m2(ngridmx,nlayermx+1)
c.......................................................................
c
c q2min : borne inferieure de q2
c q2max : borne superieure de q2
c
c.......................................................................
      REAL q2min
      REAL q2max
c.......................................................................
c knmin : borne inferieure de kn
c kmmin : borne inferieure de km
c knconst : vrai si kn est independant de q2
c kmconst : vrai si km est independant de q2
c.......................................................................
      REAL knmin
      REAL kmmin
      LOGICAL knconst(ngridmx,nlayermx+1)
      LOGICAL kmconst(ngridmx,nlayermx+1)
c.......................................................................
      INTEGER ilay,ilev,igrid
      REAL tmp1,tmp2,tmp3,tmp4,tmp5,tmp6
c.......................................................................
      PARAMETER (kappa=0.4E+0)
      PARAMETER (long0=160.E+0)
      PARAMETER (gnmin=-0.28E+0)
      PARAMETER (gnmax=0.0233E+0)
      PARAMETER (a1=0.92E+0)
      PARAMETER (a2=0.74E+0)
      PARAMETER (b1=16.6E+0)
      PARAMETER (b2=10.1E+0)
      PARAMETER (c1=0.08E+0)
      PARAMETER (knmin=1.E-5)
      PARAMETER (kmmin=1.E-5)
      PARAMETER (q2min=1.E-3)
      PARAMETER (q2max=1.E+2)
      PARAMETER (nlay=nlayermx)
      PARAMETER (nlev=nlayermx+1)
      PARAMETER (ngrid=ngridmx)
c
      PARAMETER (
     &  cn1=a2*(1.E+0 -6.E+0 *a1/b1)
     &          )
      PARAMETER (
     &  cn2=-3.E+0 *a2*(6.E+0 *a1+b2)
     &          )
      PARAMETER (
     &  cm1=a1*(1.E+0 -3.E+0 *c1-6.E+0 *a1/b1)
     &          )
      PARAMETER (
     &  cm2=a1*(-3.E+0 *a2*((b2-3.E+0 *a2)*(1.E+0 -6.E+0 *a1/b1)
     &          -3.E+0 *c1*(b2+6.E+0 *a1)))
     &          )
      PARAMETER (
     &  cm3=-3.E+0 *a2*(6.E+0 *a1+b2)
     &          )
      PARAMETER (
     &  cm4=-9.E+0 *a1*a2
     &          )
c.......................................................................
      CHARACTER*100 nom
      INTEGER dim
      CHARACTER*100 titre
c.......................................................................
c les q2 au pas de temps precedent
c
      DO ilev=1,nlev
                                                      DO igrid=1,ngrid
        q2pre(igrid,ilev)=amax1(q2(igrid,ilev),q2min)
        qpre(igrid,ilev)=sqrt(q2pre(igrid,ilev))
                                                      ENDDO
      ENDDO
                                                      DO igrid=1,ngrid
      tmp1=cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2)
      q2pre(igrid,1)=b1**(2.E+0/3.E+0)*tmp1
      q2pre(igrid,1)=amax1(q2pre(igrid,1),q2min)
      qpre(igrid,1)=sqrt(q2pre(igrid,1))
      q2(igrid,1)=q2pre(igrid,1)
      q(igrid,1)=qpre(igrid,1)
                                                      ENDDO
c
c.......................................................................
c les increments verticaux
c
      DO ilay=1,nlay
                                                      DO igrid=1,ngrid
        unsdz(igrid,ilay)=1.E+0/(zlev(igrid,ilay+1)-zlev(igrid,ilay))
                                                      ENDDO
      ENDDO
                                                      DO igrid=1,ngrid
      unsdzdec(igrid,1)=1.E+0/(zlay(igrid,1)-zlev(igrid,1))
                                                      ENDDO
      DO ilay=2,nlay
                                                      DO igrid=1,ngrid
        unsdzdec(igrid,ilay)=1.E+0/(zlay(igrid,ilay)-zlay(igrid,ilay-1))
                                                      ENDDO
      ENDDO
                                                      DO igrid=1,ngrid
      unsdzdec(igrid,nlay+1)=1.E+0/(zlev(igrid,nlay+1)-zlay(igrid,nlay))
                                                      ENDDO
c
c.......................................................................
c calcul des fonctions de stabilite
c
                                                      DO igrid=1,ngrid
      m2pre(igrid,1)=(unsdzdec(igrid,1)
     &                   *u(igrid,1))**2
     &                 +(unsdzdec(igrid,1)
     &                   *v(igrid,1))**2
      mpre(igrid,1)=sqrt(m2pre(igrid,1))
                                                      ENDDO
c
c-----------------------------------------------------------------------
      DO ilev=2,nlev-1
                                                      DO igrid=1,ngrid
c-----------------------------------------------------------------------
c
        n2pre(igrid,ilev)=g*unsdzdec(igrid,ilev)
     &                   *(teta(igrid,ilev)-teta(igrid,ilev-1))
     &                   /(teta(igrid,ilev)+teta(igrid,ilev-1)) *2.E+0
        m2pre(igrid,ilev)=(unsdzdec(igrid,ilev)
     &                     *(u(igrid,ilev)-u(igrid,ilev-1)))**2
     &                   +(unsdzdec(igrid,ilev)
     &                     *(v(igrid,ilev)-v(igrid,ilev-1)))**2
        mpre(igrid,ilev)=sqrt(m2pre(igrid,ilev))
        tmp1=kappa*(zlev(igrid,ilev)-zlev(igrid,1))
        longblack(igrid,ilev)=tmp1/(1.E+0 + tmp1/long0)
        gn(igrid,ilev)=-longblack(igrid,ilev)**2 / q2pre(igrid,ilev)
     &                                           * n2pre(igrid,ilev)
        gm(igrid,ilev)=longblack(igrid,ilev)**2 / q2pre(igrid,ilev)
     &                                           * m2pre(igrid,ilev)
        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn(igrid,ilev))
        sm(igrid,ilev)=
     &    (cm1+cm2*gn(igrid,ilev))
     &   /( (1.E+0 +cm3*gn(igrid,ilev))
     &     *(1.E+0 +cm4*gn(igrid,ilev)) )
c
c --->
c       on se fait un petit MY_2.0 pour rire
c<---
c
        ri(igrid,ilev)=0.E+0
        q2mys(igrid,ilev)=0.E+0
        qmys(igrid,ilev)=0.E+0
        IF (abs(gm(igrid,ilev)).gt.1.E-6*abs(gn(igrid,ilev))) THEN
          ri(igrid,ilev)=-gn(igrid,ilev)/gm(igrid,ilev)
          tmp1=1.E+0 / b1
     &               / (sm(igrid,ilev)-sn(igrid,ilev)*ri(igrid,ilev))
          q2mys(igrid,ilev)=q2pre(igrid,ilev)*gm(igrid,ilev)/tmp1
          qmys(igrid,ilev)=sqrt(q2mys(igrid,ilev))
        ENDIF
c
c --->
c       les fonctions de stabilite sont sous controle.
c       gn a une borne superieure qui correspond au pole commun
c       a sn et sm et une borne inferieure qui est censee avoir
c       un sens physique en termes de limite superieure sur la
c       longueur de melange. dans ces deux cas limite, on impose
c       que la solution stationnaire de q^2 soit celle correspondant
c       a l'equation d'origine pour gn=gn_limite. cela impose de
c       prendre une longueur de melange differente pour le terme
c       de dissipation :
c          longdis = longstab**2 / longblack
c<---
c
        gninf(igrid,ilev)=.false.
        gnsup(igrid,ilev)=.false.
        longstab(igrid,ilev)=longblack(igrid,ilev)
        longdis(igrid,ilev)=longblack(igrid,ilev)
ccc        IF (gn(igrid,ilev).lt.gnmin) THEN
ccc          gninf(igrid,ilev)=.true.
ccc          gn(igrid,ilev)=gnmin
ccc          longstab(igrid,ilev)=
ccc     &           sqrt( -gn(igrid,ilev)*q2pre(igrid,ilev)
ccc     &                                /n2pre(igrid,ilev) )
ccc          longdis(igrid,ilev)=longstab(igrid,ilev)**2
ccc     &                       /longblack(igrid,ilev)
ccc          sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn(igrid,ilev))
ccc          sm(igrid,ilev)=
ccc     &      (cm1+cm2*gn(igrid,ilev))
ccc     &     /( (1.E+0 +cm3*gn(igrid,ilev))
ccc     &       *(1.E+0 +cm4*gn(igrid,ilev)) )
ccc        ENDIF
c
ccc        IF (gn(igrid,ilev).gt.gnmax) THEN
ccc          gnsup(igrid,ilev)=.true.
ccc          gn(igrid,ilev)=gnmax
ccc          longstab(igrid,ilev)=
ccc     &            sqrt( -gn(igrid,ilev)*q2pre(igrid,ilev)
ccc     &                                 /n2pre(igrid,ilev) )
ccc          longdis(igrid,ilev)=longstab(igrid,ilev)**2
ccc     &                       /longblack(igrid,ilev)
ccc          sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn(igrid,ilev))
ccc          sm(igrid,ilev)=
ccc     &      (cm1+cm2*gn(igrid,ilev))
ccc     &     /( (1.E+0 +cm3*gn(igrid,ilev))
ccc     &       *(1.E+0 +cm4*gn(igrid,ilev)) )
ccc        ENDIF
c
        snq2(igrid,ilev)=
     &   -gn(igrid,ilev)
     &   *(-cn1*cn2/(1.E+0 +cn2*gn(igrid,ilev))**2 )
        smq2(igrid,ilev)=
     &   -gn(igrid,ilev)
     &   *( cm2*(1.E+0 +cm3*gn(igrid,ilev))
     &         *(1.E+0 +cm4*gn(igrid,ilev))
     &     -( cm3*(1.E+0 +cm4*gn(igrid,ilev))
     &       +cm4*(1.E+0 +cm3*gn(igrid,ilev)) )
     &     *(cm1+cm2*gn(igrid,ilev))            )
     &   /( (1.E+0 +cm3*gn(igrid,ilev))
     &     *(1.E+0 +cm4*gn(igrid,ilev)) )**2
c
c --->
c       a comprendre ...#$??
c<---
c
        IF (snq2(igrid,ilev)*sn(igrid,ilev).le.0.E+0)
     &      snq2(igrid,ilev)=0.E+0
        IF (smq2(igrid,ilev)*sm(igrid,ilev).le.0.E+0)
     &      smq2(igrid,ilev)=0.E+0
c
c-----------------------------------------------------------------------
                                                      ENDDO
      ENDDO
c-----------------------------------------------------------------------
c
c.......................................................................
c calcul de kmpre et knpre
c
                                                      DO igrid=1,ngrid
      knpre(igrid,1)=knmin
      kmpre(igrid,1)=kmmin
      knq3(igrid,1)=0.E+0
      kmq3(igrid,1)=0.E+0
                                                      ENDDO
c
c-----------------------------------------------------------------------
      DO ilev=2,nlev-1
                                                      DO igrid=1,ngrid
c-----------------------------------------------------------------------
c
        knpre(igrid,ilev)=longblack(igrid,ilev)*qpre(igrid,ilev)
     &                                         *sn(igrid,ilev)
        kmpre(igrid,ilev)=longblack(igrid,ilev)*qpre(igrid,ilev)
     &                                         *sm(igrid,ilev)
        knq3(igrid,ilev)=knpre(igrid,ilev)*snq2(igrid,ilev)
     &                                    /sn(igrid,ilev)
        kmq3(igrid,ilev)=kmpre(igrid,ilev)*smq2(igrid,ilev)
     &                                    /sm(igrid,ilev)
        knconst(igrid,ilev)=.false.
        kmconst(igrid,ilev)=.false.
c
c --->
c       pour des raisons mysterieuses km et kn sont minores
c<---
c
        knconst(igrid,ilev)=.false.
        kmconst(igrid,ilev)=.false.
ccc        IF (knpre(igrid,ilev).lt.knmin) THEN
ccc        knpre(igrid,ilev)=knmin
ccc        knq3(igrid,ilev)=0.E+0
ccc        knconst(igrid,ilev)=.true.
ccc        ENDIF
ccc        IF (kmpre(igrid,ilev).lt.kmmin) THEN
ccc        kmpre(igrid,ilev)=kmmin
ccc        kmq3(igrid,ilev)=0.E+0
ccc        kmconst(igrid,ilev)=.true.
ccc        ENDIF
c
c-----------------------------------------------------------------------
                                                      ENDDO
      ENDDO
c-----------------------------------------------------------------------
c
                                                      DO igrid=1,ngrid
      knpre(igrid,nlev)=knpre(igrid,nlev-1)
      kmpre(igrid,nlev)=kmpre(igrid,nlev-1)
      knq3(igrid,nlev)=knq3(igrid,nlev-1)
      kmq3(igrid,nlev)=kmq3(igrid,nlev-1)
                                                      ENDDO
c
c.......................................................................
c calcul des termes sources et puits de l'equation de q2
c
c-----------------------------------------------------------------------
      DO ilev=2,nlev-1
                                                      DO igrid=1,ngrid
c-----------------------------------------------------------------------
c
        termq(igrid,ilev)=0.E+0
        termq3(igrid,ilev)=0.E+0
        termqm2(igrid,ilev)=0.E+0
        termq3m2(igrid,ilev)=0.E+0
c
        tmp1=dt*2.E+0 *kmpre(igrid,ilev)*m2pre(igrid,ilev)
        tmp2=dt*2.E+0 *kmq3(igrid,ilev)*m2pre(igrid,ilev)
        termqm2(igrid,ilev)=termqm2(igrid,ilev)
     &    +dt*2.E+0 *kmpre(igrid,ilev)*m2pre(igrid,ilev)
     &    -dt*2.E+0 *kmq3(igrid,ilev)*m2pre(igrid,ilev)
        termq3m2(igrid,ilev)=termq3m2(igrid,ilev)
     &    +dt*2.E+0 *kmq3(igrid,ilev)*m2pre(igrid,ilev)
c
        termq(igrid,ilev)=termq(igrid,ilev)
     &    -dt*2.E+0 *knpre(igrid,ilev)*n2pre(igrid,ilev)
     &    +dt*2.E+0 *knq3(igrid,ilev)*n2pre(igrid,ilev)
        termq3(igrid,ilev)=termq3(igrid,ilev)
     &    -dt*2.E+0 *knq3(igrid,ilev)*n2pre(igrid,ilev)
c
        termq3(igrid,ilev)=termq3(igrid,ilev)
     &    -dt*2.E+0 *qpre(igrid,ilev)**3 / (b1*longdis(igrid,ilev))
c
c-----------------------------------------------------------------------
                                                      ENDDO
      ENDDO
c-----------------------------------------------------------------------
c
c.......................................................................
c resolution stationnaire couplee avec le gradient de vitesse local
c
c-----------------------------------------------------------------------
      DO ilev=2,nlev-1
                                                      DO igrid=1,ngrid
c-----------------------------------------------------------------------
c
c on cherche le cisaillement qui annule l'equation de q^2 supposee
c en q3
c
        tmp1=termq(igrid,ilev)+termq3(igrid,ilev)
     &      +termqm2(igrid,ilev)+termq3m2(igrid,ilev)
        tmp1=-tmp1/dt/2.E+0
     &      /( sm(igrid,ilev)/q2pre(igrid,ilev) )
     &      /( longblack(igrid,ilev)*qpre(igrid,ilev)**3 )
        m2cstat(igrid,ilev)=m2pre(igrid,ilev)+tmp1
        mcstat(igrid,ilev)=sqrt(m2cstat(igrid,ilev))
c
c puis on ecrit la valeur de q qui annule l'equation de m supposee
c en q3
c
        IF (ilev.eq.2) THEN
          kmcstat(igrid,ilev)=1.E+0 / mcstat(igrid,ilev)
     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
     &                        *mpre(igrid,ilev+1)
     &      +unsdz(igrid,ilev-1)
ccc     &              *cd(igrid)*(u(igrid,1)**2+v(igrid,1)**2) )
ccc     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
     &              *cd(igrid)
sqrtuuigridd,3)**2vvigridd,3)**2)
     &                -mcstat(igrid,ilev)/unsdzdec(igrid,ilev)
     &                -mpre(igrid,ilev+1)/unsdzdec(igrid,ilev+1) )**2)
     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
        ELSE
          kmcstat(igrid,ilev)=1.E+0 / mcstat(igrid,ilev)
     &    *( unsdz(igrid,ilev)*kmpre(igrid,ilev+1)
     &                        *mpre(igrid,ilev+1)
     &      +unsdz(igrid,ilev-1)*kmpre(igrid,ilev-1)
     &                          *mpre(igrid,ilev-1) )
     &      /( unsdz(igrid,ilev)+unsdz(igrid,ilev-1) )
        ENDIF
        tmp2=kmcstat(igrid,ilev)
     &      /( sm(igrid,ilev)/q2pre(igrid,ilev) )
     &      /longblack(igrid,ilev)
        qcstat(igrid,ilev)=tmp2**(1.E+0/3.E+0)
        q2cstat(igrid,ilev)=qcstat(igrid,ilev)**2
c
c-----------------------------------------------------------------------
                                                      ENDDO
      ENDDO
c-----------------------------------------------------------------------
c
c.......................................................................
c choix de la solution finale
c
c-----------------------------------------------------------------------
      DO ilev=2,nlev-1
                                                      DO igrid=1,ngrid
c-----------------------------------------------------------------------
c
          q(igrid,ilev)=qcstat(igrid,ilev)
          q2(igrid,ilev)=q2cstat(igrid,ilev)
          m(igrid,ilev)=mcstat(igrid,ilev)
          m2(igrid,ilev)=m2cstat(igrid,ilev)
          n2(igrid,ilev)=n2pre(igrid,ilev)
c
c --->
c       pour des raisons simples q2 est minore
c<---
c
        IF (q2(igrid,ilev).lt.q2min) THEN
          q2(igrid,ilev)=q2min
          q(igrid,ilev)=sqrt(q2min)
        ENDIF
c
c-----------------------------------------------------------------------
                                                      ENDDO
      ENDDO
c-----------------------------------------------------------------------
c
                                                      DO igrid=1,ngrid
      q2(igrid,nlev)=q2(igrid,nlev-1)
      q(igrid,nlev)=q(igrid,nlev-1)
                                                      ENDDO
c
c.......................................................................
c calcul final de long, kn, km
c
                                                      DO igrid=1,ngrid
      long(igrid,1)=0.E+0
      kn(igrid,1)=knmin
      km(igrid,1)=kmmin
                                                      ENDDO
c
c-----------------------------------------------------------------------
      DO ilev=2,nlev-1
                                                      DO igrid=1,ngrid
c-----------------------------------------------------------------------
c
        gn(igrid,ilev)=-longblack(igrid,ilev)**2 / q2(igrid,ilev)
     &                                           * n2(igrid,ilev)
ccc        IF (gn(igrid,ilev).lt.gnmin) gn(igrid,ilev)=gnmin
ccc        IF (gn(igrid,ilev).gt.gnmax) gn(igrid,ilev)=gnmax
        sn(igrid,ilev)=cn1/(1.E+0 +cn2*gn(igrid,ilev))
        sm(igrid,ilev)=
     &    (cm1+cm2*gn(igrid,ilev))
     &   /( (1.E+0 +cm3*gn(igrid,ilev))*(1.E+0 +cm4*gn(igrid,ilev)) )
        long(igrid,ilev)=longblack(igrid,ilev)
        kn(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
     &                 *sn(igrid,ilev)
        km(igrid,ilev)=long(igrid,ilev)*q(igrid,ilev)
     &                 *sm(igrid,ilev)
c
        IF (kn(igrid,ilev).lt.knmin) kn(igrid,ilev)=knmin
        IF (km(igrid,ilev).lt.kmmin) km(igrid,ilev)=kmmin
c
c
c-----------------------------------------------------------------------
                                                      ENDDO
      ENDDO
c-----------------------------------------------------------------------
c
                                                      DO igrid=1,ngrid
      long(igrid,nlev)=long(igrid,nlev-1)
      kn(igrid,nlev)=kn(igrid,nlev-1)
      km(igrid,nlev)=km(igrid,nlev-1)
                                                      ENDDO
c.......................................................................
c sorties GRADS
c
c      IF (ngridmx.eq.1) THEN
c
c      nom='n2'
c      dim=nlay
c      titre='stratification'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,n2pre)
c
c      nom='m2'
c      dim=nlay
c      titre='cisaillement'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,m2pre)
c
c      nom='ri'
c      dim=nlay
c      titre='nombre de Richardson'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,ri)
c
c      nom='m2cs'
c      dim=nlay
c      titre='cisaillement : couple stationnaire'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,m2cstat)
c
c      nom='q2'
c      dim=nlay
c      titre='q2'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,q2)
c
c      nom='q20'
c      dim=nlay
c      titre='q2 solution de MY_2.0'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,q2mys)
c
c      nom='q2cs'
c      dim=nlay
c      titre='q2 : couple stationnaire (sans iterer)'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,q2cstat)
c
c      nom='dq'
c      dim=nlay
c      titre='termes en q dans l''equation de q2'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,termq)
c
c      nom='dq3'
c      dim=nlay
c      titre='termes en q3 dans l''equation de q2'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,termq3)
c
c      nom='dqm'
c      dim=nlay
c      titre='termes en q dans l''equation de q2'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,termqm2)
c
c      nom='dq3m'
c      dim=nlay
c      titre='termes en q3 dans l''equation de q2'
c      CALL writegrads(ngrid,nlay,nom,dim,titre,termq3m2)
c
c      ENDIF
c
c.......................................................................
      RETURN
      END