1 |
module nuage_m |
2 |
|
3 |
IMPLICIT none |
4 |
|
5 |
contains |
6 |
|
7 |
SUBROUTINE nuage (paprs, pplay, t, pqlwp, pclc, pcltau, pclemi, pch, pcl, & |
8 |
pcm, pct, pctlwp) |
9 |
|
10 |
! From LMDZ4/libf/phylmd/nuage.F, version 1.1.1.1, 2004/05/19 12:53:07 |
11 |
|
12 |
use dimphy, only: klon, klev |
13 |
use SUPHEC_M, only: rg |
14 |
|
15 |
! Author: Z. X. Li (LMD/CNRS) |
16 |
! Date: 1993/09/10 |
17 |
! Objet: Calculer \'epaisseur optique et \'emissivit\'e des nuages |
18 |
|
19 |
! Arguments: |
20 |
|
21 |
REAL, intent(in):: paprs(klon, klev+1) |
22 |
real, intent(in):: pplay(klon, klev) |
23 |
REAL, intent(in):: t(klon, klev) ! temperature |
24 |
|
25 |
REAL, intent(in):: pqlwp(klon, klev) |
26 |
! eau liquide nuageuse dans l'atmosphere (kg/kg) |
27 |
|
28 |
REAL, intent(inout):: pclc(klon, klev) |
29 |
! couverture nuageuse pour le rayonnement (0 \`a 1) |
30 |
|
31 |
REAL, intent(out):: pcltau(klon, klev) ! \'epaisseur optique des nuages |
32 |
real, intent(out):: pclemi(klon, klev) ! \'emissivit\'e des nuages (0 \`a 1) |
33 |
REAL pch(klon), pcl(klon), pcm(klon), pct(klon), pctlwp(klon) |
34 |
|
35 |
! Local: |
36 |
|
37 |
LOGICAL lo |
38 |
|
39 |
REAL cetahb, cetamb |
40 |
PARAMETER (cetahb = 0.45, cetamb = 0.80) |
41 |
|
42 |
INTEGER i, k |
43 |
REAL zflwp, zfice |
44 |
|
45 |
REAL radius, rad_froid, rad_chaud, rad_chau1, rad_chau2 |
46 |
PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0) |
47 |
REAL coef, coef_froi, coef_chau |
48 |
PARAMETER (coef_chau=0.13, coef_froi=0.09) |
49 |
REAL seuil_neb, t_glace |
50 |
PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0) |
51 |
INTEGER nexpo ! exponentiel pour glace/eau |
52 |
PARAMETER (nexpo=6) |
53 |
|
54 |
!-------------------------------------------------------------------- |
55 |
|
56 |
! Calculer l'epaisseur optique et l'emmissivite des nuages |
57 |
|
58 |
DO k = 1, klev |
59 |
DO i = 1, klon |
60 |
rad_chaud = rad_chau1 |
61 |
IF (k <= 3) rad_chaud = rad_chau2 |
62 |
|
63 |
pclc(i, k) = MAX(pclc(i, k), seuil_neb) |
64 |
zflwp = 1000.*pqlwp(i, k)/RG/pclc(i, k) & |
65 |
*(paprs(i, k)-paprs(i, k+1)) |
66 |
zfice = 1.0 - (t(i, k)-t_glace) / (273.13-t_glace) |
67 |
zfice = MIN(MAX(zfice, 0.0), 1.0) |
68 |
zfice = zfice**nexpo |
69 |
|
70 |
radius = rad_chaud * (1.-zfice) + rad_froid * zfice |
71 |
coef = coef_chau * (1.-zfice) + coef_froi * zfice |
72 |
pcltau(i, k) = 3.0/2.0 * zflwp / radius |
73 |
pclemi(i, k) = 1.0 - EXP(- coef * zflwp) |
74 |
lo = (pclc(i, k) <= seuil_neb) |
75 |
IF (lo) pclc(i, k) = 0.0 |
76 |
IF (lo) pcltau(i, k) = 0.0 |
77 |
IF (lo) pclemi(i, k) = 0.0 |
78 |
END DO |
79 |
END DO |
80 |
|
81 |
! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS |
82 |
|
83 |
DO i = 1, klon |
84 |
pct(i)=1.0 |
85 |
pch(i)=1.0 |
86 |
pcm(i) = 1.0 |
87 |
pcl(i) = 1.0 |
88 |
pctlwp(i) = 0.0 |
89 |
END DO |
90 |
|
91 |
DO k = klev, 1, -1 |
92 |
DO i = 1, klon |
93 |
pctlwp(i) = pctlwp(i) & |
94 |
+ pqlwp(i, k)*(paprs(i, k)-paprs(i, k+1))/RG |
95 |
pct(i) = pct(i)*(1.0-pclc(i, k)) |
96 |
if (pplay(i, k) <= cetahb*paprs(i, 1)) & |
97 |
pch(i) = pch(i)*(1.0-pclc(i, k)) |
98 |
if (pplay(i, k) > cetahb*paprs(i, 1) .AND. & |
99 |
pplay(i, k) <= cetamb*paprs(i, 1)) & |
100 |
pcm(i) = pcm(i)*(1.0-pclc(i, k)) |
101 |
if (pplay(i, k) > cetamb*paprs(i, 1)) & |
102 |
pcl(i) = pcl(i)*(1.0-pclc(i, k)) |
103 |
END DO |
104 |
END DO |
105 |
|
106 |
DO i = 1, klon |
107 |
pct(i)=1.-pct(i) |
108 |
pch(i)=1.-pch(i) |
109 |
pcm(i)=1.-pcm(i) |
110 |
pcl(i)=1.-pcl(i) |
111 |
END DO |
112 |
|
113 |
END SUBROUTINE nuage |
114 |
|
115 |
end module nuage_m |