LMDZ
calwake.F90
Go to the documentation of this file.
1 
2 ! $Id: calwake.F90 2346 2015-08-21 15:13:46Z emillour $
3 
4 SUBROUTINE 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
232 END SUBROUTINE calwake
dimphy::klon
integer, save klon
Definition: dimphy.F90:3
dimphy::klev
integer, save klev
Definition: dimphy.F90:7
calwake
subroutine calwake(paprs, pplay, dtime, t, q, omgb, dt_dwn, dq_dwn, m_dwn, m_up, dt_a, dq_a, sigd, wdt_pbl, wdq_pbl, udt_pbl, udq_pbl, wake_deltat, wake_deltaq, wake_dth, wake_h, wake_s, wake_dens, wake_pe, wake_fip, wake_gfl, dt_wake, dq_wake, wake_k, undi_t, undi_q, wake_omgbdth, wake_dp_omgb, wake_dtke, wake_dqke, wake_dtpbl, wake_dqpbl, wake_omg, wake_dp_deltomg, wake_spread, wake_cstar, wake_d_deltat_gw, wake_ddeltat, wake_ddeltaq)
Definition: calwake.F90:11
wake
subroutine wake(p, ph, pi, dtime, sigd_con, te0, qe0, omgb, dtdwn, dqdwn, amdwn, amup, dta, dqa, wdtpbl, wdqpbl, udtpbl, udqpbl, deltatw, deltaqw, dth, hw, sigmaw, wape, fip, gfl, dtls, dqls, ktopw, omgbdth, dp_omgb, wdens, tu, qu, dtke, dqke, dtpbl, dqpbl, omg, dp_deltomg, spread, cstar, d_deltat_gw, d_deltatw2, d_deltaqw2)
Definition: wake.F90:12
dimphy
Definition: dimphy.F90:1
sigd
!$Id!Parameters for nlm real sigd
Definition: cv30param.h:5