source: lmdz_wrf/WRFV3/lmdz/calwake.F90 @ 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: 17.0 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       &             ,wake_deltat,wake_deltaq,wake_dth                               &
11       &             ,wake_h,wake_s,wake_dens                                        &
12       &             ,wake_pe,wake_fip,wake_gfl                                      &
13       &             ,dt_wake,dq_wake                                                &
14       &             ,wake_k                                                         &
15       &             ,undi_t,undi_q                                                  &
16       &             ,wake_omgbdth,wake_dp_omgb                                      &
17       &             ,wake_dtKE,wake_dqKE                                            &
18       &             ,wake_dtPBL,wake_dqPBL                                          &
19       &             ,wake_omg,wake_dp_deltomg                                       &
20       &             ,wake_spread,wake_Cstar,wake_d_deltat_gw                        &
21       &             ,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!IM 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 SUBROUTINE CALWAKE
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       &             ,wake_deltat,wake_deltaq,wake_dth                               &
262       &             ,wake_h,wake_s,wake_dens                                        &
263       &             ,wake_pe,wake_fip,wake_gfl                                      &
264       &             ,dt_wake,dq_wake                                                &
265       &             ,wake_k                                                         &
266       &             ,undi_t,undi_q                                                  &
267       &             ,wake_omgbdth,wake_dp_omgb                                      &
268       &             ,wake_dtKE,wake_dqKE                                            &
269       &             ,wake_dtPBL,wake_dqPBL                                          &
270       &             ,wake_omg,wake_dp_deltomg                                       &
271       &             ,wake_spread,wake_Cstar,wake_d_deltat_gw                        &
272       &             ,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 SUBROUTINE CALWAKE_scal
Note: See TracBrowser for help on using the repository browser.