source: LMDZ4/trunk/libf/phylmd/calwake.F @ 984

Last change on this file since 984 was 974, checked in by lmdzadmin, 16 years ago

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