1 | SUBROUTINE bl_for_dms(u, v, paprs, pplay, cdragh, cdragm & |
---|
2 | , t, q, tsol, ustar, obklen) |
---|
3 | USE dimphy |
---|
4 | IMPLICIT NONE |
---|
5 | ! |
---|
6 | !=================================================================== |
---|
7 | ! Auteur : E. Cosme |
---|
8 | ! Calcul de la vitesse de friction (ustar) et de la longueur de |
---|
9 | ! Monin-Obukhov (obklen), necessaires pour calculer les flux de DMS |
---|
10 | ! par la methode de Nightingale. |
---|
11 | ! Cette SUBROUTINE est plus que fortement inspiree de la subroutine |
---|
12 | ! 'nonlocal' dans clmain.F . |
---|
13 | ! reference : Holtslag, A.A.M., and B.A. Boville, 1993: |
---|
14 | ! Local versus nonlocal boundary-layer diffusion in a global climate |
---|
15 | ! model. J. of Climate, vol. 6, 1825-1842. (a confirmer) |
---|
16 | ! 31 08 01 |
---|
17 | !=================================================================== |
---|
18 | ! |
---|
19 | INCLUDE "dimensions.h" |
---|
20 | INCLUDE "YOMCST.h" |
---|
21 | INCLUDE "YOETHF.h" |
---|
22 | INCLUDE "FCTTRE.h" |
---|
23 | ! |
---|
24 | ! Arguments : |
---|
25 | REAL :: u(klon, klev) ! vent zonal |
---|
26 | REAL :: v(klon, klev) ! vent meridien |
---|
27 | REAL :: paprs(klon, klev + 1) ! niveaux de pression aux intercouches (Pa) |
---|
28 | REAL :: pplay(klon, klev) ! niveaux de pression aux milieux... (Pa) |
---|
29 | REAL :: cdragh(klon) ! coefficient de trainee pour la chaleur |
---|
30 | REAL :: cdragm(klon) ! coefficient de trainee pour le vent |
---|
31 | REAL :: t(klon, klev) ! temperature |
---|
32 | REAL :: q(klon, klev) ! humidite kg/kg |
---|
33 | REAL :: tsol(klon) ! temperature du sol |
---|
34 | REAL :: ustar(klon) ! vitesse de friction |
---|
35 | REAL :: obklen(klon) ! longueur de Monin-Obukhov |
---|
36 | ! |
---|
37 | ! Locales : |
---|
38 | REAL :: vk |
---|
39 | PARAMETER (vk = 0.35) |
---|
40 | REAL :: beta ! coefficient d'evaporation reelle (/evapotranspiration) |
---|
41 | ! entre 0 et 1, mais 1 au-dessus de la mer |
---|
42 | PARAMETER (beta = 1.) |
---|
43 | INTEGER :: i, k |
---|
44 | REAL :: zxt, zxu, zxv, zxq, zxqs, zxmod, taux, tauy |
---|
45 | REAL :: zcor, zdelta, zcvm5 |
---|
46 | REAL :: z(klon, klev) |
---|
47 | REAL :: zx_alf1, zx_alf2 ! parametres pour extrapolation |
---|
48 | REAL :: khfs(klon) ! surface kinematic heat flux [mK/s] |
---|
49 | REAL :: kqfs(klon) ! sfc kinematic constituent flux [m/s] |
---|
50 | REAL :: heatv(klon) ! surface virtual heat flux |
---|
51 | |
---|
52 | |
---|
53 | ! |
---|
54 | !====================================================================== |
---|
55 | ! |
---|
56 | ! Calculer les hauteurs de chaque couche |
---|
57 | ! |
---|
58 | ! JE20150707 r2es=611.14 *18.0153/28.9644 |
---|
59 | DO i = 1, klon |
---|
60 | z(i, 1) = RD * t(i, 1) / (0.5 * (paprs(i, 1) + pplay(i, 1))) & |
---|
61 | * (paprs(i, 1) - pplay(i, 1)) / RG |
---|
62 | ENDDO |
---|
63 | DO k = 2, klev |
---|
64 | DO i = 1, klon |
---|
65 | z(i, k) = z(i, k - 1) & |
---|
66 | + RD * 0.5 * (t(i, k - 1) + t(i, k)) / paprs(i, k) & |
---|
67 | * (pplay(i, k - 1) - pplay(i, k)) / RG |
---|
68 | ENDDO |
---|
69 | ENDDO |
---|
70 | |
---|
71 | DO i = 1, klon |
---|
72 | ! |
---|
73 | zdelta = MAX(0., SIGN(1., RTT - tsol(i))) |
---|
74 | zcvm5 = R5LES * RLVTT * (1. - zdelta) + R5IES * RLSTT * zdelta |
---|
75 | zcvm5 = zcvm5 / RCPD / (1.0 + RVTMP2 * q(i, 1)) |
---|
76 | zxqs = r2es * FOEEW(tsol(i), zdelta) / paprs(i, 1) |
---|
77 | zxqs = MIN(0.5, zxqs) |
---|
78 | zcor = 1. / (1. - retv * zxqs) |
---|
79 | zxqs = zxqs * zcor |
---|
80 | ! |
---|
81 | zx_alf1 = 1.0 |
---|
82 | zx_alf2 = 1.0 - zx_alf1 |
---|
83 | zxt = (t(i, 1) + z(i, 1) * RG / RCPD / (1. + RVTMP2 * q(i, 1))) & |
---|
84 | * (1. + RETV * q(i, 1)) * zx_alf1 & |
---|
85 | + (t(i, 2) + z(i, 2) * RG / RCPD / (1. + RVTMP2 * q(i, 2))) & |
---|
86 | * (1. + RETV * q(i, 2)) * zx_alf2 |
---|
87 | zxu = u(i, 1) * zx_alf1 + u(i, 2) * zx_alf2 |
---|
88 | zxv = v(i, 1) * zx_alf1 + v(i, 2) * zx_alf2 |
---|
89 | zxq = q(i, 1) * zx_alf1 + q(i, 2) * zx_alf2 |
---|
90 | zxmod = 1.0 + SQRT(zxu**2 + zxv**2) |
---|
91 | khfs(i) = (tsol(i) * (1. + RETV * q(i, 1)) - zxt) * zxmod * cdragh(i) |
---|
92 | kqfs(i) = (zxqs - zxq) * zxmod * cdragh(i) * beta |
---|
93 | heatv(i) = khfs(i) + 0.61 * zxt * kqfs(i) |
---|
94 | taux = zxu * zxmod * cdragm(i) |
---|
95 | tauy = zxv * zxmod * cdragm(i) |
---|
96 | ustar(i) = SQRT(taux**2 + tauy**2) |
---|
97 | ustar(i) = MAX(SQRT(ustar(i)), 0.01) |
---|
98 | ! |
---|
99 | ENDDO |
---|
100 | ! |
---|
101 | DO i = 1, klon |
---|
102 | obklen(i) = -t(i, 1) * ustar(i)**3 / (RG * vk * heatv(i)) |
---|
103 | ENDDO |
---|
104 | ! |
---|
105 | END SUBROUTINE |
---|