1 |
guez |
175 |
module nuage_m |
2 |
|
|
|
3 |
guez |
51 |
IMPLICIT none |
4 |
guez |
3 |
|
5 |
guez |
175 |
contains |
6 |
guez |
3 |
|
7 |
guez |
175 |
SUBROUTINE nuage (paprs, pplay, t, pqlwp, pclc, pcltau, pclemi, pch, pcl, & |
8 |
guez |
217 |
pcm, pct, pctlwp) |
9 |
guez |
213 |
|
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 |
guez |
217 |
use SUPHEC_M, only: rg |
14 |
guez |
213 |
|
15 |
|
|
! Author: Z. X. Li (LMD/CNRS) |
16 |
|
|
! Date: 1993/09/10 |
17 |
|
|
! Objet: Calculer \'epaisseur optique et \'emissivit\'e des nuages |
18 |
|
|
|
19 |
guez |
175 |
! Arguments: |
20 |
guez |
213 |
|
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 |
guez |
217 |
REAL, intent(out):: pcltau(klon, klev) ! \'epaisseur optique des nuages |
32 |
|
|
real pclemi(klon, klev) ! pclemi--output-R-emissivite des nuages (0 a 1) |
33 |
guez |
213 |
REAL pch(klon), pcl(klon), pcm(klon), pct(klon), pctlwp(klon) |
34 |
|
|
|
35 |
|
|
! Local: |
36 |
|
|
|
37 |
guez |
175 |
LOGICAL lo |
38 |
guez |
213 |
|
39 |
guez |
175 |
REAL cetahb, cetamb |
40 |
|
|
PARAMETER (cetahb = 0.45, cetamb = 0.80) |
41 |
guez |
213 |
|
42 |
guez |
175 |
INTEGER i, k |
43 |
|
|
REAL zflwp, zfice |
44 |
guez |
213 |
|
45 |
guez |
175 |
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 |
guez |
213 |
!cc PARAMETER (rad_chaud=15.0, rad_froid=35.0) |
48 |
|
|
! sintex initial PARAMETER (rad_chaud=10.0, rad_froid=30.0) |
49 |
guez |
175 |
REAL coef, coef_froi, coef_chau |
50 |
|
|
PARAMETER (coef_chau=0.13, coef_froi=0.09) |
51 |
|
|
REAL seuil_neb, t_glace |
52 |
|
|
PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0) |
53 |
|
|
INTEGER nexpo ! exponentiel pour glace/eau |
54 |
|
|
PARAMETER (nexpo=6) |
55 |
guez |
51 |
|
56 |
guez |
213 |
!-------------------------------------------------------------------- |
57 |
|
|
|
58 |
|
|
! Calculer l'epaisseur optique et l'emmissivite des nuages |
59 |
guez |
51 |
|
60 |
guez |
175 |
DO k = 1, klev |
61 |
|
|
DO i = 1, klon |
62 |
|
|
rad_chaud = rad_chau1 |
63 |
guez |
213 |
IF (k <= 3) rad_chaud = rad_chau2 |
64 |
guez |
51 |
|
65 |
guez |
213 |
pclc(i, k) = MAX(pclc(i, k), seuil_neb) |
66 |
|
|
zflwp = 1000.*pqlwp(i, k)/RG/pclc(i, k) & |
67 |
|
|
*(paprs(i, k)-paprs(i, k+1)) |
68 |
|
|
zfice = 1.0 - (t(i, k)-t_glace) / (273.13-t_glace) |
69 |
|
|
zfice = MIN(MAX(zfice, 0.0), 1.0) |
70 |
guez |
175 |
zfice = zfice**nexpo |
71 |
guez |
51 |
|
72 |
guez |
175 |
radius = rad_chaud * (1.-zfice) + rad_froid * zfice |
73 |
|
|
coef = coef_chau * (1.-zfice) + coef_froi * zfice |
74 |
guez |
213 |
pcltau(i, k) = 3.0/2.0 * zflwp / radius |
75 |
|
|
pclemi(i, k) = 1.0 - EXP(- coef * zflwp) |
76 |
|
|
lo = (pclc(i, k) <= seuil_neb) |
77 |
|
|
IF (lo) pclc(i, k) = 0.0 |
78 |
|
|
IF (lo) pcltau(i, k) = 0.0 |
79 |
|
|
IF (lo) pclemi(i, k) = 0.0 |
80 |
guez |
175 |
END DO |
81 |
|
|
END DO |
82 |
guez |
213 |
|
83 |
guez |
175 |
! COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS |
84 |
guez |
213 |
|
85 |
guez |
175 |
DO i = 1, klon |
86 |
|
|
pct(i)=1.0 |
87 |
|
|
pch(i)=1.0 |
88 |
|
|
pcm(i) = 1.0 |
89 |
|
|
pcl(i) = 1.0 |
90 |
|
|
pctlwp(i) = 0.0 |
91 |
|
|
END DO |
92 |
guez |
213 |
|
93 |
guez |
175 |
DO k = klev, 1, -1 |
94 |
|
|
DO i = 1, klon |
95 |
guez |
213 |
pctlwp(i) = pctlwp(i) & |
96 |
|
|
+ pqlwp(i, k)*(paprs(i, k)-paprs(i, k+1))/RG |
97 |
|
|
pct(i) = pct(i)*(1.0-pclc(i, k)) |
98 |
|
|
if (pplay(i, k) <= cetahb*paprs(i, 1)) & |
99 |
|
|
pch(i) = pch(i)*(1.0-pclc(i, k)) |
100 |
|
|
if (pplay(i, k) > cetahb*paprs(i, 1) .AND. & |
101 |
|
|
pplay(i, k) <= cetamb*paprs(i, 1)) & |
102 |
|
|
pcm(i) = pcm(i)*(1.0-pclc(i, k)) |
103 |
|
|
if (pplay(i, k) > cetamb*paprs(i, 1)) & |
104 |
|
|
pcl(i) = pcl(i)*(1.0-pclc(i, k)) |
105 |
guez |
175 |
END DO |
106 |
|
|
END DO |
107 |
guez |
213 |
|
108 |
guez |
175 |
DO i = 1, klon |
109 |
|
|
pct(i)=1.-pct(i) |
110 |
|
|
pch(i)=1.-pch(i) |
111 |
|
|
pcm(i)=1.-pcm(i) |
112 |
|
|
pcl(i)=1.-pcl(i) |
113 |
|
|
END DO |
114 |
guez |
213 |
|
115 |
guez |
175 |
END SUBROUTINE nuage |
116 |
|
|
|
117 |
|
|
end module nuage_m |