My Project
 All Classes Files Functions Variables Macros
calwake.F
Go to the documentation of this file.
1 !
2 ! $Id: calwake.F 1576 2011-10-07 12:37:23Z 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