source: LMDZ5/branches/IPSLCM5A2.1/libf/phylmd/coef_diff_turb_mod.F90 @ 5360

Last change on this file since 5360 was 2561, checked in by fhourdin, 9 years ago

Parametrisation d'une longueur de melange verticale minimum associee
aux circulations meso-echelle introduites par le relief sous maille.
D'apres Etienne Vignon et Frédéric Hourdin

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 18.8 KB
Line 
1!
2MODULE coef_diff_turb_mod
3!
4! This module contains some procedures for calculation of the coefficients of the
5! turbulent diffusion in the atmosphere and coefficients for turbulent diffusion
6! at surface(cdrag)
7!
8  IMPLICIT NONE
9 
10CONTAINS
11!
12!****************************************************************************************
13!
14  SUBROUTINE coef_diff_turb(dtime, nsrf, knon, ni, &
15       ypaprs, ypplay, yu, yv, yq, yt, yts, yqsurf, ycdragm, &
16       ycoefm, ycoefh ,yq2)
17 
18    USE dimphy
19    USE indice_sol_mod
20    USE print_control_mod, ONLY: prt_level, lunout
21!
22! Calculate coefficients(ycoefm, ycoefh) for turbulent diffusion in the
23! atmosphere
24! NB! No values are calculated between surface and the first model layer.
25!     ycoefm(:,1) and ycoefh(:,1) are not valid !!!
26!
27!
28! Input arguments
29!****************************************************************************************
30    REAL, INTENT(IN)                           :: dtime
31    INTEGER, INTENT(IN)                        :: nsrf, knon
32    INTEGER, DIMENSION(klon), INTENT(IN)       :: ni
33    REAL, DIMENSION(klon,klev+1), INTENT(IN)   :: ypaprs
34    REAL, DIMENSION(klon,klev), INTENT(IN)     :: ypplay
35    REAL, DIMENSION(klon,klev), INTENT(IN)     :: yu, yv
36    REAL, DIMENSION(klon,klev), INTENT(IN)     :: yq, yt
37    REAL, DIMENSION(klon), INTENT(IN)          :: yts, yqsurf
38    REAL, DIMENSION(klon), INTENT(IN)          :: ycdragm
39
40! InOutput arguments
41!****************************************************************************************
42    REAL, DIMENSION(klon,klev+1), INTENT(INOUT):: yq2
43 
44! Output arguments
45!****************************************************************************************
46    REAL, DIMENSION(klon,klev), INTENT(OUT)    :: ycoefh
47    REAL, DIMENSION(klon,klev), INTENT(OUT)    :: ycoefm
48
49! Other local variables
50!****************************************************************************************
51    INTEGER                                    :: k, i, j
52    REAL, DIMENSION(klon,klev)                 :: ycoefm0, ycoefh0, yzlay, yteta
53    REAL, DIMENSION(klon,klev+1)               :: yzlev, q2diag, ykmm, ykmn, ykmq
54    REAL, DIMENSION(klon)                      :: yustar
55
56! Include
57!****************************************************************************************
58    INCLUDE "clesphys.h"
59    INCLUDE "compbl.h"
60    INCLUDE "YOETHF.h"
61    INCLUDE "YOMCST.h"
62
63
64!****************************************************************************************   
65! Calcul de coefficients de diffusion turbulent de l'atmosphere :
66! ycoefm(:,2:klev), ycoefh(:,2:klev)
67!
68!****************************************************************************************   
69
70    CALL coefkz(nsrf, knon, ypaprs, ypplay, &
71         ksta, ksta_ter, &
72         yts, yu, yv, yt, yq, &
73         yqsurf, &
74         ycoefm, ycoefh)
75 
76!****************************************************************************************
77! Eventuelle recalcule des coeffeicients de diffusion turbulent de l'atmosphere :
78! ycoefm(:,2:klev), ycoefh(:,2:klev)
79!
80!****************************************************************************************
81
82    IF (iflag_pbl.EQ.1) THEN
83       CALL coefkz2(nsrf, knon, ypaprs, ypplay, yt, &
84            ycoefm0, ycoefh0)
85
86       DO k = 2, klev
87          DO i = 1, knon
88             ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
89             ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
90          ENDDO
91       ENDDO
92    ENDIF
93
94 
95!**************************************************************************************** 
96! Calcul d'une diffusion minimale pour les conditions tres stables
97!
98!****************************************************************************************
99    IF (ok_kzmin) THEN
100       CALL coefkzmin(knon,ypaprs,ypplay,yu,yv,yt,yq,ycdragm, &
101            ycoefm0,ycoefh0)
102       
103       DO k = 2, klev
104          DO i = 1, knon
105             ycoefm(i,k) = MAX(ycoefm(i,k),ycoefm0(i,k))
106             ycoefh(i,k) = MAX(ycoefh(i,k),ycoefh0(i,k))
107          ENDDO
108       ENDDO
109       
110    ENDIF
111
112 
113!****************************************************************************************
114! MELLOR ET YAMADA adapte a Mars Richard Fournier et Frederic Hourdin
115!
116!****************************************************************************************
117
118    IF (iflag_pbl.GE.3) THEN
119
120       yzlay(1:knon,1)= &
121            RD*yt(1:knon,1)/(0.5*(ypaprs(1:knon,1)+ypplay(1:knon,1))) &
122            *(ypaprs(1:knon,1)-ypplay(1:knon,1))/RG
123       DO k=2,klev
124          DO i = 1, knon
125             yzlay(i,k)= &
126                  yzlay(i,k-1)+RD*0.5*(yt(i,k-1)+yt(i,k)) &
127                  /ypaprs(i,k)*(ypplay(i,k-1)-ypplay(i,k))/RG
128          END DO
129       END DO
130
131       DO k=1,klev
132          DO i = 1, knon
133             yteta(i,k)= &
134                  yt(i,k)*(ypaprs(i,1)/ypplay(i,k))**RKAPPA &
135                  *(1.+0.61*yq(i,k))
136          END DO
137       END DO
138
139       yzlev(1:knon,1)=0.
140       yzlev(1:knon,klev+1)=2.*yzlay(1:knon,klev)-yzlay(1:knon,klev-1)
141       DO k=2,klev
142          DO i = 1, knon
143             yzlev(i,k)=0.5*(yzlay(i,k)+yzlay(i,k-1))
144          END DO
145       END DO
146
147!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
148!!$! Pour memoire, le papier Hourdin et al. 2002 a ete obtenur avec un
149!!$! bug sur les coefficients de surface :
150!!$!          ycdragh(1:knon) = ycoefm(1:knon,1)
151!!$!          ycdragm(1:knon) = ycoefh(1:knon,1)
152!!$!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
153       CALL ustarhb(knon,yu,yv,ycdragm, yustar)
154     
155       IF (prt_level > 9) THEN
156          WRITE(lunout,*) 'USTAR = ',yustar
157       ENDIF
158         
159!   iflag_pbl peut etre utilise comme longuer de melange
160       IF (iflag_pbl.GE.31) THEN
161          CALL vdif_kcay(knon,dtime,RG,RD,ypaprs,yt, &
162               yzlev,yzlay,yu,yv,yteta, &
163               ycdragm,yq2,q2diag,ykmm,ykmn,yustar, &
164               iflag_pbl)
165       ELSE IF (iflag_pbl<20) THEN
166          CALL yamada4(ni,nsrf,knon,dtime,RG,RD,ypaprs,yt, &
167               yzlev,yzlay,yu,yv,yteta, &
168               ycdragm,yq2,ykmm,ykmn,ykmq,yustar, &
169               iflag_pbl)
170       ENDIF
171       
172       ycoefm(1:knon,2:klev)=ykmm(1:knon,2:klev)
173       ycoefh(1:knon,2:klev)=ykmn(1:knon,2:klev)
174               
175    ENDIF !(iflag_pbl.ge.3)
176
177  END SUBROUTINE coef_diff_turb
178!
179!****************************************************************************************
180!
181  SUBROUTINE coefkz(nsrf, knon, paprs, pplay, &
182       ksta, ksta_ter, &
183       ts, &
184       u,v,t,q, &
185       qsurf, &
186       pcfm, pcfh)
187   
188    USE dimphy
189    USE indice_sol_mod
190    USE print_control_mod, ONLY: prt_level, lunout
191 
192!======================================================================
193! Auteur(s) F. Hourdin, M. Forichon, Z.X. Li (LMD/CNRS) date: 19930922
194!           (une version strictement identique a l'ancien modele)
195! Objet: calculer le coefficient du frottement du sol (Cdrag) et les
196!        coefficients d'echange turbulent dans l'atmosphere.
197! Arguments:
198! nsrf-----input-I- indicateur de la nature du sol
199! knon-----input-I- nombre de points a traiter
200! paprs----input-R- pregssion a chaque intercouche (en Pa)
201! pplay----input-R- pression au milieu de chaque couche (en Pa)
202! ts-------input-R- temperature du sol (en Kelvin)
203! u--------input-R- vitesse u
204! v--------input-R- vitesse v
205! t--------input-R- temperature (K)
206! q--------input-R- vapeur d'eau (kg/kg)
207!
208! pcfm-----output-R- coefficients a calculer (vitesse)
209! pcfh-----output-R- coefficients a calculer (chaleur et humidite)
210!======================================================================
211    INCLUDE "YOETHF.h"
212    INCLUDE "YOMCST.h"
213    INCLUDE "FCTTRE.h"
214    INCLUDE "compbl.h"
215!
216! Arguments:
217!
218    INTEGER, INTENT(IN)                      :: knon, nsrf
219    REAL, INTENT(IN)                         :: ksta, ksta_ter
220    REAL, DIMENSION(klon), INTENT(IN)        :: ts
221    REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs
222    REAL, DIMENSION(klon,klev), INTENT(IN)   :: pplay
223    REAL, DIMENSION(klon,klev), INTENT(IN)   :: u, v, t, q
224    REAL, DIMENSION(klon), INTENT(IN)        :: qsurf
225
226    REAL, DIMENSION(klon,klev), INTENT(OUT)  :: pcfm, pcfh
227
228!
229! Local variables:
230!
231    INTEGER, DIMENSION(klon)    :: itop ! numero de couche du sommet de la couche limite
232!
233! Quelques constantes et options:
234!
235    REAL, PARAMETER :: cepdu2=0.1**2
236    REAL, PARAMETER :: CKAP=0.4
237    REAL, PARAMETER :: cb=5.0
238    REAL, PARAMETER :: cc=5.0
239    REAL, PARAMETER :: cd=5.0
240    REAL, PARAMETER :: clam=160.0
241    REAL, PARAMETER :: ratqs=0.05 ! largeur de distribution de vapeur d'eau
242    LOGICAL, PARAMETER :: richum=.TRUE. ! utilise le nombre de Richardson humide
243    REAL, PARAMETER :: ric=0.4 ! nombre de Richardson critique
244    REAL, PARAMETER :: prandtl=0.4
245    REAL kstable ! diffusion minimale (situation stable)
246    ! GKtest
247    ! PARAMETER (kstable=1.0e-10)
248!IM: 261103     REAL kstable_ter, kstable_sinon
249!IM: 211003 cf GK   PARAMETER (kstable_ter = 1.0e-6)
250!IM: 261103     PARAMETER (kstable_ter = 1.0e-8)
251!IM: 261103   PARAMETER (kstable_ter = 1.0e-10)
252!IM: 261103   PARAMETER (kstable_sinon = 1.0e-10)
253    ! fin GKtest
254    REAL, PARAMETER :: mixlen=35.0 ! constante controlant longueur de melange
255    INTEGER isommet ! le sommet de la couche limite
256    LOGICAL, PARAMETER :: tvirtu=.TRUE. ! calculer Ri d'une maniere plus performante
257    LOGICAL, PARAMETER :: opt_ec=.FALSE.! formule du Centre Europeen dans l'atmosphere
258
259!
260! Variables locales:
261    INTEGER i, k !IM 120704
262    REAL zgeop(klon,klev)
263    REAL zmgeom(klon)
264    REAL zri(klon)
265    REAL zl2(klon)
266    REAL zdphi, zdu2, ztvd, ztvu, zcdn
267    REAL zscf
268    REAL zt, zq, zdelta, zcvm5, zcor, zqs, zfr, zdqs
269    REAL z2geomf, zalh2, zalm2, zscfh, zscfm
270    REAL, PARAMETER :: t_coup=273.15
271    LOGICAL, PARAMETER :: check=.FALSE.
272!
273! contre-gradient pour la chaleur sensible: Kelvin/metre
274    REAL gamt(2:klev)
275
276    LOGICAL, SAVE :: appel1er=.TRUE.
277    !$OMP THREADPRIVATE(appel1er)
278!
279! Fonctions thermodynamiques et fonctions d'instabilite
280    REAL fsta, fins, x
281
282    fsta(x) = 1.0 / (1.0+10.0*x*(1+8.0*x))
283    fins(x) = SQRT(1.0-18.0*x)
284
285    isommet=klev
286     
287    IF (appel1er) THEN
288       IF (prt_level > 9) THEN
289          WRITE(lunout,*)'coefkz, opt_ec:', opt_ec
290          WRITE(lunout,*)'coefkz, richum:', richum
291          IF (richum) WRITE(lunout,*)'coefkz, ratqs:', ratqs
292          WRITE(lunout,*)'coefkz, isommet:', isommet
293          WRITE(lunout,*)'coefkz, tvirtu:', tvirtu
294          appel1er = .FALSE.
295       ENDIF
296    ENDIF
297!
298! Initialiser les sorties
299!
300    DO k = 1, klev
301       DO i = 1, knon
302          pcfm(i,k) = 0.0
303          pcfh(i,k) = 0.0
304       ENDDO
305    ENDDO
306    DO i = 1, knon
307       itop(i) = 0
308    ENDDO
309   
310!
311! Prescrire la valeur de contre-gradient
312!
313    IF (iflag_pbl.EQ.1) THEN
314       DO k = 3, klev
315          gamt(k) = -1.0E-03
316       ENDDO
317       gamt(2) = -2.5E-03
318    ELSE
319       DO k = 2, klev
320          gamt(k) = 0.0
321       ENDDO
322    ENDIF
323!IM cf JLD/ GKtest
324    IF ( nsrf .NE. is_oce ) THEN
325!IM 261103     kstable = kstable_ter
326       kstable = ksta_ter
327    ELSE
328!IM 261103     kstable = kstable_sinon
329       kstable = ksta
330    ENDIF
331!IM cf JLD/ GKtest fin
332
333!
334! Calculer les geopotentiels de chaque couche
335!
336    DO i = 1, knon
337       zgeop(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1))) &
338            * (paprs(i,1)-pplay(i,1))
339    ENDDO
340    DO k = 2, klev
341       DO i = 1, knon
342          zgeop(i,k) = zgeop(i,k-1) &
343               + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k) &
344               * (pplay(i,k-1)-pplay(i,k))
345       ENDDO
346    ENDDO
347
348!
349! Calculer les coefficients turbulents dans l'atmosphere
350!
351    DO i = 1, knon
352       itop(i) = isommet
353    ENDDO
354
355
356    DO k = 2, isommet
357       DO i = 1, knon
358          zdu2=MAX(cepdu2,(u(i,k)-u(i,k-1))**2 &
359               +(v(i,k)-v(i,k-1))**2)
360          zmgeom(i)=zgeop(i,k)-zgeop(i,k-1)
361          zdphi =zmgeom(i) / 2.0
362          zt = (t(i,k)+t(i,k-1)) * 0.5
363          zq = (q(i,k)+q(i,k-1)) * 0.5
364
365!
366! Calculer Qs et dQs/dT:
367!
368          IF (thermcep) THEN
369             zdelta = MAX(0.,SIGN(1.,RTT-zt))
370             zcvm5 = R5LES*RLVTT/RCPD/(1.0+RVTMP2*zq)*(1.-zdelta) &
371                  + R5IES*RLSTT/RCPD/(1.0+RVTMP2*zq)*zdelta
372             zqs = R2ES * FOEEW(zt,zdelta) / pplay(i,k)
373             zqs = MIN(0.5,zqs)
374             zcor = 1./(1.-RETV*zqs)
375             zqs = zqs*zcor
376             zdqs = FOEDE(zt,zdelta,zcvm5,zqs,zcor)
377          ELSE
378             IF (zt .LT. t_coup) THEN
379                zqs = qsats(zt) / pplay(i,k)
380                zdqs = dqsats(zt,zqs)
381             ELSE
382                zqs = qsatl(zt) / pplay(i,k)
383                zdqs = dqsatl(zt,zqs)
384             ENDIF
385          ENDIF
386!
387!           calculer la fraction nuageuse (processus humide):
388!
389          if (zq /= 0.) then
390             zfr = (zq+ratqs*zq-zqs) / (2.0*ratqs*zq)
391          else
392             zfr = 0.
393          end if
394          zfr = MAX(0.0,MIN(1.0,zfr))
395          IF (.NOT.richum) zfr = 0.0
396!
397!           calculer le nombre de Richardson:
398!
399          IF (tvirtu) THEN
400             ztvd =( t(i,k) &
401                  + zdphi/RCPD/(1.+RVTMP2*zq) &
402                  *( (1.-zfr) + zfr*(1.+RLVTT*zqs/RD/zt)/(1.+zdqs) ) &
403                  )*(1.+RETV*q(i,k))
404             ztvu =( t(i,k-1) &
405                  - zdphi/RCPD/(1.+RVTMP2*zq) &
406                  *( (1.-zfr) + zfr*(1.+RLVTT*zqs/RD/zt)/(1.+zdqs) ) &
407                  )*(1.+RETV*q(i,k-1))
408             zri(i) =zmgeom(i)*(ztvd-ztvu)/(zdu2*0.5*(ztvd+ztvu))
409             zri(i) = zri(i) &
410                  + zmgeom(i)*zmgeom(i)/RG*gamt(k) &
411                  *(paprs(i,k)/101325.0)**RKAPPA &
412                  /(zdu2*0.5*(ztvd+ztvu))
413
414          ELSE ! calcul de Ridchardson compatible LMD5
415
416             zri(i) =(RCPD*(t(i,k)-t(i,k-1)) &
417                  -RD*0.5*(t(i,k)+t(i,k-1))/paprs(i,k) &
418                  *(pplay(i,k)-pplay(i,k-1)) &
419                  )*zmgeom(i)/(zdu2*0.5*RCPD*(t(i,k-1)+t(i,k)))
420             zri(i) = zri(i) + &
421                  zmgeom(i)*zmgeom(i)*gamt(k)/RG &
422                  *(paprs(i,k)/101325.0)**RKAPPA &
423                  /(zdu2*0.5*(t(i,k-1)+t(i,k)))
424          ENDIF
425!
426!           finalement, les coefficients d'echange sont obtenus:
427!
428          zcdn=SQRT(zdu2) / zmgeom(i) * RG
429
430          IF (opt_ec) THEN
431             z2geomf=zgeop(i,k-1)+zgeop(i,k)
432             zalm2=(0.5*ckap/RG*z2geomf &
433                  /(1.+0.5*ckap/rg/clam*z2geomf))**2
434             zalh2=(0.5*ckap/rg*z2geomf &
435                  /(1.+0.5*ckap/RG/(clam*SQRT(1.5*cd))*z2geomf))**2
436             IF (zri(i).LT.0.0) THEN  ! situation instable
437                zscf = ((zgeop(i,k)/zgeop(i,k-1))**(1./3.)-1.)**3 &
438                     / (zmgeom(i)/RG)**3 / (zgeop(i,k-1)/RG)
439                zscf = SQRT(-zri(i)*zscf)
440                zscfm = 1.0 / (1.0+3.0*cb*cc*zalm2*zscf)
441                zscfh = 1.0 / (1.0+3.0*cb*cc*zalh2*zscf)
442                pcfm(i,k)=zcdn*zalm2*(1.-2.0*cb*zri(i)*zscfm)
443                pcfh(i,k)=zcdn*zalh2*(1.-3.0*cb*zri(i)*zscfh)
444             ELSE ! situation stable
445                zscf=SQRT(1.+cd*zri(i))
446                pcfm(i,k)=zcdn*zalm2/(1.+2.0*cb*zri(i)/zscf)
447                pcfh(i,k)=zcdn*zalh2/(1.+3.0*cb*zri(i)*zscf)
448             ENDIF
449          ELSE
450             zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,itop(i)+1)) &
451                  /(paprs(i,2)-paprs(i,itop(i)+1)) ))**2
452             pcfm(i,k)=SQRT(MAX(zcdn*zcdn*(ric-zri(i))/ric, kstable))
453             pcfm(i,k)= zl2(i)* pcfm(i,k)
454             pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
455          ENDIF
456       ENDDO
457    ENDDO
458
459!
460! Au-dela du sommet, pas de diffusion turbulente:
461!
462    DO i = 1, knon
463       IF (itop(i)+1 .LE. klev) THEN
464          DO k = itop(i)+1, klev
465             pcfh(i,k) = 0.0
466             pcfm(i,k) = 0.0
467          ENDDO
468       ENDIF
469    ENDDO
470     
471  END SUBROUTINE coefkz
472!
473!****************************************************************************************
474!
475  SUBROUTINE coefkz2(nsrf, knon, paprs, pplay,t, &
476       pcfm, pcfh)
477
478    USE dimphy
479    USE indice_sol_mod
480
481!======================================================================
482! J'introduit un peu de diffusion sauf dans les endroits
483! ou une forte inversion est presente
484! On peut dire qu'il represente la convection peu profonde
485!
486! Arguments:
487! nsrf-----input-I- indicateur de la nature du sol
488! knon-----input-I- nombre de points a traiter
489! paprs----input-R- pression a chaque intercouche (en Pa)
490! pplay----input-R- pression au milieu de chaque couche (en Pa)
491! t--------input-R- temperature (K)
492!
493! pcfm-----output-R- coefficients a calculer (vitesse)
494! pcfh-----output-R- coefficients a calculer (chaleur et humidite)
495!======================================================================
496!
497! Arguments:
498!
499    INTEGER, INTENT(IN)                       :: knon, nsrf
500    REAL, DIMENSION(klon, klev+1), INTENT(IN) ::  paprs
501    REAL, DIMENSION(klon, klev), INTENT(IN)   ::  pplay
502    REAL, DIMENSION(klon, klev), INTENT(IN)   :: t(klon,klev)
503   
504    REAL, DIMENSION(klon, klev), INTENT(OUT)  :: pcfm, pcfh
505!
506! Quelques constantes et options:
507!
508    REAL, PARAMETER :: prandtl=0.4
509    REAL, PARAMETER :: kstable=0.002
510!   REAL, PARAMETER :: kstable=0.001
511    REAL, PARAMETER :: mixlen=35.0 ! constante controlant longueur de melange
512    REAL, PARAMETER :: seuil=-0.02 ! au-dela l'inversion est consideree trop faible
513!    PARAMETER (seuil=-0.04)
514!    PARAMETER (seuil=-0.06)
515!    PARAMETER (seuil=-0.09)
516
517!
518! Variables locales:
519!
520    INTEGER i, k, invb(knon)
521    REAL zl2(knon)
522    REAL zdthmin(knon), zdthdp
523
524    INCLUDE "YOMCST.h"
525!
526! Initialiser les sorties
527!
528    DO k = 1, klev
529       DO i = 1, knon
530          pcfm(i,k) = 0.0
531          pcfh(i,k) = 0.0
532       ENDDO
533    ENDDO
534
535!
536! Chercher la zone d'inversion forte
537!
538    DO i = 1, knon
539       invb(i) = klev
540       zdthmin(i)=0.0
541    ENDDO
542    DO k = 2, klev/2-1
543       DO i = 1, knon
544          zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1)) &
545               - RD * 0.5*(t(i,k)+t(i,k+1))/RCPD/paprs(i,k+1)
546          zdthdp = zdthdp * 100.0
547          IF (pplay(i,k).GT.0.8*paprs(i,1) .AND. &
548               zdthdp.LT.zdthmin(i) ) THEN
549             zdthmin(i) = zdthdp
550             invb(i) = k
551          ENDIF
552       ENDDO
553    ENDDO
554
555!
556! Introduire une diffusion:
557!
558    IF ( nsrf.EQ.is_oce ) THEN
559       DO k = 2, klev
560          DO i = 1, knon
561!IM cf FH/GK   IF ( (nsrf.NE.is_oce) .OR.  ! si ce n'est pas sur l'ocean
562!IM cf FH/GK  .     (invb(i).EQ.klev) .OR. ! s'il n'y a pas d'inversion
563      !IM cf JLD/ GKtest TERkz2
564      ! IF ( (nsrf.EQ.is_ter) .OR.  ! si on est sur la terre
565      ! fin GKtest
566
567
568! s'il n'y a pas d'inversion ou si l'inversion est trop faible
569!          IF ( (nsrf.EQ.is_oce) .AND. &
570             IF ( (invb(i).EQ.klev) .OR. (zdthmin(i).GT.seuil) ) THEN
571                zl2(i)=(mixlen*MAX(0.0,(paprs(i,k)-paprs(i,klev+1)) &
572                     /(paprs(i,2)-paprs(i,klev+1)) ))**2
573                pcfm(i,k)= zl2(i)* kstable
574                pcfh(i,k) = pcfm(i,k) /prandtl ! h et m different
575             ENDIF
576          ENDDO
577       ENDDO
578    ENDIF
579
580  END SUBROUTINE coefkz2
581!
582!****************************************************************************************
583!
584END MODULE coef_diff_turb_mod
Note: See TracBrowser for help on using the repository browser.