source: LMDZ6/branches/Amaury_dev/libf/phylmd/stdlevvar_mod.F90 @ 5133

Last change on this file since 5133 was 5117, checked in by abarral, 5 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

  • Property svn:executable set to *
File size: 25.6 KB
RevLine 
[5099]1
[3817]2MODULE stdlevvar_mod
[5099]3
[3817]4! This module contains main procedures for calculation
5! of temperature, specific humidity and wind at a reference level
[5099]6
[3817]7  USE cdrag_mod
8  USE screenp_mod
9  USE screenc_mod
10  IMPLICIT NONE
11
12CONTAINS
[5099]13
[3817]14!****************************************************************************************
[5099]15
[3817]16!r original routine svn3623
[5099]17
[3817]18      SUBROUTINE stdlevvar(klon, knon, nsrf, zxli, &
19                           u1, v1, t1, q1, z1, &
20                           ts1, qsurf, z0m, z0h, psol, pat1, &
[4722]21                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar, s_pblh, prain, tsol)
[3817]22      IMPLICIT NONE
23!-------------------------------------------------------------------------
[5099]24
[3817]25! Objet : calcul de la temperature et l'humidite relative a 2m et du
26!         module du vent a 10m a partir des relations de Dyer-Businger et
27!         des equations de Louis.
[5099]28
[3817]29! Reference : Hess, Colman et McAvaney (1995)       
[5099]30
[3817]31! I. Musat, 01.07.2002
[5099]32
[3817]33!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
[5099]34
[3817]35!-------------------------------------------------------------------------
[5099]36
[3817]37! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
38! knon----input-I- nombre de points pour un type de surface
39! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
40! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
41! u1------input-R- vent zonal au 1er niveau du modele
42! v1------input-R- vent meridien au 1er niveau du modele
43! t1------input-R- temperature de l'air au 1er niveau du modele
44! q1------input-R- humidite relative au 1er niveau du modele
45! z1------input-R- geopotentiel au 1er niveau du modele
46! ts1-----input-R- temperature de l'air a la surface
47! qsurf---input-R- humidite relative a la surface
48! z0m, z0h---input-R- rugosite
49! psol----input-R- pression au sol
50! pat1----input-R- pression au 1er niveau du modele
[5099]51
[3817]52! t_2m---output-R- temperature de l'air a 2m
53! q_2m---output-R- humidite relative a 2m
54! u_10m--output-R- vitesse du vent a 10m
55!AM
56! t_10m--output-R- temperature de l'air a 10m
57! q_10m--output-R- humidite specifique a 10m
58! ustar--output-R- u*
[5099]59
[5117]60      INTEGER, INTENT(IN) :: klon, knon, nsrf
61      LOGICAL, INTENT(IN) :: zxli
62      REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, z1, ts1
63      REAL, DIMENSION(klon), INTENT(IN) :: qsurf
64      REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
65      REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
[5099]66
[5117]67      REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
68      REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
[4722]69      REAL, DIMENSION(klon), INTENT(INOUT) :: s_pblh
70      REAL, DIMENSION(klon), INTENT(IN) :: prain
71      REAL, DIMENSION(klon), INTENT(IN) :: tsol
[3817]72!-------------------------------------------------------------------------
73      include "flux_arp.h"
74      include "YOMCST.h"
75!IM PLUS
76      include "YOETHF.h"
[5099]77
[3817]78! Quelques constantes et options:
[5099]79
[3817]80! RKAR : constante de von Karman
81      REAL, PARAMETER :: RKAR=0.40
82! niter : nombre iterations calcul "corrector"
83!     INTEGER, parameter :: niter=6, ncon=niter-1
84      INTEGER, parameter :: niter=2, ncon=niter-1
[5099]85
[3817]86! Variables locales
87      INTEGER :: i, n
88      REAL :: zref
[5117]89      REAL, DIMENSION(klon) :: speed
[3817]90! tpot : temperature potentielle
[5117]91      REAL, DIMENSION(klon) :: tpot
92      REAL, DIMENSION(klon) :: zri1, cdran
93      REAL, DIMENSION(klon) :: cdram, cdrah
[3817]94! ri1 : nb. de Richardson entre la surface --> la 1ere couche
[5117]95      REAL, DIMENSION(klon) :: ri1
96      REAL, DIMENSION(klon) :: testar, qstar
97      REAL, DIMENSION(klon) :: zdte, zdq
[3817]98! lmon : longueur de Monin-Obukhov selon Hess, Colman and McAvaney
[5117]99      DOUBLE PRECISION, DIMENSION(klon) :: lmon
[3817]100      DOUBLE PRECISION, parameter :: eps=1.0D-20
[5117]101      REAL, DIMENSION(klon) :: delu, delte, delq
102      REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
103      REAL, DIMENSION(klon) :: temp, pref
[3817]104      LOGICAL :: okri
[5117]105      REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
[3817]106!convertgence
[5117]107      REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
108      REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
109      REAL, DIMENSION(klon) :: ok_pred, ok_corr, zri_zero
110!     REAL, DIMENSION(klon) :: conv_te, conv_q
[3817]111!-------------------------------------------------------------------------
112      DO i=1, knon
113       speed(i)=SQRT(u1(i)**2+v1(i)**2)
114       ri1(i) = 0.0
115      ENDDO
[5099]116
[3817]117      okri=.FALSE.
118!      CALL coefcdrag(klon, knon, nsrf, zxli, &
119! &                   speed, t1, q1, z1, psol, &
120! &                   ts1, qsurf, rugos, okri, ri1,  &         
121! &                   cdram, cdrah, cdran, zri1, pref)           
122! Fuxing WANG, 04/03/2015, replace the coefcdrag by the merged version: cdrag
123
124      CALL cdrag(knon, nsrf, &
[5087]125                     speed, t1, q1, z1, &
126                     psol, s_pblh, ts1, qsurf, z0m, z0h, &
127                     zri_zero, 0, &
128                     cdram, cdrah, zri1, pref, prain, tsol, pat1)
[3817]129
130! --- special Dice: on force cdragm ( a defaut de forcer ustar) MPL 05082013
[5116]131     IF (ok_prescr_ust) THEN
[3817]132      DO i = 1, knon
133       print *,'cdram avant=',cdram(i)
134       cdram(i) = ust*ust/speed(i)/speed(i)
135       print *,'cdram ust speed apres=',cdram(i),ust,speed
136      ENDDO
137     ENDIF
[5099]138
[3817]139!---------Star variables----------------------------------------------------
[5099]140
[3817]141      DO i = 1, knon
142        ri1(i) = zri1(i)
143        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
144        ustar(i) = sqrt(cdram(i) * speed(i) * speed(i))
145        zdte(i) = tpot(i) - ts1(i)
146        zdq(i) = max(q1(i),0.0) - max(qsurf(i),0.0)
[5099]147
148
[3817]149!IM BUG BUG BUG       zdte(i) = max(zdte(i),1.e-10)
150        zdte(i) = sign(max(abs(zdte(i)),1.e-10),zdte(i))
[5099]151
[3817]152        testar(i) = (cdrah(i) * zdte(i) * speed(i))/ustar(i)
153        qstar(i) = (cdrah(i) * zdq(i) * speed(i))/ustar(i)
154        lmon(i) = (ustar(i) * ustar(i) * tpot(i))/ &
[5087]155                  (RKAR * RG * testar(i))
[3817]156      ENDDO
[5099]157
[3817]158!----------First aproximation of variables at zref --------------------------
159      zref = 2.0
160      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
[5087]161                   ts1, qsurf, z0m, lmon, &
162                   ustar, testar, qstar, zref, &
163                   delu, delte, delq)
[5099]164
[3817]165      DO i = 1, knon
166        u_zref(i) = delu(i)
167        q_zref(i) = max(qsurf(i),0.0) + delq(i)
168        te_zref(i) = ts1(i) + delte(i)
169        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
170        q_zref_p(i) = q_zref(i)
171!       te_zref_p(i) = te_zref(i)
172        temp_p(i) = temp(i)
173      ENDDO
[5099]174
[3817]175! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
[5099]176
[3817]177      DO n = 1, niter
[5099]178
[3817]179        okri=.TRUE.
180        CALL screenc(klon, knon, nsrf, zxli, &
[5087]181                     u_zref, temp, q_zref, zref, &
182                     ts1, qsurf, z0m, z0h, psol, &
183                     ustar, testar, qstar, okri, ri1, &
184                     pref, delu, delte, delq, s_pblh ,prain, tsol, pat1)
[5099]185
[3817]186        DO i = 1, knon
187          u_zref(i) = delu(i)
188          q_zref(i) = delq(i) + max(qsurf(i),0.0)
189          te_zref(i) = delte(i) + ts1(i)
[5099]190
[3817]191! return to normal temperature
[5099]192
[3817]193          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
194!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
195!                 (1 + RVTMP2 * max(q_zref(i),0.0))
[5099]196
[3817]197!IM +++
198!         IF(temp(i).GT.350.) THEN
199!           WRITE(*,*) 'temp(i) GT 350 K !!',i,nsrf,temp(i)
200!         ENDIF
201!IM ---
[5099]202
[5082]203        IF(n==ncon) THEN
[3817]204          te_zref_con(i) = te_zref(i)
205          q_zref_con(i) = q_zref(i)
206        ENDIF
[5099]207
[3817]208        ENDDO
[5099]209
[3817]210      ENDDO
[5099]211
[3817]212! verifier le critere de convergence : 0.25% pour te_zref et 5% pour qe_zref
[5099]213
[3817]214!       DO i = 1, knon
215!         conv_te(i) = (te_zref(i) - te_zref_con(i))/te_zref_con(i)
216!         conv_q(i) = (q_zref(i) - q_zref_con(i))/q_zref_con(i)
217!IM +++
218!         IF(abs(conv_te(i)).GE.0.0025.AND.abs(conv_q(i)).GE.0.05) THEN
219!           PRINT*,'DIV','i=',i,te_zref_con(i),te_zref(i),conv_te(i), &
220!           q_zref_con(i),q_zref(i),conv_q(i)
221!         ENDIF
222!IM ---
223!       ENDDO
[5099]224
[3817]225      DO i = 1, knon
226        q_zref_c(i) = q_zref(i)
227        temp_c(i) = temp(i)
[5099]228
[3817]229!       IF(zri1(i).LT.0.) THEN
230!         IF(nsrf.EQ.1) THEN
231!           ok_pred(i)=1.
232!           ok_corr(i)=0.
233!         ELSE
234!           ok_pred(i)=0.
235!           ok_corr(i)=1.
236!         ENDIF
237!       ELSE
238!         ok_pred(i)=0.
239!         ok_corr(i)=1.
240!       ENDIF
[5099]241
[3817]242        ok_pred(i)=0.
243        ok_corr(i)=1.
[5099]244
[3817]245        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
246        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
247!IM +++
248!       IF(n.EQ.niter) THEN
249!       IF(t_2m(i).LT.t1(i).AND.t_2m(i).LT.ts1(i)) THEN
250!         PRINT*,' BAD t2m LT ',i,nsrf,t_2m(i),t1(i),ts1(i)
251!       ELSEIF(t_2m(i).GT.t1(i).AND.t_2m(i).GT.ts1(i)) THEN
252!         PRINT*,' BAD t2m GT ',i,nsrf,t_2m(i),t1(i),ts1(i)
253!       ENDIF
254!       ENDIF
255!IM ---
256      ENDDO
[5099]257
258
[3817]259!----------First aproximation of variables at zref --------------------------
[5099]260
[3817]261      zref = 10.0
262      CALL screenp(klon, knon, nsrf, speed, tpot, q1, &
[5087]263                   ts1, qsurf, z0m, lmon, &
264                   ustar, testar, qstar, zref, &
265                   delu, delte, delq)
[5099]266
[3817]267      DO i = 1, knon
268        u_zref(i) = delu(i)
269        q_zref(i) = max(qsurf(i),0.0) + delq(i)
270        te_zref(i) = ts1(i) + delte(i)
271        temp(i) = te_zref(i) * (psol(i)/pat1(i))**(-RKAPPA)
272!       temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
273!                 (1 + RVTMP2 * max(q_zref(i),0.0))
274        u_zref_p(i) = u_zref(i)
275      ENDDO
[5099]276
[3817]277! Iteration of the variables at the reference level zref : corrector ; see Hess & McAvaney, 1995
[5099]278
[3817]279      DO n = 1, niter
[5099]280
[3817]281        okri=.TRUE.
282        CALL screenc(klon, knon, nsrf, zxli, &
[5087]283                     u_zref, temp, q_zref, zref, &
284                     ts1, qsurf, z0m, z0h, psol, &
285                     ustar, testar, qstar, okri, ri1, &
286                     pref, delu, delte, delq, s_pblh ,prain, tsol, pat1)
[5099]287
[3817]288        DO i = 1, knon
289          u_zref(i) = delu(i)
290          q_zref(i) = delq(i) + max(qsurf(i),0.0)
291          te_zref(i) = delte(i) + ts1(i)
292          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
293!         temp(i) = te_zref(i) - (zref* RG)/RCPD/ &
294!                   (1 + RVTMP2 * max(q_zref(i),0.0))
295        ENDDO
[5099]296
[3817]297      ENDDO
[5099]298
[3817]299      DO i = 1, knon
300        u_zref_c(i) = u_zref(i)
[5099]301
[3817]302        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
[5099]303
[3817]304!AM
305        q_zref_c(i) = q_zref(i)
306        temp_c(i) = temp(i)
307        t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
308        q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
309!MA
310      ENDDO
[5099]311
[5105]312
[5103]313      END SUBROUTINE stdlevvar
[5099]314
[3817]315      SUBROUTINE stdlevvarn(klon, knon, nsrf, zxli, &
316                           u1, v1, t1, q1, z1, &
317                           ts1, qsurf, z0m, z0h, psol, pat1, &
[3839]318                           t_2m, q_2m, t_10m, q_10m, u_10m, ustar, &
319                           n2mout)
[5099]320
[5112]321      USE lmdz_ioipsl_getin_p, ONLY: getin_p
[3817]322      IMPLICIT NONE
323!-------------------------------------------------------------------------
[5099]324
[3817]325! Objet : calcul de la temperature et l'humidite relative a 2m et du
326!         module du vent a 10m a partir des relations de Dyer-Businger et
327!         des equations de Louis.
[5099]328
[3817]329! Reference : Hess, Colman et McAvaney (1995)       
[5099]330
[3817]331! I. Musat, 01.07.2002
[5099]332
[3817]333!AM On rajoute en sortie t et q a 10m pr le calcule d'hbtm2 dans clmain
[5099]334
[3817]335!-------------------------------------------------------------------------
[5099]336
[3817]337! klon----input-I- dimension de la grille physique (= nb_pts_latitude X nb_pts_longitude)
338! knon----input-I- nombre de points pour un type de surface
339! nsrf----input-I- indice pour le type de surface; voir indice_sol_mod.F90
340! zxli----input-L- TRUE si calcul des cdrags selon Laurent Li
341! u1------input-R- vent zonal au 1er niveau du modele
342! v1------input-R- vent meridien au 1er niveau du modele
343! t1------input-R- temperature de l'air au 1er niveau du modele
344! q1------input-R- humidite relative au 1er niveau du modele
345! z1------input-R- geopotentiel au 1er niveau du modele
346! ts1-----input-R- temperature de l'air a la surface
347! qsurf---input-R- humidite relative a la surface
348! z0m, z0h---input-R- rugosite
349! psol----input-R- pression au sol
350! pat1----input-R- pression au 1er niveau du modele
[5099]351
[3817]352! t_2m---output-R- temperature de l'air a 2m
353! q_2m---output-R- humidite relative a 2m
354! u_2m--output-R- vitesse du vent a 2m
355! u_10m--output-R- vitesse du vent a 10m
[3839]356! ustar--output-R- u*
[3817]357!AM
358! t_10m--output-R- temperature de l'air a 10m
359! q_10m--output-R- humidite specifique a 10m
[5099]360
[5117]361      INTEGER, INTENT(IN) :: klon, knon, nsrf
362      LOGICAL, INTENT(IN) :: zxli
363      REAL, DIMENSION(klon), INTENT(IN) :: u1, v1, t1, q1, ts1, z1
364      REAL, DIMENSION(klon), INTENT(INOUT) :: z0m, z0h
365      REAL, DIMENSION(klon), INTENT(IN) :: qsurf
366      REAL, DIMENSION(klon), INTENT(IN) :: psol, pat1
[5099]367
[5117]368      REAL, DIMENSION(klon), INTENT(OUT) :: t_2m, q_2m, ustar
369      REAL, DIMENSION(klon), INTENT(OUT) :: u_10m, t_10m, q_10m
370      INTEGER, DIMENSION(klon, 6), INTENT(OUT) :: n2mout
[5099]371
[5117]372      REAL, DIMENSION(klon) :: u_2m
373      REAL, DIMENSION(klon) :: cdrm2m, cdrh2m, ri2m
374      REAL, DIMENSION(klon) :: cdram, cdrah, zri1
375      REAL, DIMENSION(klon) :: cdmn1, cdhn1, fm1, fh1
376      REAL, DIMENSION(klon) :: cdmn2m, cdhn2m, fm2m, fh2m
377      REAL, DIMENSION(klon) :: ri2m_new
[4722]378      REAL, DIMENSION(klon) :: s_pblh
379      REAL, DIMENSION(klon) :: prain
380      REAL, DIMENSION(klon) :: tsol
[3817]381!-------------------------------------------------------------------------
382      include "flux_arp.h"
383      include "YOMCST.h"
384!IM PLUS
385      include "YOETHF.h"
[5099]386
[3817]387! Quelques constantes et options:
[5099]388
[3817]389! RKAR : constante de von Karman
390      REAL, PARAMETER :: RKAR=0.40
391! niter : nombre iterations calcul "corrector"
392!     INTEGER, parameter :: niter=6, ncon=niter-1
393!IM 071020     INTEGER, parameter :: niter=2, ncon=niter-1
394      INTEGER, parameter :: niter=2, ncon=niter
395!     INTEGER, parameter :: niter=6, ncon=niter
[5099]396
[3817]397! Variables locales
398      INTEGER :: i, n
399      REAL :: zref
[5117]400      REAL, DIMENSION(klon) :: speed
[3817]401! tpot : temperature potentielle
[5117]402      REAL, DIMENSION(klon) :: tpot
403      REAL, DIMENSION(klon) :: cdran
[3817]404! ri1 : nb. de Richardson entre la surface --> la 1ere couche
[5117]405      REAL, DIMENSION(klon) :: ri1
[3817]406      DOUBLE PRECISION, parameter :: eps=1.0D-20
[5117]407      REAL, DIMENSION(klon) :: delu, delte, delq
408      REAL, DIMENSION(klon) :: delh, delm
409      REAL, DIMENSION(klon) :: delh_new, delm_new
410      REAL, DIMENSION(klon) :: u_zref, te_zref, q_zref
411      REAL, DIMENSION(klon) :: u_zref_pnew, te_zref_pnew, q_zref_pnew
412      REAL, DIMENSION(klon) :: temp, pref
413      REAL, DIMENSION(klon) :: temp_new, pref_new
[3817]414      LOGICAL :: okri
[5117]415      REAL, DIMENSION(klon) :: u_zref_p, te_zref_p, temp_p, q_zref_p
416      REAL, DIMENSION(klon) :: u_zref_p_new, te_zref_p_new, temp_p_new, q_zref_p_new
[3817]417!convergence
[5117]418      REAL, DIMENSION(klon) :: te_zref_con, q_zref_con
419      REAL, DIMENSION(klon) :: u_zref_c, te_zref_c, temp_c, q_zref_c
420      REAL, DIMENSION(klon) :: ok_pred, ok_corr
[5099]421
[5117]422      REAL, DIMENSION(klon) :: cdrm10m, cdrh10m, ri10m
423      REAL, DIMENSION(klon) :: cdmn10m, cdhn10m, fm10m, fh10m
424      REAL, DIMENSION(klon) :: cdn2m, cdn1, zri_zero
[3817]425      REAL :: CEPDUE,zdu2
426      INTEGER :: nzref, nz1
[5117]427      LOGICAL, DIMENSION(klon) :: ok_t2m_toosmall, ok_t2m_toobig
428      LOGICAL, DIMENSION(klon) :: ok_q2m_toosmall, ok_q2m_toobig
429      LOGICAL, DIMENSION(klon) :: ok_u2m_toobig
430      LOGICAL, DIMENSION(klon) :: ok_t10m_toosmall, ok_t10m_toobig
431      LOGICAL, DIMENSION(klon) :: ok_q10m_toosmall, ok_q10m_toobig
432      LOGICAL, DIMENSION(klon) :: ok_u10m_toobig
433      INTEGER, DIMENSION(klon, 6) :: n10mout
[3817]434
435!-------------------------------------------------------------------------
436      CEPDUE=0.1
[5099]437
[3817]438! n2mout : compteur des pas de temps ou t2m,q2m ou u2m sont en dehors des intervalles
439!          [tsurf, temp], [qsurf, q1] ou [0, speed]
[3831]440! n10mout : compteur des pas de temps ou t10m,q10m ou u10m sont en dehors des intervalles
441!          [tsurf, temp], [qsurf, q1] ou [0, speed]
[5099]442
[3817]443      n2mout(:,:)=0
[3831]444      n10mout(:,:)=0
[3817]445     
446      DO i=1, knon
447       speed(i)=MAX(SQRT(u1(i)**2+v1(i)**2),CEPDUE)
448       ri1(i) = 0.0
449      ENDDO
[5099]450
[3817]451      okri=.FALSE.
452      CALL cdrag(knon, nsrf, &
[5087]453                     speed, t1, q1, z1, &
454                     psol, s_pblh, ts1, qsurf, z0m, z0h, &
455                     zri_zero, 0, &
456                     cdram, cdrah, zri1, pref, prain, tsol, pat1)
[3817]457
458      DO i = 1, knon
459        ri1(i) = zri1(i)
460        tpot(i) = t1(i)* (psol(i)/pat1(i))**RKAPPA
461        zdu2 = MAX(CEPDUE*CEPDUE, speed(i)**2)
[3839]462        ustar(i) = sqrt(cdram(i) * zdu2)
[5099]463
[3817]464      ENDDO
[5099]465
[3817]466!----------First aproximation of variables at zref --------------------------
467      zref = 2.0
[5099]468
[3817]469! calcul first-guess en utilisant dans les calculs à 2m
470! le Richardson de la premiere couche atmospherique
[5099]471
[3817]472       CALL screencn(klon, knon, nsrf, zxli, &
[5087]473                     speed, tpot, q1, zref, &
474                     ts1, qsurf, z0m, z0h, psol, &
475                     cdram, cdrah,  okri, &
476                     ri1, 1, &
477                     pref_new, delm_new, delh_new, ri2m, &
478                     s_pblh, prain, tsol, pat1      )
[5099]479
[3817]480       DO i = 1, knon
481         u_zref(i) = delm_new(i)*speed(i)
482         u_zref_p(i) = u_zref(i)
483         q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
[5087]484             max(qsurf(i),0.0)*(1-delh_new(i))
[3817]485         q_zref_p(i) = q_zref(i)
486         te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
487         te_zref_p(i) = te_zref(i)
[5099]488
[3817]489! return to normal temperature
490         temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
491         temp_p(i) = temp(i)
[5099]492
[3817]493! compteurs ici
[5099]494
[5082]495         ok_t2m_toosmall(i)=te_zref(i)<tpot(i).AND. &
[5087]496   te_zref(i)<ts1(i)
[5082]497         ok_t2m_toobig(i)=te_zref(i)>tpot(i).AND. &
[5087]498   te_zref(i)>ts1(i)
[5082]499         ok_q2m_toosmall(i)=q_zref(i)<q1(i).AND. &
[5087]500   q_zref(i)<qsurf(i)
[5082]501         ok_q2m_toobig(i)=q_zref(i)>q1(i).AND. &
[5087]502   q_zref(i)>qsurf(i)
[5082]503         ok_u2m_toobig(i)=u_zref(i)>speed(i)
[5099]504
[3817]505         IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
506             n2mout(i,1)=n2mout(i,1)+1
507         ENDIF
508         IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
509             n2mout(i,3)=n2mout(i,3)+1
510         ENDIF
511         IF(ok_u2m_toobig(i)) THEN
512             n2mout(i,5)=n2mout(i,5)+1
513         ENDIF
[5099]514
[3817]515         IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
[5087]516   ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
517   ok_u2m_toobig(i)) THEN
[3817]518             delm_new(i)=min(max(delm_new(i),0.),1.)
519             delh_new(i)=min(max(delh_new(i),0.),1.)
520             u_zref(i) = delm_new(i)*speed(i)
521             u_zref_p(i) = u_zref(i)
522             q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
[5087]523                 max(qsurf(i),0.0)*(1-delh_new(i))
[3817]524             q_zref_p(i) = q_zref(i)
525             te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
526             te_zref_p(i) = te_zref(i)
[5099]527
[3817]528! return to normal temperature
529             temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
530             temp_p(i) = temp(i)
531         ENDIF
[5099]532
[3817]533       ENDDO
[5099]534
[3817]535! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
[5099]536
[3817]537      DO n = 1, niter
[5099]538
[3817]539        okri=.TRUE.
540        CALL screencn(klon, knon, nsrf, zxli, &
[5087]541                     u_zref, temp, q_zref, zref, &
542                     ts1, qsurf, z0m, z0h, psol, &
543                     cdram, cdrah,  okri, &
544                     ri1, 0, &
545                     pref, delm, delh, ri2m, &
546                     s_pblh, prain, tsol, pat1      )
[5099]547
[3817]548        DO i = 1, knon
549          u_zref(i) = delm(i)*speed(i)
550          q_zref(i) = delh(i)*max(q1(i),0.0) + &
[5087]551             max(qsurf(i),0.0)*(1-delh(i))
[3817]552          te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
[5099]553
[3817]554! return to normal temperature
555          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
[5099]556
[3817]557! compteurs ici
[5099]558
[5082]559          ok_t2m_toosmall(i)=te_zref(i)<tpot(i).AND. &
[5087]560   te_zref(i)<ts1(i)
[5082]561          ok_t2m_toobig(i)=te_zref(i)>tpot(i).AND. &
[5087]562   te_zref(i)>ts1(i)
[5082]563          ok_q2m_toosmall(i)=q_zref(i)<q1(i).AND. &
[5087]564   q_zref(i)<qsurf(i)
[5082]565          ok_q2m_toobig(i)=q_zref(i)>q1(i).AND. &
[5087]566   q_zref(i)>qsurf(i)
[5082]567          ok_u2m_toobig(i)=u_zref(i)>speed(i)
[5099]568
[3817]569          IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i)) THEN
570              n2mout(i,2)=n2mout(i,2)+1
571          ENDIF
572          IF(ok_q2m_toosmall(i).OR.ok_q2m_toobig(i)) THEN
573              n2mout(i,4)=n2mout(i,4)+1
574          ENDIF
575          IF(ok_u2m_toobig(i)) THEN
576              n2mout(i,6)=n2mout(i,6)+1
577          ENDIF
[5099]578
[3817]579          IF(ok_t2m_toosmall(i).OR.ok_t2m_toobig(i).OR. &
[5087]580   ok_q2m_toosmall(i).OR.ok_q2m_toobig(i).OR. &
581   ok_u2m_toobig(i)) THEN
[3817]582              delm(i)=min(max(delm(i),0.),1.)
583              delh(i)=min(max(delh(i),0.),1.)
584              u_zref(i) = delm(i)*speed(i)
585              q_zref(i) = delh(i)*max(q1(i),0.0) + &
[5087]586             max(qsurf(i),0.0)*(1-delh(i))
[3817]587              te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
588              temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
589          ENDIF
[5099]590
591
[5082]592          IF(n==ncon) THEN
[3817]593            te_zref_con(i) = te_zref(i)
594            q_zref_con(i) = q_zref(i)
595          ENDIF
[5099]596
[3817]597        ENDDO
[5099]598
[3817]599      ENDDO
[5099]600
[3817]601      DO i = 1, knon
602        q_zref_c(i) = q_zref(i)
603        temp_c(i) = temp(i)
[5099]604
[3817]605        ok_pred(i)=0.
606        ok_corr(i)=1.
[5099]607
[3817]608        t_2m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
609        q_2m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
[5099]610
[3817]611        u_zref_c(i) = u_zref(i)
612        u_2m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
613      ENDDO
[5099]614
615
[3817]616!----------First aproximation of variables at zref --------------------------
[5099]617
[3817]618      zref = 10.0
[5099]619
[3821]620       CALL screencn(klon, knon, nsrf, zxli, &
[5087]621                     speed, tpot, q1, zref, &
622                     ts1, qsurf, z0m, z0h, psol, &
623                     cdram, cdrah,  okri, &
624                     ri1, 1, &
625                     pref_new, delm_new, delh_new, ri10m, &
626                     s_pblh, prain, tsol, pat1      )
[5099]627
[3821]628       DO i = 1, knon
629         u_zref(i) = delm_new(i)*speed(i)
630         q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
[5087]631             max(qsurf(i),0.0)*(1-delh_new(i))
[3821]632         te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
633         temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
634         u_zref_p(i) = u_zref(i)
[5099]635
[3821]636! compteurs ici
[5099]637
[5082]638         ok_t10m_toosmall(i)=te_zref(i)<tpot(i).AND. &
[5087]639   te_zref(i)<ts1(i)
[5082]640         ok_t10m_toobig(i)=te_zref(i)>tpot(i).AND. &
[5087]641   te_zref(i)>ts1(i)
[5082]642         ok_q10m_toosmall(i)=q_zref(i)<q1(i).AND. &
[5087]643   q_zref(i)<qsurf(i)
[5082]644         ok_q10m_toobig(i)=q_zref(i)>q1(i).AND. &
[5087]645   q_zref(i)>qsurf(i)
[5082]646         ok_u10m_toobig(i)=u_zref(i)>speed(i)
[5099]647
[3831]648         IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
649             n10mout(i,1)=n10mout(i,1)+1
650         ENDIF
651         IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
652             n10mout(i,3)=n10mout(i,3)+1
653         ENDIF
654         IF(ok_u10m_toobig(i)) THEN
655             n10mout(i,5)=n10mout(i,5)+1
656         ENDIF
[5099]657
[3821]658         IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
[5087]659   ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
660   ok_u10m_toobig(i)) THEN
[3821]661             delm_new(i)=min(max(delm_new(i),0.),1.)
662             delh_new(i)=min(max(delh_new(i),0.),1.)
663             u_zref(i) = delm_new(i)*speed(i)
664             u_zref_p(i) = u_zref(i)
665             q_zref(i) = delh_new(i)*max(q1(i),0.0) + &
[5087]666                 max(qsurf(i),0.0)*(1-delh_new(i))
[3821]667             te_zref(i) = delh_new(i)*tpot(i) + ts1(i)*(1-delh_new(i))
668             temp(i) = te_zref(i) * (psol(i)/pref_new(i))**(-RKAPPA)
669         ENDIF
[5099]670
[3821]671       ENDDO
[5099]672
[3821]673! Iteration of the variables at the reference level zref : corrector calculation ; see Hess & McAvaney, 1995
[5099]674
[3817]675      DO n = 1, niter
[5099]676
[3817]677        okri=.TRUE.
678        CALL screencn(klon, knon, nsrf, zxli, &
[5087]679                     u_zref, temp, q_zref, zref, &
680                     ts1, qsurf, z0m, z0h, psol, &
681                     cdram, cdrah,  okri, &
682                     ri1, 0, &
683                     pref, delm, delh, ri10m, &
684                     s_pblh, prain, tsol, pat1      )
[5099]685
[3817]686        DO i = 1, knon
687          u_zref(i) = delm(i)*speed(i)
688          q_zref(i) = delh(i)*max(q1(i),0.0) + &
[5087]689             max(qsurf(i),0.0)*(1-delh(i))
[3817]690          te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
[5099]691
[3821]692! return to normal temperature
[3817]693          temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
[5099]694
[3821]695! compteurs ici
[5099]696
[5082]697          ok_t10m_toosmall(i)=te_zref(i)<tpot(i).AND. &
[5087]698   te_zref(i)<ts1(i)
[5082]699          ok_t10m_toobig(i)=te_zref(i)>tpot(i).AND. &
[5087]700   te_zref(i)>ts1(i)
[5082]701          ok_q10m_toosmall(i)=q_zref(i)<q1(i).AND. &
[5087]702   q_zref(i)<qsurf(i)
[5082]703          ok_q10m_toobig(i)=q_zref(i)>q1(i).AND. &
[5087]704   q_zref(i)>qsurf(i)
[5082]705          ok_u10m_toobig(i)=u_zref(i)>speed(i)
[5099]706
[3821]707          IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i)) THEN
708              n10mout(i,2)=n10mout(i,2)+1
709          ENDIF
710          IF(ok_q10m_toosmall(i).OR.ok_q10m_toobig(i)) THEN
711              n10mout(i,4)=n10mout(i,4)+1
712          ENDIF
713          IF(ok_u10m_toobig(i)) THEN
714              n10mout(i,6)=n10mout(i,6)+1
715          ENDIF
[5099]716
[3821]717          IF(ok_t10m_toosmall(i).OR.ok_t10m_toobig(i).OR. &
[5087]718   ok_q10m_toosmall(i).OR.ok_q10m_toobig(i).OR. &
719   ok_u10m_toobig(i)) THEN
[3821]720              delm(i)=min(max(delm(i),0.),1.)
721              delh(i)=min(max(delh(i),0.),1.)
722              u_zref(i) = delm(i)*speed(i)
723              q_zref(i) = delh(i)*max(q1(i),0.0) + &
[5087]724             max(qsurf(i),0.0)*(1-delh(i))
[3821]725              te_zref(i) = delh(i)*tpot(i) + ts1(i)*(1-delh(i))
726              temp(i) = te_zref(i) * (psol(i)/pref(i))**(-RKAPPA)
727          ENDIF
[5099]728
729
[5082]730          IF(n==ncon) THEN
[3821]731            te_zref_con(i) = te_zref(i)
732            q_zref_con(i) = q_zref(i)
733          ENDIF
[5099]734
[3817]735        ENDDO
[5099]736
[3821]737      ENDDO
[5099]738
[3817]739      DO i = 1, knon
[3821]740        q_zref_c(i) = q_zref(i)
741        temp_c(i) = temp(i)
[5099]742
[3821]743        ok_pred(i)=0.
744        ok_corr(i)=1.
[5099]745
[3817]746        t_10m(i) = temp_p(i) * ok_pred(i) + temp_c(i) * ok_corr(i)
747        q_10m(i) = q_zref_p(i) * ok_pred(i) + q_zref_c(i) * ok_corr(i)
[5099]748
[3821]749        u_zref_c(i) = u_zref(i)
750        u_10m(i) = u_zref_p(i) * ok_pred(i) + u_zref_c(i) * ok_corr(i)
[3817]751      ENDDO
[5099]752
[5105]753
[5103]754      END SUBROUTINE stdlevvarn
[3817]755
756END MODULE stdlevvar_mod
Note: See TracBrowser for help on using the repository browser.