Context Navigation

nuage.F @ 453

Last change on this file since 453 was 390, checked in by lmdzadmin, 22 years ago
Bug sur le common nuage LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 9.3 KB

Line
1	SUBROUTINE nuage (paprs, pplay,
2	. t, pqlwp, pclc, pcltau, pclemi,
3	. pch, pcl, pcm, pct, pctlwp)
4	IMPLICIT none
5	c======================================================================
6	c Auteur(s): Z.X. Li (LMD/CNRS) date: 19930910
7	c Objet: Calculer epaisseur optique et emmissivite des nuages
8	c======================================================================
9	c Arguments:
10	c t-------input-R-temperature
11	c pqlwp---input-R-eau liquide nuageuse dans l'atmosphere (kg/kg)
12	c pclc----input-R-couverture nuageuse pour le rayonnement (0 a 1)
13	c
14	c pcltau--output-R-epaisseur optique des nuages
15	c pclemi--output-R-emissivite des nuages (0 a 1)
16	c======================================================================
17	C
18	#include "YOMCST.h"
19	c
20	#include "dimensions.h"
21	#include "dimphy.h"
22	#include "nuage.h"
23	REAL paprs(klon,klev+1), pplay(klon,klev)
24	REAL t(klon,klev)
25	c
26	REAL pclc(klon,klev)
27	REAL pqlwp(klon,klev)
28	REAL pcltau(klon,klev), pclemi(klon,klev)
29	c
30	REAL pct(klon), pctlwp(klon), pch(klon), pcl(klon), pcm(klon)
31	c
32	LOGICAL lo
33	c
34	REAL cetahb, cetamb
35	PARAMETER (cetahb = 0.45, cetamb = 0.80)
36	C
37	INTEGER i, k
38	REAL zflwp, zradef, zfice, zmsac
39	c
40	REAL radius, rad_chaud
41	ccc PARAMETER (rad_chau1=13.0, rad_chau2=9.0, rad_froid=35.0)
42	ccc PARAMETER (rad_chaud=15.0, rad_froid=35.0)
43	c sintex initial PARAMETER (rad_chaud=10.0, rad_froid=30.0)
44	REAL coef, coef_froi, coef_chau
45	PARAMETER (coef_chau=0.13, coef_froi=0.09)
46	REAL seuil_neb, t_glace
47	PARAMETER (seuil_neb=0.001, t_glace=273.0-15.0)
48	INTEGER nexpo ! exponentiel pour glace/eau
49	PARAMETER (nexpo=6)
50	ccc PARAMETER (nexpo=1)
51	c
52	c Calculer l'epaisseur optique et l'emmissivite des nuages
53	c
54	DO k = 1, klev
55	DO i = 1, klon
56	rad_chaud = rad_chau1
57	IF (k.LE.3) rad_chaud = rad_chau2
58	pclc(i,k) = MAX(pclc(i,k), seuil_neb)
59	zflwp = 1000.*pqlwp(i,k)/RG/pclc(i,k)
60	. *(paprs(i,k)-paprs(i,k+1))
61	zfice = 1.0 - (t(i,k)-t_glace) / (273.13-t_glace)
62	zfice = MIN(MAX(zfice,0.0),1.0)
63	zfice = zfice**nexpo
64	radius = rad_chaud * (1.-zfice) + rad_froid * zfice
65	coef = coef_chau * (1.-zfice) + coef_froi * zfice
66	pcltau(i,k) = 3.0/2.0 * zflwp / radius
67	pclemi(i,k) = 1.0 - EXP( - coef * zflwp)
68	lo = (pclc(i,k) .LE. seuil_neb)
69	IF (lo) pclc(i,k) = 0.0
70	IF (lo) pcltau(i,k) = 0.0
71	IF (lo) pclemi(i,k) = 0.0
72	ENDDO
73	ENDDO
74	ccc DO k = 1, klev
75	ccc DO i = 1, klon
76	ccc t(i,k) = t(i,k)
77	ccc pclc(i,k) = MAX( 1.e-5 , pclc(i,k) )
78	ccc lo = pclc(i,k) .GT. (2.*1.e-5)
79	ccc zflwp = pqlwp(i,k)1000.(paprs(i,k)-paprs(i,k+1))
80	ccc . /(rg*pclc(i,k))
81	ccc zradef = 10.0 + (1.-sigs(k))*45.0
82	ccc pcltau(i,k) = 1.5 * zflwp / zradef
83	ccc zfice=1.0-MIN(MAX((t(i,k)-263.)/(273.-263.),0.0),1.0)
84	ccc zmsac = 0.13(1.0-zfice) + 0.08zfice
85	ccc pclemi(i,k) = 1.-EXP(-zmsac*zflwp)
86	ccc if (.NOT.lo) pclc(i,k) = 0.0
87	ccc if (.NOT.lo) pcltau(i,k) = 0.0
88	ccc if (.NOT.lo) pclemi(i,k) = 0.0
89	ccc ENDDO
90	ccc ENDDO
91	cccccc print*, 'pas de nuage dans le rayonnement'
92	cccccc DO k = 1, klev
93	cccccc DO i = 1, klon
94	cccccc pclc(i,k) = 0.0
95	cccccc pcltau(i,k) = 0.0
96	cccccc pclemi(i,k) = 0.0
97	cccccc ENDDO
98	cccccc ENDDO
99	C
100	C COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
101	C
102	DO i = 1, klon
103	pct(i)=1.0
104	pch(i)=1.0
105	pcm(i) = 1.0
106	pcl(i) = 1.0
107	pctlwp(i) = 0.0
108	ENDDO
109	C
110	DO k = klev, 1, -1
111	DO i = 1, klon
112	pctlwp(i) = pctlwp(i)
113	. + pqlwp(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
114	pct(i) = pct(i)*(1.0-pclc(i,k))
115	if (pplay(i,k).LE.cetahb*paprs(i,1))
116	. pch(i) = pch(i)*(1.0-pclc(i,k))
117	if (pplay(i,k).GT.cetahb*paprs(i,1) .AND.
118	. pplay(i,k).LE.cetamb*paprs(i,1))
119	. pcm(i) = pcm(i)*(1.0-pclc(i,k))
120	if (pplay(i,k).GT.cetamb*paprs(i,1))
121	. pcl(i) = pcl(i)*(1.0-pclc(i,k))
122	ENDDO
123	ENDDO
124	C
125	DO i = 1, klon
126	pct(i)=1.-pct(i)
127	pch(i)=1.-pch(i)
128	pcm(i)=1.-pcm(i)
129	pcl(i)=1.-pcl(i)
130	ENDDO
131	C
132	RETURN
133	END
134	SUBROUTINE diagcld1(paprs,pplay,rain,snow,kbot,ktop,
135	. diafra,dialiq)
136	IMPLICIT none
137	c
138	c Laurent Li (LMD/CNRS), le 12 octobre 1998
139	c (adaptation du code ECMWF)
140	c
141	c Dans certains cas, le schema pronostique des nuages n'est
142	c pas suffisament performant. On a donc besoin de diagnostiquer
143	c ces nuages. Je dois avouer que c'est une frustration.
144	c
145	#include "dimensions.h"
146	#include "dimphy.h"
147	#include "YOMCST.h"
148	c
149	c Arguments d'entree:
150	REAL paprs(klon,klev+1) ! pression (Pa) a inter-couche
151	REAL pplay(klon,klev) ! pression (Pa) au milieu de couche
152	REAL t(klon,klev) ! temperature (K)
153	REAL q(klon,klev) ! humidite specifique (Kg/Kg)
154	REAL rain(klon) ! pluie convective (kg/m2/s)
155	REAL snow(klon) ! neige convective (kg/m2/s)
156	INTEGER ktop(klon) ! sommet de la convection
157	INTEGER kbot(klon) ! bas de la convection
158	c
159	c Arguments de sortie:
160	REAL diafra(klon,klev) ! fraction nuageuse diagnostiquee
161	REAL dialiq(klon,klev) ! eau liquide nuageuse
162	c
163	c Constantes ajustables:
164	REAL CANVA, CANVB, CANVH
165	PARAMETER (CANVA=2.0, CANVB=0.3, CANVH=0.4)
166	REAL CCA, CCB, CCC
167	PARAMETER (CCA=0.125, CCB=1.5, CCC=0.8)
168	REAL CCFCT, CCSCAL
169	PARAMETER (CCFCT=0.400)
170	PARAMETER (CCSCAL=1.0E+11)
171	REAL CETAHB, CETAMB
172	PARAMETER (CETAHB=0.45, CETAMB=0.80)
173	REAL CCLWMR
174	PARAMETER (CCLWMR=1.E-04)
175	REAL ZEPSCR
176	PARAMETER (ZEPSCR=1.0E-10)
177	c
178	c Variables locales:
179	INTEGER i, k
180	REAL zcc(klon)
181	c
182	c Initialisation:
183	c
184	DO k = 1, klev
185	DO i = 1, klon
186	diafra(i,k) = 0.0
187	dialiq(i,k) = 0.0
188	ENDDO
189	ENDDO
190	c
191	DO i = 1, klon ! Calculer la fraction nuageuse
192	zcc(i) = 0.0
193	IF((rain(i)+snow(i)).GT.0.) THEN
194	zcc(i)= CCA * LOG(MAX(ZEPSCR,(rain(i)+snow(i))*CCSCAL))-CCB
195	zcc(i)= MIN(CCC,MAX(0.0,zcc(i)))
196	ENDIF
197	ENDDO
198	c
199	DO i = 1, klon ! pour traiter les enclumes
200	diafra(i,ktop(i)) = MAX(diafra(i,ktop(i)),zcc(i)*CCFCT)
201	IF ((zcc(i).GE.CANVH) .AND.
202	. (pplay(i,ktop(i)).LE.CETAHB*paprs(i,1)))
203	. diafra(i,ktop(i)) = MAX(diafra(i,ktop(i)),
204	. MAX(zcc(i)CCFCT,CANVA(zcc(i)-CANVB)))
205	dialiq(i,ktop(i))=CCLWMR*diafra(i,ktop(i))
206	ENDDO
207	c
208	DO k = 1, klev ! nuages convectifs (sauf enclumes)
209	DO i = 1, klon
210	IF (k.LT.ktop(i) .AND. k.GE.kbot(i)) THEN
211	diafra(i,k)=MAX(diafra(i,k),zcc(i)*CCFCT)
212	dialiq(i,k)=CCLWMR*diafra(i,k)
213	ENDIF
214	ENDDO
215	ENDDO
216	c
217	RETURN
218	END
219	SUBROUTINE diagcld2(paprs,pplay,t,q, diafra,dialiq)
220	IMPLICIT none
221	c
222	#include "dimensions.h"
223	#include "dimphy.h"
224	#include "YOMCST.h"
225	c
226	c Arguments d'entree:
227	REAL paprs(klon,klev+1) ! pression (Pa) a inter-couche
228	REAL pplay(klon,klev) ! pression (Pa) au milieu de couche
229	REAL t(klon,klev) ! temperature (K)
230	REAL q(klon,klev) ! humidite specifique (Kg/Kg)
231	c
232	c Arguments de sortie:
233	REAL diafra(klon,klev) ! fraction nuageuse diagnostiquee
234	REAL dialiq(klon,klev) ! eau liquide nuageuse
235	c
236	REAL CETAMB
237	PARAMETER (CETAMB=0.80)
238	REAL CLOIA, CLOIB, CLOIC, CLOID
239	PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.6, CLOID=5.0)
240	ccc PARAMETER (CLOIA=1.0E+02, CLOIB=-10.00, CLOIC=-0.9, CLOID=5.0)
241	REAL RGAMMAS
242	PARAMETER (RGAMMAS=0.05)
243	REAL CRHL
244	PARAMETER (CRHL=0.15)
245	ccc PARAMETER (CRHL=0.70)
246	REAL t_coup
247	PARAMETER (t_coup=234.0)
248	c
249	c Variables locales:
250	INTEGER i, k, kb, invb(klon)
251	REAL zqs, zrhb, zcll, zdthmin(klon), zdthdp
252	REAL zdelta, zcor
253	c
254	c Fonctions thermodynamiques:
255	#include "YOETHF.h"
256	#include "FCTTRE.h"
257	c
258	c Initialisation:
259	c
260	DO k = 1, klev
261	DO i = 1, klon
262	diafra(i,k) = 0.0
263	dialiq(i,k) = 0.0
264	ENDDO
265	ENDDO
266	c
267	DO i = 1, klon
268	invb(i) = klev
269	zdthmin(i)=0.0
270	ENDDO
271
272	DO k = 2, klev/2-1
273	DO i = 1, klon
274	zdthdp = (t(i,k)-t(i,k+1))/(pplay(i,k)-pplay(i,k+1))
275	. - RD * 0.5*(t(i,k)+t(i,k+1))/RCPD/paprs(i,k+1)
276	zdthdp = zdthdp * CLOIA
277	IF (pplay(i,k).GT.CETAMB*paprs(i,1) .AND.
278	. zdthdp.LT.zdthmin(i) ) THEN
279	zdthmin(i) = zdthdp
280	invb(i) = k
281	ENDIF
282	ENDDO
283	ENDDO
284
285	DO i = 1, klon
286	kb=invb(i)
287	IF (thermcep) THEN
288	zdelta=MAX(0.,SIGN(1.,RTT-t(i,kb)))
289	zqs= R2ES*FOEEW(t(i,kb),zdelta)/pplay(i,kb)
290	zqs=MIN(0.5,zqs)
291	zcor=1./(1.-RETV*zqs)
292	zqs=zqs*zcor
293	ELSE
294	IF (t(i,kb) .LT. t_coup) THEN
295	zqs = qsats(t(i,kb)) / pplay(i,kb)
296	ELSE
297	zqs = qsatl(t(i,kb)) / pplay(i,kb)
298	ENDIF
299	ENDIF
300	zcll = CLOIB * zdthmin(i) + CLOIC
301	zcll = MIN(1.0,MAX(0.0,zcll))
302	zrhb= q(i,kb)/zqs
303	IF (zcll.GT.0.0.AND.zrhb.LT.CRHL)
304	. zcll=zcll(1.-(CRHL-zrhb)CLOID)
305	zcll=MIN(1.0,MAX(0.0,zcll))
306	diafra(i,kb) = MAX(diafra(i,kb),zcll)
307	dialiq(i,kb)= diafra(i,kb) * RGAMMAS*zqs
308	ENDDO
309	c
310	RETURN
311	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format