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

Last change on this file since 2645 was 2635, checked in by jyg, 8 years ago

Some cleaning in the wake routines: (i) the wake
number per unit area (wdens) is now a state
variable (held constant for the time being);
(ii) wake state variable changes are computed in
subroutine 'physiq' if iflag_wake_tend=1 (it is
computed within wake routines if
iflag_wake_tend=0, consistent with earlier
versions); (iii) the new routine 'add_wake_tend'
adds tendencies to wake state variables; (iv)
tendencies due to various processes (pbl, wakes,
thermals) are named and added separately.
  • 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: 8.8 KB
Line 
1
2! $Id: calwake.F90 2635 2016-09-27 16:02:46Z musat $
3
4SUBROUTINE calwake(iflag_wake_tend, paprs, pplay, dtime, &
5    t, q, omgb, &
6    dt_dwn, dq_dwn, m_dwn, m_up, dt_a, dq_a, &
7    sigd, &
8    wake_deltat, wake_deltaq, wake_s, wake_dens, &
9    wake_dth, wake_h, &
10    wake_pe, wake_fip, wake_gfl, &
11    dt_wake, dq_wake, wake_k, t_x, q_x, wake_omgbdth, &
12    wake_dp_omgb, &
13    wake_dtke, wake_dqke, &
14    wake_omg, wake_dp_deltomg, &
15    wake_spread, wake_cstar, wake_d_deltat_gw, &
16    wake_ddeltat, wake_ddeltaq, wake_ds, wake_ddens)
17  ! **************************************************************
18  ! *
19  ! CALWAKE                                                     *
20  ! interface avec le schema de calcul de la poche    *
21  ! froide                                            *
22  ! *
23  ! written by   : CHERUY Frederique, 13/03/2000, 10.31.05      *
24  ! modified by :  ROEHRIG Romain,    01/30/2007                *
25  ! **************************************************************
26
27  USE dimphy
28  IMPLICIT NONE
29  ! ======================================================================
30  include "YOMCST.h"
31
32  ! Arguments
33  ! ----------
34  ! Input
35  ! ----
36  INTEGER,                       INTENT (IN)         :: iflag_wake_tend
37  REAL,                          INTENT (IN)         :: dtime
38  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: pplay
39  REAL, DIMENSION(klon, klev+1), INTENT (IN)         :: paprs
40  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: t, q, omgb
41  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_dwn, dq_dwn
42  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: m_up, m_dwn
43  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_a, dq_a
44  REAL, DIMENSION(klon),         INTENT (IN)         :: sigd
45  ! Input/Output
46  ! ------------
47  REAL, DIMENSION(klon, klev),   INTENT (INOUT)      :: wake_deltat, wake_deltaq
48  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_s
49  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_dens
50  ! Output
51  ! ------
52  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: dt_wake, dq_wake
53  INTEGER, DIMENSION(klon),      INTENT (OUT)        :: wake_k
54  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_d_deltat_gw
55  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_h
56  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dth
57  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_pe, wake_fip, wake_gfl
58  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: t_x, q_x
59  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omgbdth, wake_dp_omgb
60  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dtke, wake_dqke
61  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omg, wake_dp_deltomg
62  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_spread
63  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_cstar
64  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_ddeltat, wake_ddeltaq
65  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_ds, wake_ddens
66
67
68  ! Variable internes
69  ! -----------------
70  INTEGER                                            :: i, l
71  REAL                                               :: aire
72  REAL, DIMENSION(klon, klev)                        :: p,  pi
73  REAL, DIMENSION(klon, klev+1)                      ::  ph, omgbe
74  REAL, DIMENSION(klon, klev)                        :: te, qe
75  REAL, DIMENSION(klon, klev)                        :: dtdwn, dqdwn
76  REAL, DIMENSION(klon, klev)                        :: dta, dqa
77  REAL, DIMENSION(klon, klev)                        :: amdwn, amup
78  REAL, DIMENSION(klon, klev)                        :: dtw, dqw, dth
79  REAL, DIMENSION(klon, klev)                        :: dtls, dqls
80  REAL, DIMENSION(klon, klev)                        :: tx, qx
81  REAL, DIMENSION(klon)                              :: hw, wape, fip, gfl
82  REAL, DIMENSION(klon)                              :: sigmaw, wdens
83  REAL, DIMENSION(klon, klev+1)                      :: omgbdth
84  REAL, DIMENSION(klon, klev)                        :: dp_omgb
85  REAL, DIMENSION(klon, klev)                        :: dtke, dqke
86  REAL, DIMENSION(klon, klev+1)                      :: omg
87  REAL, DIMENSION(klon, klev)                        :: dp_deltomg, spread
88  REAL, DIMENSION(klon)                              :: cstar
89  REAL, DIMENSION(klon)                              :: sigd0
90  INTEGER, DIMENSION(klon)                           :: ktopw
91  REAL, DIMENSION(klon, klev)                        :: d_deltat_gw
92  REAL, DIMENSION(klon, klev)                        :: d_deltatw, d_deltaqw
93  REAL, DIMENSION(klon)                              :: d_sigmaw, d_wdens
94
95  REAL                                               :: rdcp
96
97
98  ! print *, '-> calwake, wake_s ', wake_s(1)
99
100  rdcp = 1./3.5
101
102
103  ! -----------------------------------------------------------
104  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
105  ! ----------------------------------------------------------
106
107
108  DO l = 1, klev
109    DO i = 1, klon
110      p(i, l) = pplay(i, l)
111      ph(i, l) = paprs(i, l)
112      pi(i, l) = (pplay(i,l)/100000.)**rdcp
113
114      te(i, l) = t(i, l)
115      qe(i, l) = q(i, l)
116      omgbe(i, l) = omgb(i, l)
117
118      dtdwn(i, l) = dt_dwn(i, l)
119      dqdwn(i, l) = dq_dwn(i, l)
120      dta(i, l) = dt_a(i, l)
121      dqa(i, l) = dq_a(i, l)
122    END DO
123  END DO
124
125  omgbe(:, klev+1) = 0.
126
127  DO i = 1, klon
128    sigd0(i) = sigd(i)
129  END DO
130  ! print*, 'sigd0,sigd', sigd0, sigd(i)
131  DO i = 1, klon
132    ph(i, klev+1) = 0.
133  END DO
134
135  DO i = 1, klon
136    ktopw(i) = wake_k(i)
137  END DO
138
139  DO i = 1, klon
140    hw(i) = wake_h(i)
141  END DO
142!
143!    Make a copy of state variables
144  DO l = 1, klev
145    DO i = 1, klon
146      dtw(i, l) = wake_deltat(i, l)
147      dqw(i, l) = wake_deltaq(i, l)
148    END DO
149  END DO
150
151  DO i = 1, klon
152    sigmaw(i) = wake_s(i)
153  END DO
154
155  DO i = 1, klon
156    wdens(i) = wake_dens(i)
157  END DO
158
159  ! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
160  ! fkc  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    END DO
167  END DO
168
169  ! 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  END DO
174
175  DO l = 1, klev
176    DO i = 1, klon
177      amup(i, l) = m_up(i, l)
178    END DO
179  END DO
180
181  CALL wake(p, ph, pi, dtime, &
182    te, qe, omgbe, &
183    dtdwn, dqdwn, amdwn, amup, dta, dqa, &
184    sigd0, &
185    dtw, dqw, sigmaw, wdens, &                                   ! state variables
186    dth, hw, wape, fip, gfl, &
187    dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
188    dtke, dqke, omg, dp_deltomg, spread, cstar, &
189    d_deltat_gw, &
190    d_deltatw, d_deltaqw, d_sigmaw, d_wdens)                     ! tendencies
191
192!
193  DO l = 1, klev
194    DO i = 1, klon
195      IF (ktopw(i)>0) THEN
196        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
197        wake_omgbdth(i, l) = omgbdth(i, l)
198        wake_dp_omgb(i, l) = dp_omgb(i, l)
199        wake_dtke(i, l) = dtke(i, l)
200        wake_dqke(i, l) = dqke(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)*dtime         ! derivative -> tendency
206        dq_wake(i, l) = dqls(i, l)*dtime         ! derivative -> tendency
207        t_x(i, l) = tx(i, l)
208        q_x(i, l) = qx(i, l)
209      ELSE
210        wake_d_deltat_gw(i, l) = 0.
211        wake_omgbdth(i, l) = 0.
212        wake_dp_omgb(i, l) = 0.
213        wake_dtke(i, l) = 0.
214        wake_dqke(i, l) = 0.
215        wake_omg(i, l) = 0.
216        wake_dp_deltomg(i, l) = 0.
217        wake_spread(i, l) = 0.
218        wake_dth(i, l) = 0.
219        dt_wake(i, l) = 0.
220        dq_wake(i, l) = 0.
221        t_x(i, l) = te(i, l)
222        q_x(i, l) = qe(i, l)
223      END IF
224    END DO
225  END DO
226
227  DO i = 1, klon
228    wake_h(i) = hw(i)
229    wake_pe(i) = wape(i)
230    wake_fip(i) = fip(i)
231    wake_gfl(i) = gfl(i)
232    wake_k(i) = ktopw(i)
233    wake_cstar(i) = cstar(i)
234  END DO
235
236!  Tendencies of state variables
237  DO l = 1, klev
238    DO i = 1, klon
239      IF (ktopw(i)>0) THEN
240        wake_ddeltat(i, l) = d_deltatw(i, l)*dtime
241        wake_ddeltaq(i, l) = d_deltaqw(i, l)*dtime
242      ELSE
243        wake_ddeltat(i, l) = -wake_deltat(i, l)
244        wake_ddeltaq(i, l) = -wake_deltaq(i, l)
245      END IF
246    END DO
247  END DO
248  DO i = 1, klon
249    IF (ktopw(i)>0) THEN
250      wake_ds(i) = d_sigmaw(i)*dtime
251      wake_ddens(i) = d_wdens(i)*dtime
252    ELSE
253      wake_ds(i)   = -wake_s(i)
254      wake_ddens(i)= -wake_dens(i)
255    END IF
256  END DO
257
258!jyg< 
259  IF (iflag_wake_tend .EQ. 0) THEN
260!  Update State variables
261    DO l = 1, klev
262      DO i = 1, klon
263        IF (ktopw(i)>0) THEN
264          wake_deltat(i, l) = dtw(i, l)
265          wake_deltaq(i, l) = dqw(i, l)
266        ELSE
267          wake_deltat(i, l) = 0.
268          wake_deltaq(i, l) = 0.
269        END IF
270      END DO
271    END DO
272    DO i = 1, klon
273      wake_s(i) = sigmaw(i)
274      wake_dens(i) = wdens(i)
275    END DO
276  ENDIF
277!>jyg
278
279  RETURN
280END SUBROUTINE calwake
281
Note: See TracBrowser for help on using the repository browser.