*=*=*=*= vdif_kshear.html =*=*=*=*
SUBROUTINE vdif_kshear(dt,g,zlev,zlay,u,v,teta,cd,q2,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 INTEGER itmp1, itmp2,itmp3 REAL tmp1,tmp2,tmp3,tmp4,tmp5,tmp6 c....................................................................... PARAMETER (kappa=0.4E+0) PARAMETER (long0=160.E+0) PARAMETER (gnmin=-10.E+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 c!!!!! allerte !!!!!c c!!!!! zlev n'est pas declare a nlev !!!!!c c!!!!! ----> DO igrid=1,ngrid zlev(igrid,nlev)=zlay(igrid,nlay) & +( zlay(igrid,nlay) - zlev(igrid,nlev-1) ) ENDDO c!!!!! <---- c!!!!! allerte !!!!!c 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 c c ---> c on ne sais traiter que les cas stratifies. et l'ajustement c convectif est cense faire en sorte que seul des configurations c stratifiees soient rencontrees en entree de cette routine. c mais, bon ... on sait jamais (meme on sait que n2 prends c quelques valeurs negatives ... parfois) alors : c<--- c IF (n2pre(igrid,ilev).lt.0.E+0) THEN n2pre(igrid,ilev)=0.E+0 ENDIF c 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) c gninf(igrid,ilev)=.false. gnsup(igrid,ilev)=.false. longstab(igrid,ilev)=longblack(igrid,ilev) longdis(igrid,ilev)=longblack(igrid,ilev) c IF (gn(igrid,ilev).lt.gnmin) THEN gninf(igrid,ilev)=.true. gn(igrid,ilev)=gnmin ENDIF c IF (gn(igrid,ilev).gt.gnmax) THEN gnsup(igrid,ilev)=.true. gn(igrid,ilev)=gnmax ENDIF c 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 IF ((gninf(igrid,ilev)).or.(gnsup(igrid,ilev))) THEN snq2(igrid,ilev)=0.E+0 smq2(igrid,ilev)=0.E+0 ELSE 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 ENDIF c if ((sn(igrid,ilev).le.0.E+0) & .or.(sn(igrid,ilev).ge.100.E+0)) & then print *,'igrid ilev',igrid,ilev,'-->' print *,'CL : sn gn' & ,sn(igrid,ilev),gn(igrid,ilev) print *,'teta teta u u v v' print *,teta(igrid,ilev),teta(igrid,ilev-1) & ,u(igrid,ilev),u(igrid,ilev-1) & ,v(igrid,ilev),v(igrid,ilev-1) print *,'profiles u v teta' do itmp1=1,nlev print *,itmp1 & ,u(igrid,itmp1),v(igrid,itmp1),teta(igrid,itmp1) enddo endif c if ((sm(igrid,ilev).le.0.E+0) & .or.(sm(igrid,ilev).ge.100.E+0)) & then print *,'igrid ilev',igrid,ilev,'-->' print *,'CL : sm gn' & ,sm(igrid,ilev),gn(igrid,ilev) print *,'teta teta u u v v' print *,teta(igrid,ilev),teta(igrid,ilev-1) & ,u(igrid,ilev),u(igrid,ilev-1) & ,v(igrid,ilev),v(igrid,ilev-1) print *,'profiles u v teta' do itmp1=1,nlev print *,itmp1 & ,u(igrid,itmp1),v(igrid,itmp1),teta(igrid,itmp1) enddo endif c if (snq2(igrid,ilev).ge.sn(igrid,ilev)) & then print *,'igrid ilev',igrid,ilev,'-->' print *,'CL : sn snq2',sn(igrid,ilev),snq2(igrid,ilev) print *,'teta teta u u v v' print *,teta(igrid,ilev),teta(igrid,ilev-1) & ,u(igrid,ilev),u(igrid,ilev-1) & ,v(igrid,ilev),v(igrid,ilev-1) print *,'profiles u v teta' do itmp1=1,nlev print *,itmp1 & ,u(igrid,itmp1),v(igrid,itmp1),teta(igrid,itmp1) enddo endif c if (smq2(igrid,ilev).ge.sm(igrid,ilev)) & then print *,'igrid ilev',igrid,ilev,'-->' print *,'CL : sm smq2',sm(igrid,ilev),smq2(igrid,ilev) print *,'teta teta u u v v' print *,teta(igrid,ilev),teta(igrid,ilev-1) & ,u(igrid,ilev),u(igrid,ilev-1) & ,v(igrid,ilev),v(igrid,ilev-1) print *,'profiles u v teta' do itmp1=1,nlev print *,itmp1 & ,u(igrid,itmp1),v(igrid,itmp1),teta(igrid,itmp1) enddo endif c c ---> c la decomposition de Taylor en q2 n'a de sens que c dans les cas stratifies ou sn et sm sont quasi c proportionnels a q2. ailleurs on laisse le meme c algorithme car l'ajustement convectif fait le travail. c mais c'est delirant quand sn et snq2 n'ont pas le meme c signe : dans ces cas, on ne fait pas la decomposition. 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----------------------------------------------------------------------- DO igrid=1,ngrid m2pre(igrid,nlev)=m2pre(igrid,nlev-1) mpre(igrid,nlev)=mpre(igrid,nlev-1) ENDDO 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) 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) tmp2=termqm2(igrid,ilev)+termq3m2(igrid,ilev) m2cstat(igrid,ilev)=m2pre(igrid,ilev) ccc & -(tmp1+tmp2)/(tmp2/m2pre(igrid,ilev)) & -(tmp1+tmp2)/(dt*2.E+0*kmpre(igrdtmp1+tmp2)/(dt*2.E+0*kmpre(igrid,ilev)) c c if (m2cstat(igrid,ilev).le.0.E+0) & then print *,'igrid ilev',igrid,ilev,'-->' print *,'CL : m2cstat n2pre m2pre' & ,m2cstat(igrid,ilev),n2pre(igrid,ilev) & ,m2pre(igrid,ilev) print *,'teta teta u u v v' print *,teta(igrid,ilev),teta(igrid,ilev-1) & ,u(igrid,ilev),u(igrid,ilev-1) & ,v(igrid,ilev),v(igrid,ilev-1) print *,'profiles u v teta' do itmp1=1,nlev print *,itmp1 & ,u(itmp1,ilev),v(itmp1,ilev),teta(itmp1,ilev) enddo endif c c 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 if ((qcstat(igrid,ilev).lt.0.E+0) & .or.(qcstat(igrid,ilev).ge.100.E+0)) & then print *,'igrid ilev',igrid,ilev,'-->' print *,'CL : qcstat',qcstat(igrid,ilev) print *,'teta teta u u v v' print *,teta(igrid,ilev),teta(igrid,ilev-1) & ,u(igrid,ilev),u(igrid,ilev-1) & ,v(igrid,ilev),v(igrid,ilev-1) print *,'profiles u v teta' do itmp1=1,nlev print *,itmp1 & ,u(igrid,itmp1),v(igrid,itmp1),teta(igrid,itmp1) enddo endif c 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) IF (gn(igrid,ilev).lt.gnmin) gn(igrid,ilev)=gnmin 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).le.1.E-4) & .or.(kn(igrid,ilev).ge.1000.E+0)) & then print *,'igrid ilev',igrid,ilev,'-->' print *,'CL : kn n2' & ,kn(igrid,ilev),n2(igrid,ilev) print *,'teta teta u u v v' print *,teta(igrid,ilev),teta(igrid,ilev-1) & ,u(igrid,ilev),u(igrid,ilev-1) & ,v(igrid,ilev),v(igrid,ilev-1) print *,'profiles u v teta' do itmp1=1,nlev print *,itmp1 & ,u(igrid,itmp1),v(igrid,itmp1),teta(igrid,itmp1) enddo endif c if ((km(igrid,ilev).le.1.E-4) & .or.(km(igrid,ilev).ge.1000.E+0)) & then print *,'igrid ilev',igrid,ilev,'-->' print *,'CL : km n2' & ,km(igrid,ilev),n2(igrid,ilev) print *,'teta teta u u v v' print *,teta(igrid,ilev),teta(igrid,ilev-1) & ,u(igrid,ilev),u(igrid,ilev-1) & ,v(igrid,ilev),v(igrid,ilev-1) print *,'profiles u v teta' do itmp1=1,nlev print *,itmp1 & ,u(igrid,itmp1),v(igrid,itmp1),teta(igrid,itmp1) enddo endif 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='q2r' c dim=nlay c titre='q2 ref' 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