source: LMDZ6/trunk/libf/phylmd/calwake.F90 @ 4639

Last change on this file since 4639 was 4588, checked in by fhourdin, 16 months ago

Nouveaux noms et encapsulation module pour wake
  • 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: 10.3 KB
Line 
1
2! $Id: calwake.F90 4588 2023-06-28 22:54:46Z evignon $
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, wgen, &
7    sigd, Cin, &
8    wake_deltat, wake_deltaq, wake_s, awake_dens, 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, awake_ddens, 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  USE phys_state_var_mod, ONLY: pctsrf
29  USE indice_sol_mod, ONLY: is_oce
30  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
31  USE lmdz_wake, ONLY : wake
32  IMPLICIT NONE
33  ! ======================================================================
34  include "YOMCST.h"
35
36  ! Arguments
37  ! ----------
38  ! Input
39  ! ----
40  INTEGER,                       INTENT (IN)         :: iflag_wake_tend
41  REAL,                          INTENT (IN)         :: dtime
42  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: pplay
43  REAL, DIMENSION(klon, klev+1), INTENT (IN)         :: paprs
44  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: t, q, omgb
45  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_dwn, dq_dwn
46  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: m_up, m_dwn
47  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_a, dq_a
48  REAL, DIMENSION(klon),         INTENT (IN)         :: wgen
49  REAL, DIMENSION(klon),         INTENT (IN)         :: sigd
50  REAL, DIMENSION(klon),         INTENT (IN)         :: Cin
51  ! Input/Output
52  ! ------------
53  REAL, DIMENSION(klon, klev),   INTENT (INOUT)      :: wake_deltat, wake_deltaq
54  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_s
55  REAL, DIMENSION(klon),         INTENT (INOUT)      :: awake_dens, wake_dens
56  ! Output
57  ! ------
58  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: dt_wake, dq_wake
59!!jyg  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_k
60  INTEGER, DIMENSION(klon),      INTENT (OUT)        :: wake_k
61  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_d_deltat_gw
62  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_h
63  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dth
64  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_pe, wake_fip, wake_gfl
65  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: t_x, q_x
66  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omgbdth, wake_dp_omgb
67  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dtke, wake_dqke
68  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omg, wake_dp_deltomg
69  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_spread
70  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_cstar
71  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_ddeltat, wake_ddeltaq
72  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_ds, awake_ddens, wake_ddens
73
74
75  ! Variable internes
76  ! -----------------
77  LOGICAL, SAVE                                      :: first = .TRUE.
78  !$OMP THREADPRIVATE(first)
79  INTEGER                                            :: i, l
80  INTEGER, DIMENSION(klon)                           :: znatsurf    ! 0 if pctsrf(is_oce)>0.1; 1 else.
81  REAL                                               :: aire
82  REAL, DIMENSION(klon, klev)                        :: p,  pi
83  REAL, DIMENSION(klon, klev+1)                      ::  ph
84  REAL, DIMENSION(klon, klev)                        ::  omgbe
85  REAL, DIMENSION(klon, klev)                        :: te, qe
86  REAL, DIMENSION(klon, klev)                        :: dtdwn, dqdwn
87  REAL, DIMENSION(klon, klev)                        :: dta, dqa
88  REAL, DIMENSION(klon, klev)                        :: amdwn, amup
89  REAL, DIMENSION(klon, klev)                        :: dtw, dqw, dth
90  REAL, DIMENSION(klon, klev)                        :: dtls, dqls
91  REAL, DIMENSION(klon, klev)                        :: tx, qx
92  REAL, DIMENSION(klon)                              :: hw, wape, fip, gfl
93  REAL, DIMENSION(klon)                              :: sigmaw, awdens, wdens
94  REAL, DIMENSION(klon, klev)                        :: omgbdth
95  REAL, DIMENSION(klon, klev)                        :: dp_omgb
96  REAL, DIMENSION(klon, klev)                        :: dtke, dqke
97  REAL, DIMENSION(klon, klev)                        :: omg
98  REAL, DIMENSION(klon, klev)                        :: dp_deltomg, spread
99  REAL, DIMENSION(klon)                              :: cstar
100  REAL, DIMENSION(klon)                              :: sigd0
101  INTEGER, DIMENSION(klon)                           :: ktopw
102  REAL, DIMENSION(klon, klev)                        :: d_deltat_gw
103  REAL, DIMENSION(klon, klev)                        :: d_deltatw, d_deltaqw
104  REAL, DIMENSION(klon)                              :: d_sigmaw, d_awdens, d_wdens
105
106  REAL                                               :: rdcp
107
108
109  IF (prt_level >= 10) THEN
110    print *, '-> calwake, wake_s, wgen input ', wake_s(1), wgen(1)
111  ENDIF
112
113  rdcp = 1./3.5
114
115  znatsurf(:) = 0
116  DO i = 1,klon
117    IF (pctsrf(i,is_oce) < 0.1) znatsurf(i) = 1
118  ENDDO
119
120
121  ! -----------------------------------------------------------
122  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
123  ! ----------------------------------------------------------
124
125
126  DO l = 1, klev
127    DO i = 1, klon
128      p(i, l) = pplay(i, l)
129      ph(i, l) = paprs(i, l)
130      pi(i, l) = (pplay(i,l)/100000.)**rdcp
131
132      te(i, l) = t(i, l)
133      qe(i, l) = q(i, l)
134      omgbe(i, l) = omgb(i, l)
135
136      dtdwn(i, l) = dt_dwn(i, l)
137      dqdwn(i, l) = dq_dwn(i, l)
138      dta(i, l) = dt_a(i, l)
139      dqa(i, l) = dq_a(i, l)
140    END DO
141  END DO
142
143!----------------------------------------------------------------
144!         Initialize tendencies to zero
145!----------------------------------------------------------------
146dtls(:,:) = 0.
147dqls(:,:) = 0.
148d_deltat_gw(:,:) = 0.
149d_deltatw(:,:) = 0.
150d_deltaqw(:,:) = 0.
151d_sigmaw(:) = 0.
152d_awdens(:) = 0.
153d_wdens(:) = 0.
154!
155
156  DO i = 1, klon
157    sigd0(i) = sigd(i)
158  END DO
159  ! print*, 'sigd0,sigd', sigd0, sigd(i)
160  DO i = 1, klon
161    ph(i, klev+1) = 0.
162  END DO
163
164!!jyg!  DO i = 1, klon                 
165!!jyg!    ktopw(i) = NINT(wake_k(i))   
166!!jyg!  END DO                         
167
168  DO i = 1, klon
169    hw(i) = wake_h(i)
170  END DO
171!
172!    Make a copy of state variables
173  DO l = 1, klev
174    DO i = 1, klon
175      dtw(i, l) = wake_deltat(i, l)
176      dqw(i, l) = wake_deltaq(i, l)
177    END DO
178  END DO
179
180  DO i = 1, klon
181    sigmaw(i) = wake_s(i)
182  END DO
183
184  DO i = 1, klon
185    awdens(i) = max(0., awake_dens(i))
186    wdens(i) = max(0., wake_dens(i))
187  END DO
188
189  ! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
190  ! fkc  on veut le flux de masse au milieu des couches
191
192  DO l = 1, klev - 1
193    DO i = 1, klon
194      amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
195      amdwn(i, l) = (m_dwn(i,l+1))
196    END DO
197  END DO
198
199  ! au sommet le flux de masse est nul
200
201  DO i = 1, klon
202    amdwn(i, klev) = 0.5*m_dwn(i, klev)
203  END DO
204
205  DO l = 1, klev
206    DO i = 1, klon
207      amup(i, l) = m_up(i, l)
208    END DO
209  END DO
210
211
212
213  CALL wake(klon,klev,znatsurf, p, ph, pi, dtime, &
214    te, qe, omgbe, &
215    dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
216    sigd0, Cin, &
217    dtw, dqw, sigmaw, awdens, wdens, &                      ! state variables
218    dth, hw, wape, fip, gfl, &
219    dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
220    dtke, dqke, omg, dp_deltomg, spread, cstar, &
221    d_deltat_gw, &
222    d_deltatw, d_deltaqw, d_sigmaw, d_awdens, d_wdens)      ! tendencies
223
224!
225  DO l = 1, klev
226    DO i = 1, klon
227      IF (ktopw(i)>0) THEN
228        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
229        wake_omgbdth(i, l) = omgbdth(i, l)
230        wake_dp_omgb(i, l) = dp_omgb(i, l)
231        wake_dtke(i, l) = dtke(i, l)
232        wake_dqke(i, l) = dqke(i, l)
233        wake_omg(i, l) = omg(i, l)
234        wake_dp_deltomg(i, l) = dp_deltomg(i, l)
235        wake_spread(i, l) = spread(i, l)
236        wake_dth(i, l) = dth(i, l)
237        dt_wake(i, l) = dtls(i, l)*dtime         ! derivative -> tendency
238        dq_wake(i, l) = dqls(i, l)*dtime         ! derivative -> tendency
239        t_x(i, l) = tx(i, l)
240        q_x(i, l) = qx(i, l)
241      ELSE
242        wake_d_deltat_gw(i, l) = 0.
243        wake_omgbdth(i, l) = 0.
244        wake_dp_omgb(i, l) = 0.
245        wake_dtke(i, l) = 0.
246        wake_dqke(i, l) = 0.
247        wake_omg(i, l) = 0.
248        wake_dp_deltomg(i, l) = 0.
249        wake_spread(i, l) = 0.
250        wake_dth(i, l) = 0.
251        dt_wake(i, l) = 0.
252        dq_wake(i, l) = 0.
253        t_x(i, l) = te(i, l)
254        q_x(i, l) = qe(i, l)
255      END IF
256    END DO
257  END DO
258
259  DO i = 1, klon
260    wake_h(i) = hw(i)
261    wake_pe(i) = wape(i)
262    wake_fip(i) = fip(i)
263    wake_gfl(i) = gfl(i)
264    wake_k(i) = ktopw(i)
265    wake_cstar(i) = cstar(i)
266  END DO
267
268!  Tendencies of state variables
269  DO l = 1, klev
270    DO i = 1, klon
271      IF (ktopw(i)>0) THEN
272        wake_ddeltat(i, l) = d_deltatw(i, l)*dtime
273        wake_ddeltaq(i, l) = d_deltaqw(i, l)*dtime
274      ELSE
275        wake_ddeltat(i, l) = -wake_deltat(i, l)
276        wake_ddeltaq(i, l) = -wake_deltaq(i, l)
277      END IF
278    END DO
279  END DO
280  DO i = 1, klon
281    IF (ktopw(i)>0) THEN
282      wake_ds(i) = d_sigmaw(i)*dtime
283      awake_ddens(i) = d_awdens(i)*dtime
284      wake_ddens(i) = d_wdens(i)*dtime
285    ELSE
286      wake_ds(i)   = -wake_s(i)
287      wake_ddens(i)= -wake_dens(i)
288    END IF
289  END DO
290!
291
292!jyg< 
293  IF (iflag_wake_tend .EQ. 0) THEN
294!  Update State variables
295    DO l = 1, klev
296      DO i = 1, klon
297        IF (ktopw(i)>0) THEN
298          wake_deltat(i, l) = dtw(i, l)
299          wake_deltaq(i, l) = dqw(i, l)
300        ELSE
301          wake_deltat(i, l) = 0.
302          wake_deltaq(i, l) = 0.
303        END IF
304      END DO
305    END DO
306    DO i = 1, klon
307      wake_s(i) = sigmaw(i)
308      awake_dens(i) = awdens(i)
309      wake_dens(i) = wdens(i)
310    END DO
311  ENDIF  ! (iflag_wake_tend .EQ. 0)
312!
313  IF (first) THEN
314    DO i = 1,klon
315      IF (wake_dens(i) < -1.) THEN
316        wake_dens(i) = wdens(i)
317      ENDIF
318    ENDDO
319    first=.false.
320  ENDIF  ! (first)
321!>jyg
322
323  RETURN
324END SUBROUTINE calwake
325
Note: See TracBrowser for help on using the repository browser.