*=*=*=*= vdif_esa.html =*=*=*=*
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