GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/calwake.F90 Lines: 143 145 98.6 %
Date: 2023-06-30 12:51:15 Branches: 93 96 96.9 %

Line Branch Exec Source
1
2
! $Id: calwake.F90 4588 2023-06-28 22:54:46Z fhourdin $
3
4
288
SUBROUTINE 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
288
    wake_deltat, wake_deltaq, wake_s, awake_dens, wake_dens, &
9
    wake_dth, wake_h, &
10
    wake_pe, wake_fip, wake_gfl, &
11
288
    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
576
  INTEGER, DIMENSION(klon)                           :: znatsurf    ! 0 if pctsrf(is_oce)>0.1; 1 else.
81
  REAL                                               :: aire
82
576
  REAL, DIMENSION(klon, klev)                        :: p,  pi
83
576
  REAL, DIMENSION(klon, klev+1)                      ::  ph
84
576
  REAL, DIMENSION(klon, klev)                        ::  omgbe
85
576
  REAL, DIMENSION(klon, klev)                        :: te, qe
86
576
  REAL, DIMENSION(klon, klev)                        :: dtdwn, dqdwn
87
576
  REAL, DIMENSION(klon, klev)                        :: dta, dqa
88
576
  REAL, DIMENSION(klon, klev)                        :: amdwn, amup
89
576
  REAL, DIMENSION(klon, klev)                        :: dtw, dqw, dth
90
576
  REAL, DIMENSION(klon, klev)                        :: dtls, dqls
91
576
  REAL, DIMENSION(klon, klev)                        :: tx, qx
92
576
  REAL, DIMENSION(klon)                              :: hw, wape, fip, gfl
93
576
  REAL, DIMENSION(klon)                              :: sigmaw, awdens, wdens
94
576
  REAL, DIMENSION(klon, klev)                        :: omgbdth
95
576
  REAL, DIMENSION(klon, klev)                        :: dp_omgb
96
576
  REAL, DIMENSION(klon, klev)                        :: dtke, dqke
97
576
  REAL, DIMENSION(klon, klev)                        :: omg
98
576
  REAL, DIMENSION(klon, klev)                        :: dp_deltomg, spread
99
576
  REAL, DIMENSION(klon)                              :: cstar
100
576
  REAL, DIMENSION(klon)                              :: sigd0
101
576
  INTEGER, DIMENSION(klon)                           :: ktopw
102
576
  REAL, DIMENSION(klon, klev)                        :: d_deltat_gw
103
576
  REAL, DIMENSION(klon, klev)                        :: d_deltatw, d_deltaqw
104
576
  REAL, DIMENSION(klon)                              :: d_sigmaw, d_awdens, d_wdens
105
106
  REAL                                               :: rdcp
107
108
109
288
  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
286560
  znatsurf(:) = 0
116
286560
  DO i = 1,klon
117
286560
    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
11520
  DO l = 1, klev
127
11176128
    DO i = 1, klon
128
11164608
      p(i, l) = pplay(i, l)
129
11164608
      ph(i, l) = paprs(i, l)
130
11164608
      pi(i, l) = (pplay(i,l)/100000.)**rdcp
131
132
11164608
      te(i, l) = t(i, l)
133
11164608
      qe(i, l) = q(i, l)
134
11164608
      omgbe(i, l) = omgb(i, l)
135
136
11164608
      dtdwn(i, l) = dt_dwn(i, l)
137
11164608
      dqdwn(i, l) = dq_dwn(i, l)
138
11164608
      dta(i, l) = dt_a(i, l)
139
11175840
      dqa(i, l) = dq_a(i, l)
140
    END DO
141
  END DO
142
143
!----------------------------------------------------------------
144
!         Initialize tendencies to zero
145
!----------------------------------------------------------------
146

11176128
dtls(:,:) = 0.
147

11176128
dqls(:,:) = 0.
148

11176128
d_deltat_gw(:,:) = 0.
149

11176128
d_deltatw(:,:) = 0.
150

11176128
d_deltaqw(:,:) = 0.
151
286560
d_sigmaw(:) = 0.
152
286560
d_awdens(:) = 0.
153
286560
d_wdens(:) = 0.
154
!
155
156
286560
  DO i = 1, klon
157
286560
    sigd0(i) = sigd(i)
158
  END DO
159
  ! print*, 'sigd0,sigd', sigd0, sigd(i)
160
286560
  DO i = 1, klon
161
286560
    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
286560
  DO i = 1, klon
169
286560
    hw(i) = wake_h(i)
170
  END DO
171
!
172
!    Make a copy of state variables
173
11520
  DO l = 1, klev
174
11176128
    DO i = 1, klon
175
11164608
      dtw(i, l) = wake_deltat(i, l)
176
11175840
      dqw(i, l) = wake_deltaq(i, l)
177
    END DO
178
  END DO
179
180
286560
  DO i = 1, klon
181
286560
    sigmaw(i) = wake_s(i)
182
  END DO
183
184
286560
  DO i = 1, klon
185
286272
    awdens(i) = max(0., awake_dens(i))
186
286560
    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
11232
  DO l = 1, klev - 1
193
10889568
    DO i = 1, klon
194
10878336
      amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
195
10889280
      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
286560
  DO i = 1, klon
202
286560
    amdwn(i, klev) = 0.5*m_dwn(i, klev)
203
  END DO
204
205
11520
  DO l = 1, klev
206
11176128
    DO i = 1, klon
207
11175840
      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
288
    d_deltatw, d_deltaqw, d_sigmaw, d_awdens, d_wdens)      ! tendencies
223
224
!
225
11520
  DO l = 1, klev
226
11176128
    DO i = 1, klon
227
11175840
      IF (ktopw(i)>0) THEN
228
1733550
        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
229
1733550
        wake_omgbdth(i, l) = omgbdth(i, l)
230
1733550
        wake_dp_omgb(i, l) = dp_omgb(i, l)
231
1733550
        wake_dtke(i, l) = dtke(i, l)
232
1733550
        wake_dqke(i, l) = dqke(i, l)
233
1733550
        wake_omg(i, l) = omg(i, l)
234
1733550
        wake_dp_deltomg(i, l) = dp_deltomg(i, l)
235
1733550
        wake_spread(i, l) = spread(i, l)
236
1733550
        wake_dth(i, l) = dth(i, l)
237
1733550
        dt_wake(i, l) = dtls(i, l)*dtime         ! derivative -> tendency
238
1733550
        dq_wake(i, l) = dqls(i, l)*dtime         ! derivative -> tendency
239
1733550
        t_x(i, l) = tx(i, l)
240
1733550
        q_x(i, l) = qx(i, l)
241
      ELSE
242
9431058
        wake_d_deltat_gw(i, l) = 0.
243
9431058
        wake_omgbdth(i, l) = 0.
244
9431058
        wake_dp_omgb(i, l) = 0.
245
9431058
        wake_dtke(i, l) = 0.
246
9431058
        wake_dqke(i, l) = 0.
247
9431058
        wake_omg(i, l) = 0.
248
9431058
        wake_dp_deltomg(i, l) = 0.
249
9431058
        wake_spread(i, l) = 0.
250
9431058
        wake_dth(i, l) = 0.
251
9431058
        dt_wake(i, l) = 0.
252
9431058
        dq_wake(i, l) = 0.
253
9431058
        t_x(i, l) = te(i, l)
254
9431058
        q_x(i, l) = qe(i, l)
255
      END IF
256
    END DO
257
  END DO
258
259
286560
  DO i = 1, klon
260
286272
    wake_h(i) = hw(i)
261
286272
    wake_pe(i) = wape(i)
262
286272
    wake_fip(i) = fip(i)
263
286272
    wake_gfl(i) = gfl(i)
264
286272
    wake_k(i) = ktopw(i)
265
286560
    wake_cstar(i) = cstar(i)
266
  END DO
267
268
!  Tendencies of state variables
269
11520
  DO l = 1, klev
270
11176128
    DO i = 1, klon
271
11175840
      IF (ktopw(i)>0) THEN
272
1733550
        wake_ddeltat(i, l) = d_deltatw(i, l)*dtime
273
1733550
        wake_ddeltaq(i, l) = d_deltaqw(i, l)*dtime
274
      ELSE
275
9431058
        wake_ddeltat(i, l) = -wake_deltat(i, l)
276
9431058
        wake_ddeltaq(i, l) = -wake_deltaq(i, l)
277
      END IF
278
    END DO
279
  END DO
280
286560
  DO i = 1, klon
281
286560
    IF (ktopw(i)>0) THEN
282
44450
      wake_ds(i) = d_sigmaw(i)*dtime
283
44450
      awake_ddens(i) = d_awdens(i)*dtime
284
44450
      wake_ddens(i) = d_wdens(i)*dtime
285
    ELSE
286
241822
      wake_ds(i)   = -wake_s(i)
287
241822
      wake_ddens(i)= -wake_dens(i)
288
    END IF
289
  END DO
290
!
291
292
!jyg<
293
288
  IF (iflag_wake_tend .EQ. 0) THEN
294
!  Update State variables
295
11520
    DO l = 1, klev
296
11176128
      DO i = 1, klon
297
11175840
        IF (ktopw(i)>0) THEN
298
1733550
          wake_deltat(i, l) = dtw(i, l)
299
1733550
          wake_deltaq(i, l) = dqw(i, l)
300
        ELSE
301
9431058
          wake_deltat(i, l) = 0.
302
9431058
          wake_deltaq(i, l) = 0.
303
        END IF
304
      END DO
305
    END DO
306
286560
    DO i = 1, klon
307
286272
      wake_s(i) = sigmaw(i)
308
286272
      awake_dens(i) = awdens(i)
309
286560
      wake_dens(i) = wdens(i)
310
    END DO
311
  ENDIF  ! (iflag_wake_tend .EQ. 0)
312
!
313
288
  IF (first) THEN
314
995
    DO i = 1,klon
315
995
      IF (wake_dens(i) < -1.) THEN
316
        wake_dens(i) = wdens(i)
317
      ENDIF
318
    ENDDO
319
1
    first=.false.
320
  ENDIF  ! (first)
321
!>jyg
322
323
288
  RETURN
324
END SUBROUTINE calwake
325