Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

calwake.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 14.3 KB

Line
1	!
2	! $Id: calwake.F 1665 2012-10-09 13:35:26Z 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),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+1),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