Context Navigation

nuage.F @ 281

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

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

Download in other formats:

Original Format