Context Navigation

calwake.F @ 1388

Last change on this file since 1388 was 1322, checked in by Laurent Fairhead, 14 years ago

Improvements concerning wake parametrisation (from JYG, NR, IT, with more to come).
Alp_offset is read in form physiq.def file

Améliorations à la paramétrisation des poches froides (de JYG, NR, IT, d'autres
sont à venir)
Alp_offset est rajouté à la liste des paramètres lus dans physiq.def

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 14.2 KB

Line
1	!
2	! $Id: calwake.F 1322 2010-03-12 10:54:11Z fairhead $
3	!
4	SUBROUTINE CALWAKE(paprs,pplay,dtime
5	: ,t,q,omgb
6	: ,dt_dwn,dq_dwn,M_dwn,M_up
7	: ,dt_a,dq_a,sigd
8	: ,wdt_PBL,wdq_PBL
9	: ,udt_PBL,udq_PBL
10	o ,wake_deltat,wake_deltaq,wake_dth
11	o ,wake_h,wake_s,wake_dens
12	o ,wake_pe,wake_fip,wake_gfl
13	o ,dt_wake,dq_wake
14	o ,wake_k
15	o ,undi_t,undi_q
16	o ,wake_omgbdth,wake_dp_omgb
17	o ,wake_dtKE,wake_dqKE
18	o ,wake_dtPBL,wake_dqPBL
19	o ,wake_omg,wake_dp_deltomg
20	o ,wake_spread,wake_Cstar,wake_d_deltat_gw
21	o ,wake_ddeltat,wake_ddeltaq)
22	***************************************************************
23	* *
24	* CALWAKE *
25	* interface avec le schema de calcul de la poche *
26	* froide *
27	* *
28	* written by : CHERUY Frederique, 13/03/2000, 10.31.05 *
29	* modified by : ROEHRIG Romain, 01/30/2007 *
30	***************************************************************
31	*
32	USE dimphy
33	IMPLICIT none
34	c======================================================================
35	#include "dimensions.h"
36	!#include "dimphy.h"
37	#include "YOMCST.h"
38
39	c Arguments
40	c----------
41
42	INTEGER i,l,ktopw(klon)
43	REAL dtime
44
45	REAL paprs(klon,klev+1),pplay(klon,klev)
46	REAL t(klon,klev), q(klon,klev), omgb(klon,klev)
47	REAL dt_dwn(klon,klev), dq_dwn(klon,klev),M_dwn(klon,klev)
48	REAL M_up(klon,klev)
49	REAL dt_a(klon,klev), dq_a(klon,klev)
50	REAL wdt_PBL(klon,klev), wdq_PBL(klon,klev)
51	REAL udt_PBL(klon,klev), udq_PBL(klon,klev)
52	REAL wake_deltat(klon,klev),wake_deltaq(klon,klev)
53	REAL dt_wake(klon,klev),dq_wake(klon,klev)
54	REAL wake_d_deltat_gw(klon,klev)
55	REAL wake_h(klon),wake_s(klon)
56	REAL wake_dth(klon,klev)
57	REAL wake_pe(klon),wake_fip(klon),wake_gfl(klon)
58	REAL undi_t(klon,klev),undi_q(klon,klev)
59	REAL wake_omgbdth(klon,klev),wake_dp_omgb(klon,klev)
60	REAL wake_dtKE(klon,klev),wake_dqKE(klon,klev)
61	REAL wake_dtPBL(klon,klev),wake_dqPBL(klon,klev)
62	REAL wake_omg(klon,klev+1),wake_dp_deltomg(klon,klev)
63	REAL wake_spread(klon,klev),wake_Cstar(klon)
64	REAL wake_ddeltat(klon,klev),wake_ddeltaq(klon,klev)
65	REAL d_deltatw(klon,klev), d_deltaqw(klon,klev)
66	INTEGER wake_k(klon)
67	REAL sigd(klon)
68	REAL wake_dens(klon)
69
70	C Variable internes
71	C -----------------
72
73	REAL aire
74	REAL p(klon,klev),ph(klon,klev+1),pi(klon,klev)
75	REAL te(klon,klev),qe(klon,klev),omgbe(klon,klev+1)
76	REAL dtdwn(klon,klev),dqdwn(klon,klev)
77	REAL dta(klon,klev),dqa(klon,klev)
78	REAL wdtPBL(klon,klev),wdqPBL(klon,klev)
79	REAL udtPBL(klon,klev),udqPBL(klon,klev)
80	REAL amdwn(klon,klev),amup(klon,klev)
81	REAL dtw(klon,klev),dqw(klon,klev),dth(klon,klev)
82	REAL d_deltat_gw(klon,klev)
83	REAL dtls(klon,klev),dqls(klon,klev)
84	REAL tu(klon,klev),qu(klon,klev)
85	REAL hw(klon),sigmaw(klon),wape(klon),fip(klon),gfl(klon)
86	REAL omgbdth(klon,klev),dp_omgb(klon,klev)
87	REAL dtKE(klon,klev),dqKE(klon,klev)
88	REAL dtPBL(klon,klev),dqPBL(klon,klev)
89	REAL omg(klon,klev+1),dp_deltomg(klon,klev),spread(klon,klev)
90	REAL Cstar(klon)
91	REAL sigd0(klon),wdens(klon)
92
93	REAL RDCP
94
95	c print *, '-> calwake, wake_s ', wake_s(1)
96
97	RDCP=1./3.5
98
99
100	c-----------------------------------------------------------
101	cIM 290108 DO 999 i=1,klon ! a vectoriser
102	c----------------------------------------------------------
103
104
105	DO l=1,klev
106	DO i=1,klon
107	p(i,l)= pplay(i,l)
108	ph(i,l)= paprs(i,l)
109	pi(i,l) = (pplay(i,l)/100000.)**RDCP
110
111	te(i,l) = t(i,l)
112	qe(i,l) = q(i,l)
113	omgbe(i,l) = omgb(i,l)
114
115	dtdwn(i,l)= dt_dwn(i,l)
116	dqdwn(i,l)= dq_dwn(i,l)
117	dta(i,l)= dt_a(i,l)
118	dqa(i,l)= dq_a(i,l)
119	wdtPBL(i,l)= wdt_PBL(i,l)
120	wdqPBL(i,l)= wdq_PBL(i,l)
121	udtPBL(i,l)= udt_PBL(i,l)
122	udqPBL(i,l)= udq_PBL(i,l)
123	ENDDO
124	ENDDO
125
126	omgbe(:,klev+1) = 0.
127
128	DO i=1,klon
129	sigd0(i)=sigd(i)
130	ENDDO
131	c print*, 'sigd0,sigd', sigd0, sigd(i)
132	DO i=1,klon
133	ph(i,klev+1)=0.
134	ENDDO
135
136	DO i=1,klon
137	ktopw(i) = wake_k(i)
138	ENDDO
139
140	DO l=1,klev
141	DO i=1,klon
142	dtw(i,l) = wake_deltat(i,l)
143	dqw(i,l) = wake_deltaq(i,l)
144	ENDDO
145	ENDDO
146
147	DO l=1,klev
148	DO i=1,klon
149	dtls(i,l)=dt_wake(i,l)
150	dqls(i,l)=dq_wake(i,l)
151	ENDDO
152	ENDDO
153
154	DO i=1,klon
155	hw(i) = wake_h(i)
156	sigmaw(i)= wake_s(i)
157	ENDDO
158
159	cfkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
160	cfkc on veut le flux de masse au milieu des couches
161
162	DO l=1,klev-1
163	DO i=1,klon
164	amdwn(i,l)= 0.5*(M_dwn(i,l)+M_dwn(i,l+1))
165	amdwn(i,l)= (M_dwn(i,l+1))
166	ENDDO
167	ENDDO
168
169	c au sommet le flux de masse est nul
170
171	DO i=1,klon
172	amdwn(i,klev)=0.5*M_dwn(i,klev)
173	ENDDO
174	c
175	DO l = 1,klev
176	DO i=1,klon
177	amup(i,l)=M_up(i,l)
178	ENDDO
179	ENDDO
180
181	call WAKE(p,ph,pi,dtime,sigd0
182	$ ,te,qe,omgbe
183	$ ,dtdwn,dqdwn,amdwn,amup,dta,dqa
184	$ ,wdtPBL,wdqPBL,udtPBL,udqPBL
185	$ ,dtw,dqw,dth,hw,sigmaw,wape,fip,gfl
186	$ ,dtls,dqls,ktopw
187	$ ,omgbdth,dp_omgb,wdens
188	$ ,tu,qu
189	$ ,dtKE,dqKE
190	$ ,dtPBL,dqPBL
191	$ ,omg,dp_deltomg,spread
192	$ ,Cstar,d_deltat_gw
193	$ ,d_deltatw,d_deltaqw)
194	c
195	DO l=1,klev
196	DO i=1,klon
197	IF (ktopw(i) .GT. 0) THEN
198	wake_deltat(i,l)= dtw(i,l)
199	wake_deltaq(i,l)= dqw(i,l)
200	wake_d_deltat_gw(i,l)= d_deltat_gw(i,l)
201	wake_omgbdth(i,l) = omgbdth(i,l)
202	wake_dp_omgb(i,l) = dp_omgb(i,l)
203	wake_dtKE(i,l) = dtKE(i,l)
204	wake_dqKE(i,l) = dqKE(i,l)
205	wake_dtPBL(i,l) = dtPBL(i,l)
206	wake_dqPBL(i,l) = dqPBL(i,l)
207	wake_omg(i,l) = omg(i,l)
208	wake_dp_deltomg(i,l) = dp_deltomg(i,l)
209	wake_spread(i,l) = spread(i,l)
210	wake_dth(i,l) = dth(i,l)
211	dt_wake(i,l) = dtls(i,l)
212	dq_wake(i,l) = dqls(i,l)
213	undi_t(i,l) = tu(i,l)
214	undi_q(i,l) = qu(i,l)
215	wake_ddeltat(i,l) = d_deltatw(i,l)
216	wake_ddeltaq(i,l) = d_deltaqw(i,l)
217	ELSE
218	wake_deltat(i,l)= 0.
219	wake_deltaq(i,l)= 0.
220	wake_d_deltat_gw(i,l)= 0.
221	wake_omgbdth(i,l) = 0.
222	wake_dp_omgb(i,l) = 0.
223	wake_dtKE(i,l) = 0.
224	wake_dqKE(i,l) = 0.
225	wake_dtPBL(i,l) = 0.
226	wake_dqPBL(i,l) = 0.
227	wake_omg(i,l) = 0.
228	wake_dp_deltomg(i,l) = 0.
229	wake_spread(i,l) = 0.
230	wake_dth(i,l)=0.
231	dt_wake(i,l)=0.
232	dq_wake(i,l)=0.
233	undi_t(i,l)=te(i,l)
234	undi_q(i,l)=qe(i,l)
235	wake_ddeltat(i,l) = 0.
236	wake_ddeltaq(i,l) = 0.
237	ENDIF
238	ENDDO
239	ENDDO
240	c
241	DO i=1,klon
242	wake_h(i)= hw(i)
243	wake_s(i)= sigmaw(i)
244	wake_pe(i)= wape(i)
245	wake_fip(i)= fip(i)
246	wake_gfl(i) = gfl(i)
247	wake_k(i) =ktopw(i)
248	wake_Cstar(i) = Cstar(i)
249	wake_dens(i) = wdens(i)
250	ENDDO
251	c
252	RETURN
253	END
254
255	SUBROUTINE CALWAKE_scal(paprs,pplay,dtime
256	: ,t,q,omgb
257	: ,dt_dwn,dq_dwn,M_dwn,M_up
258	: ,dt_a,dq_a,sigd
259	: ,wdt_PBL,wdq_PBL
260	: ,udt_PBL,udq_PBL
261	o ,wake_deltat,wake_deltaq,wake_dth
262	o ,wake_h,wake_s,wake_dens
263	o ,wake_pe,wake_fip,wake_gfl
264	o ,dt_wake,dq_wake
265	o ,wake_k
266	o ,undi_t,undi_q
267	o ,wake_omgbdth,wake_dp_omgb
268	o ,wake_dtKE,wake_dqKE
269	o ,wake_dtPBL,wake_dqPBL
270	o ,wake_omg,wake_dp_deltomg
271	o ,wake_spread,wake_Cstar,wake_d_deltat_gw
272	o ,wake_ddeltat,wake_ddeltaq)
273	***************************************************************
274	* *
275	* CALWAKE *
276	* interface avec le schema de calcul de la poche *
277	* froide *
278	* *
279	* written by : CHERUY Frederique, 13/03/2000, 10.31.05 *
280	* modified by : ROEHRIG Romain, 01/30/2007 *
281	***************************************************************
282	*
283	USE dimphy
284	IMPLICIT none
285	c======================================================================
286
287	#include "dimensions.h"
288	cccc#include "dimphy.h"
289	#include "YOMCST.h"
290
291	c Arguments
292	c----------
293
294	INTEGER i,l,ktopw
295	REAL dtime
296
297	REAL paprs(klon,klev+1),pplay(klon,klev)
298	REAL t(klon,klev), q(klon,klev), omgb(klon,klev)
299	REAL dt_dwn(klon,klev), dq_dwn(klon,klev),M_dwn(klon,klev)
300	REAL M_up(klon,klev)
301	REAL dt_a(klon,klev), dq_a(klon,klev)
302	REAL wdt_PBL(klon,klev), wdq_PBL(klon,klev)
303	REAL udt_PBL(klon,klev), udq_PBL(klon,klev)
304	REAL wake_deltat(klon,klev),wake_deltaq(klon,klev)
305	REAL dt_wake(klon,klev),dq_wake(klon,klev)
306	REAL wake_d_deltat_gw(klon,klev)
307	REAL wake_h(klon),wake_s(klon)
308	REAL wake_dth(klon,klev)
309	REAL wake_pe(klon),wake_fip(klon),wake_gfl(klon)
310	REAL undi_t(klon,klev),undi_q(klon,klev)
311	REAL wake_omgbdth(klon,klev),wake_dp_omgb(klon,klev)
312	REAL wake_dtKE(klon,klev),wake_dqKE(klon,klev)
313	REAL wake_dtPBL(klon,klev),wake_dqPBL(klon,klev)
314	REAL wake_omg(klon,klev+1),wake_dp_deltomg(klon,klev)
315	REAL wake_spread(klon,klev),wake_Cstar(klon)
316	REAL wake_ddeltat(klon,klev),wake_ddeltaq(klon,klev)
317	REAL d_deltatw(klev), d_deltaqw(klev)
318	INTEGER wake_k(klon)
319	REAL sigd(klon)
320	REAL wake_dens(klon)
321
322	C Variable internes
323	C -----------------
324
325	REAL aire
326	REAL p(klev),ph(klev+1),pi(klev)
327	REAL te(klev),qe(klev),omgbe(klev),dtdwn(klev),dqdwn(klev)
328	REAL dta(klev),dqa(klev)
329	REAL wdtPBL(klev),wdqPBL(klev)
330	REAL udtPBL(klev),udqPBL(klev)
331	REAL amdwn(klev),amup(klev)
332	REAL dtw(klev),dqw(klev),dth(klev),d_deltat_gw(klev)
333	REAL dtls(klev),dqls(klev)
334	REAL tu(klev),qu(klev)
335	REAL hw,sigmaw,wape,fip,gfl
336	REAL omgbdth(klev),dp_omgb(klev)
337	REAL dtKE(klev),dqKE(klev)
338	REAL dtPBL(klev),dqPBL(klev)
339	REAL omg(klev+1),dp_deltomg(klev),spread(klev),Cstar
340	REAL sigd0,wdens
341
342	REAL RDCP
343
344	c print *, '-> calwake, wake_s ', wake_s(1)
345
346	RDCP=1./3.5
347
348	c-----------------------------------------------------------
349	DO 999 i=1,klon ! a vectoriser
350	c----------------------------------------------------------
351
352
353	DO l=1,klev
354	p(l)= pplay(i,l)
355	ph(l)= paprs(i,l)
356	pi(l) = (pplay(i,l)/100000.)**RDCP
357
358	te(l) = t(i,l)
359	qe(l) = q(i,l)
360	omgbe(l) = omgb(i,l)
361
362	dtdwn(l)= dt_dwn(i,l)
363	dqdwn(l)= dq_dwn(i,l)
364	dta(l)= dt_a(i,l)
365	dqa(l)= dq_a(i,l)
366	wdtPBL(l)= wdt_PBL(i,l)
367	wdqPBL(l)= wdq_PBL(i,l)
368	udtPBL(l)= udt_PBL(i,l)
369	udqPBL(l)= udq_PBL(i,l)
370	ENDDO
371
372	sigd0=sigd(i)
373	c print*, 'sigd0,sigd', sigd0, sigd(i)
374	ph(klev+1)=0.
375
376	ktopw = wake_k(i)
377
378	DO l=1,klev
379	dtw(l) = wake_deltat(i,l)
380	dqw(l) = wake_deltaq(i,l)
381	ENDDO
382
383	DO l=1,klev
384	dtls(l)=dt_wake(i,l)
385	dqls(l)=dq_wake(i,l)
386	ENDDO
387
388	hw = wake_h(i)
389	sigmaw = wake_s(i)
390
391	cfkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
392	cfkc on veut le flux de masse au milieu des couches
393
394	DO l=1,klev-1
395	amdwn(l)= 0.5*(M_dwn(i,l)+M_dwn(i,l+1))
396	amdwn(l)= (M_dwn(i,l+1))
397	ENDDO
398
399	c au sommet le flux de masse est nul
400
401	amdwn(klev)=0.5*M_dwn(i,klev)
402	c
403	DO l = 1,klev
404	amup(l)=M_up(i,l)
405	ENDDO
406
407	call WAKE_scal(p,ph,pi,dtime,sigd0
408	$ ,te,qe,omgbe
409	$ ,dtdwn,dqdwn,amdwn,amup,dta,dqa
410	$ ,wdtPBL,wdqPBL,udtPBL,udqPBL
411	$ ,dtw,dqw,dth,hw,sigmaw,wape,fip,gfl
412	$ ,dtls,dqls,ktopw
413	$ ,omgbdth,dp_omgb,wdens
414	$ ,tu,qu
415	$ ,dtKE,dqKE
416	$ ,dtPBL,dqPBL
417	$ ,omg,dp_deltomg,spread
418	$ ,Cstar,d_deltat_gw
419	$ ,d_deltatw,d_deltaqw)
420
421	IF (ktopw .GT. 0) THEN
422	DO l=1,klev
423	wake_deltat(i,l)= dtw(l)
424	wake_deltaq(i,l)= dqw(l)
425	wake_d_deltat_gw(i,l)= d_deltat_gw(l)
426	wake_omgbdth(i,l) = omgbdth(l)
427	wake_dp_omgb(i,l) = dp_omgb(l)
428	wake_dtKE(i,l) = dtKE(l)
429	wake_dqKE(i,l) = dqKE(l)
430	wake_dtPBL(i,l) = dtPBL(l)
431	wake_dqPBL(i,l) = dqPBL(l)
432	wake_omg(i,l) = omg(l)
433	wake_dp_deltomg(i,l) = dp_deltomg(l)
434	wake_spread(i,l) = spread(l)
435	wake_dth(i,l) = dth(l)
436	dt_wake(i,l) = dtls(l)
437	dq_wake(i,l) = dqls(l)
438	undi_t(i,l) = tu(l)
439	undi_q(i,l) = qu(l)
440	wake_ddeltat(i,l) = d_deltatw(l)
441	wake_ddeltaq(i,l) = d_deltaqw(l)
442	ENDDO
443	ELSE
444	DO l = 1,klev
445	wake_deltat(i,l)= 0.
446	wake_deltaq(i,l)= 0.
447	wake_d_deltat_gw(i,l)= 0.
448	wake_omgbdth(i,l) = 0.
449	wake_dp_omgb(i,l) = 0.
450	wake_dtKE(i,l) = 0.
451	wake_dqKE(i,l) = 0.
452	wake_omg(i,l) = 0.
453	wake_dp_deltomg(i,l) = 0.
454	wake_spread(i,l) = 0.
455	wake_dth(i,l)=0.
456	dt_wake(i,l)=0.
457	dq_wake(i,l)=0.
458	undi_t(i,l)=te(l)
459	undi_q(i,l)=qe(l)
460	ENDDO
461	ENDIF
462
463	wake_h(i)= hw
464	wake_s(i)= sigmaw
465	wake_pe(i)= wape
466	wake_fip(i)= fip
467	wake_gfl(i) = gfl
468	wake_k(i) =ktopw
469	wake_Cstar(i) = Cstar
470	wake_dens(i) = wdens
471	c
472	999 CONTINUE
473	c
474	RETURN
475	END

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

Download in other formats:

Original Format