Context Navigation

calwake.F @ 5427

Last change on this file since 5427 was 990, checked in by Laurent Fairhead, 16 years ago
Correction probleme de dimension sur une variable passee a un sous-programme JYG LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 14.1 KB

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

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

Download in other formats:

Original Format