source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/calwake.F @ 3457

Last change on this file since 3457 was 1322, checked in by Laurent Fairhead, 15 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
RevLine 
[1322]1!
2! $Id: calwake.F 1322 2010-03-12 10:54:11Z fairhead $
3!
[879]4      SUBROUTINE CALWAKE(paprs,pplay,dtime
[953]5     :             ,t,q,omgb
[879]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*
[940]32      USE dimphy
[879]33      IMPLICIT none
34c======================================================================
[974]35#include "dimensions.h"
36!#include "dimphy.h"
37#include "YOMCST.h"
[879]38
[974]39c Arguments
40c----------
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
70C  Variable internes
71C  -----------------
72
73      REAL aire
74      REAL p(klon,klev),ph(klon,klev+1),pi(klon,klev)
[990]75      REAL te(klon,klev),qe(klon,klev),omgbe(klon,klev+1)
[974]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
95c      print *, '-> calwake, wake_s ', wake_s(1)
96
97      RDCP=1./3.5
98
[990]99
[974]100c-----------------------------------------------------------
101cIM 290108     DO 999 i=1,klon   ! a vectoriser
102c----------------------------------------------------------
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
[990]125
126      omgbe(:,klev+1) = 0.
[974]127     
128      DO i=1,klon
129      sigd0(i)=sigd(i)
130      ENDDO
131c      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
159cfkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
160cfkc  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
169c 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
174c
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)
[1322]194c
195      DO l=1,klev
196       DO i=1,klon
197        IF (ktopw(i) .GT. 0) THEN
[974]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)
[1322]217        ELSE
[974]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.
[1322]225           wake_dtPBL(i,l) = 0.
226           wake_dqPBL(i,l) = 0.
[974]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)
[1322]235           wake_ddeltat(i,l) = 0.
236           wake_ddeltaq(i,l) = 0.
237        ENDIF
238       ENDDO
239      ENDDO
240c
241      DO i=1,klon
[974]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)
[1322]250      ENDDO
[974]251c
252      RETURN
253      END
[1322]254
[974]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
285c======================================================================
286
[879]287#include "dimensions.h"
[940]288cccc#include "dimphy.h"
[879]289#include "YOMCST.h"
290
291c Arguments
292c----------
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
322C  Variable internes
323C  -----------------
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
344c      print *, '-> calwake, wake_s ', wake_s(1)
345
346      RDCP=1./3.5
347
348c-----------------------------------------------------------
349      DO 999 i=1,klon   ! a vectoriser
350c----------------------------------------------------------
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)
373c      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
391cfkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
392cfkc  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
399c au sommet le flux de masse est nul
400
401      amdwn(klev)=0.5*M_dwn(i,klev)
402c
403      DO l = 1,klev
404        amup(l)=M_up(i,l)
405      ENDDO
406
[974]407      call WAKE_scal(p,ph,pi,dtime,sigd0
[953]408     $                ,te,qe,omgbe
[879]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
471c
472 999  CONTINUE
473c
474      RETURN
475      END
Note: See TracBrowser for help on using the repository browser.