source: LMDZ5/trunk/libf/phylmd/calwake.F90 @ 2480

Last change on this file since 2480 was 2346, checked in by Ehouarn Millour, 9 years ago

Physics/dynamics separation:

  • remove all references to dimensions.h from physics. nbp_lon (==iim) , nbp_lat (==jjm+1) and nbp_lev (==llm) from mod_grid_phy_lmdz should be used instead.
  • added module regular_lonlat_mod in phy_common to store information about the global (lon-lat) grid cell boundaries and centers.

EM
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.8 KB
Line 
1
2! $Id: calwake.F90 2346 2015-08-21 15:13:46Z acozic $
3
4SUBROUTINE calwake(paprs, pplay, dtime, t, q, omgb, dt_dwn, dq_dwn, m_dwn, &
5    m_up, dt_a, dq_a, sigd, wdt_pbl, wdq_pbl, udt_pbl, udq_pbl, wake_deltat, &
6    wake_deltaq, wake_dth, wake_h, wake_s, wake_dens, wake_pe, wake_fip, &
7    wake_gfl, dt_wake, dq_wake, wake_k, undi_t, undi_q, wake_omgbdth, &
8    wake_dp_omgb, wake_dtke, wake_dqke, wake_dtpbl, wake_dqpbl, wake_omg, &
9    wake_dp_deltomg, wake_spread, wake_cstar, wake_d_deltat_gw, wake_ddeltat, &
10    wake_ddeltaq)
11  ! **************************************************************
12  ! *
13  ! CALWAKE                                                     *
14  ! interface avec le schema de calcul de la poche    *
15  ! froide                                            *
16  ! *
17  ! written by   : CHERUY Frederique, 13/03/2000, 10.31.05      *
18  ! modified by :  ROEHRIG Romain,    01/30/2007                *
19  ! **************************************************************
20
21  USE dimphy
22  IMPLICIT NONE
23  ! ======================================================================
24  include "YOMCST.h"
25
26  ! Arguments
27  ! ----------
28
29  INTEGER i, l, ktopw(klon)
30  REAL dtime
31
32  REAL paprs(klon, klev+1), pplay(klon, klev)
33  REAL t(klon, klev), q(klon, klev), omgb(klon, klev)
34  REAL dt_dwn(klon, klev), dq_dwn(klon, klev), m_dwn(klon, klev)
35  REAL m_up(klon, klev)
36  REAL dt_a(klon, klev), dq_a(klon, klev)
37  REAL wdt_pbl(klon, klev), wdq_pbl(klon, klev)
38  REAL udt_pbl(klon, klev), udq_pbl(klon, klev)
39  REAL wake_deltat(klon, klev), wake_deltaq(klon, klev)
40  REAL dt_wake(klon, klev), dq_wake(klon, klev)
41  REAL wake_d_deltat_gw(klon, klev)
42  REAL wake_h(klon), wake_s(klon)
43  REAL wake_dth(klon, klev)
44  REAL wake_pe(klon), wake_fip(klon), wake_gfl(klon)
45  REAL undi_t(klon, klev), undi_q(klon, klev)
46  REAL wake_omgbdth(klon, klev), wake_dp_omgb(klon, klev)
47  REAL wake_dtke(klon, klev), wake_dqke(klon, klev)
48  REAL wake_dtpbl(klon, klev), wake_dqpbl(klon, klev)
49  REAL wake_omg(klon, klev), wake_dp_deltomg(klon, klev)
50  REAL wake_spread(klon, klev), wake_cstar(klon)
51  REAL wake_ddeltat(klon, klev), wake_ddeltaq(klon, klev)
52  REAL d_deltatw(klon, klev), d_deltaqw(klon, klev)
53  INTEGER wake_k(klon)
54  REAL sigd(klon)
55  REAL wake_dens(klon)
56
57  ! Variable internes
58  ! -----------------
59
60  REAL aire
61  REAL p(klon, klev), ph(klon, klev+1), pi(klon, klev)
62  REAL te(klon, klev), qe(klon, klev), omgbe(klon, klev+1)
63  REAL dtdwn(klon, klev), dqdwn(klon, klev)
64  REAL dta(klon, klev), dqa(klon, klev)
65  REAL wdtpbl(klon, klev), wdqpbl(klon, klev)
66  REAL udtpbl(klon, klev), udqpbl(klon, klev)
67  REAL amdwn(klon, klev), amup(klon, klev)
68  REAL dtw(klon, klev), dqw(klon, klev), dth(klon, klev)
69  REAL d_deltat_gw(klon, klev)
70  REAL dtls(klon, klev), dqls(klon, klev)
71  REAL tu(klon, klev), qu(klon, klev)
72  REAL hw(klon), sigmaw(klon), wape(klon), fip(klon), gfl(klon)
73  REAL omgbdth(klon, klev+1), dp_omgb(klon, klev)
74  REAL dtke(klon, klev), dqke(klon, klev)
75  REAL dtpbl(klon, klev), dqpbl(klon, klev)
76  REAL omg(klon, klev+1), dp_deltomg(klon, klev), spread(klon, klev)
77  REAL cstar(klon)
78  REAL sigd0(klon), wdens(klon)
79
80  REAL rdcp
81
82  ! print *, '-> calwake, wake_s ', wake_s(1)
83
84  rdcp = 1./3.5
85
86
87  ! -----------------------------------------------------------
88  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
89  ! ----------------------------------------------------------
90
91
92  DO l = 1, klev
93    DO i = 1, klon
94      p(i, l) = pplay(i, l)
95      ph(i, l) = paprs(i, l)
96      pi(i, l) = (pplay(i,l)/100000.)**rdcp
97
98      te(i, l) = t(i, l)
99      qe(i, l) = q(i, l)
100      omgbe(i, l) = omgb(i, l)
101
102      dtdwn(i, l) = dt_dwn(i, l)
103      dqdwn(i, l) = dq_dwn(i, l)
104      dta(i, l) = dt_a(i, l)
105      dqa(i, l) = dq_a(i, l)
106      wdtpbl(i, l) = wdt_pbl(i, l)
107      wdqpbl(i, l) = wdq_pbl(i, l)
108      udtpbl(i, l) = udt_pbl(i, l)
109      udqpbl(i, l) = udq_pbl(i, l)
110    END DO
111  END DO
112
113  omgbe(:, klev+1) = 0.
114
115  DO i = 1, klon
116    sigd0(i) = sigd(i)
117  END DO
118  ! print*, 'sigd0,sigd', sigd0, sigd(i)
119  DO i = 1, klon
120    ph(i, klev+1) = 0.
121  END DO
122
123  DO i = 1, klon
124    ktopw(i) = wake_k(i)
125  END DO
126
127  DO l = 1, klev
128    DO i = 1, klon
129      dtw(i, l) = wake_deltat(i, l)
130      dqw(i, l) = wake_deltaq(i, l)
131    END DO
132  END DO
133
134  DO l = 1, klev
135    DO i = 1, klon
136      dtls(i, l) = dt_wake(i, l)
137      dqls(i, l) = dq_wake(i, l)
138    END DO
139  END DO
140
141  DO i = 1, klon
142    hw(i) = wake_h(i)
143    sigmaw(i) = wake_s(i)
144  END DO
145
146  ! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
147  ! fkc  on veut le flux de masse au milieu des couches
148
149  DO l = 1, klev - 1
150    DO i = 1, klon
151      amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
152      amdwn(i, l) = (m_dwn(i,l+1))
153    END DO
154  END DO
155
156  ! au sommet le flux de masse est nul
157
158  DO i = 1, klon
159    amdwn(i, klev) = 0.5*m_dwn(i, klev)
160  END DO
161
162  DO l = 1, klev
163    DO i = 1, klon
164      amup(i, l) = m_up(i, l)
165    END DO
166  END DO
167
168  CALL wake(p, ph, pi, dtime, sigd0, te, qe, omgbe, dtdwn, dqdwn, amdwn, &
169    amup, dta, dqa, wdtpbl, wdqpbl, udtpbl, udqpbl, dtw, dqw, dth, hw, &
170    sigmaw, wape, fip, gfl, dtls, dqls, ktopw, omgbdth, dp_omgb, wdens, tu, &
171    qu, dtke, dqke, dtpbl, dqpbl, omg, dp_deltomg, spread, cstar, &
172    d_deltat_gw, d_deltatw, d_deltaqw)
173
174  DO l = 1, klev
175    DO i = 1, klon
176      IF (ktopw(i)>0) THEN
177        wake_deltat(i, l) = dtw(i, l)
178        wake_deltaq(i, l) = dqw(i, l)
179        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
180        wake_omgbdth(i, l) = omgbdth(i, l)
181        wake_dp_omgb(i, l) = dp_omgb(i, l)
182        wake_dtke(i, l) = dtke(i, l)
183        wake_dqke(i, l) = dqke(i, l)
184        wake_dtpbl(i, l) = dtpbl(i, l)
185        wake_dqpbl(i, l) = dqpbl(i, l)
186        wake_omg(i, l) = omg(i, l)
187        wake_dp_deltomg(i, l) = dp_deltomg(i, l)
188        wake_spread(i, l) = spread(i, l)
189        wake_dth(i, l) = dth(i, l)
190        dt_wake(i, l) = dtls(i, l)
191        dq_wake(i, l) = dqls(i, l)
192        undi_t(i, l) = tu(i, l)
193        undi_q(i, l) = qu(i, l)
194        wake_ddeltat(i, l) = d_deltatw(i, l)
195        wake_ddeltaq(i, l) = d_deltaqw(i, l)
196      ELSE
197        wake_deltat(i, l) = 0.
198        wake_deltaq(i, l) = 0.
199        wake_d_deltat_gw(i, l) = 0.
200        wake_omgbdth(i, l) = 0.
201        wake_dp_omgb(i, l) = 0.
202        wake_dtke(i, l) = 0.
203        wake_dqke(i, l) = 0.
204        wake_dtpbl(i, l) = 0.
205        wake_dqpbl(i, l) = 0.
206        wake_omg(i, l) = 0.
207        wake_dp_deltomg(i, l) = 0.
208        wake_spread(i, l) = 0.
209        wake_dth(i, l) = 0.
210        dt_wake(i, l) = 0.
211        dq_wake(i, l) = 0.
212        undi_t(i, l) = te(i, l)
213        undi_q(i, l) = qe(i, l)
214        wake_ddeltat(i, l) = 0.
215        wake_ddeltaq(i, l) = 0.
216      END IF
217    END DO
218  END DO
219
220  DO i = 1, klon
221    wake_h(i) = hw(i)
222    wake_s(i) = sigmaw(i)
223    wake_pe(i) = wape(i)
224    wake_fip(i) = fip(i)
225    wake_gfl(i) = gfl(i)
226    wake_k(i) = ktopw(i)
227    wake_cstar(i) = cstar(i)
228    wake_dens(i) = wdens(i)
229  END DO
230
231  RETURN
232END SUBROUTINE calwake
Note: See TracBrowser for help on using the repository browser.