source: LMDZ6/trunk/libf/phylmd/calwake.f90 @ 5821

Last change on this file since 5821 was 5804, checked in by fhourdin, 3 months ago

Séparation de lmdz_wake en petits fichiers (JYG&FH)

  • 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: 12.4 KB
Line 
1! $Id: calwake.f90 5804 2025-09-05 17:27:12Z idelkadi $
2MODULE calwake_mod
3  PRIVATE
4
5  LOGICAL, SAVE, ALLOCATABLE :: first(:) ! first(klon) : first calwake computation on columns
6  !$OMP THREADPRIVATE(first)
7
8  LOGICAL, SAVE :: first_first=.TRUE.  ! fisrt call to calwake
9  !$OMP THREADPRIVATE(first_first) 
10
11  PUBLIC calwake_first, calwake
12
13CONTAINS 
14
15SUBROUTINE calwake_first(dtime)
16USE dimphy, ONLY : klon,klev
17USE lmdz_wake_first, ONLY : wake_first
18  REAL, INTENT(IN)  :: dtime
19 
20  IF (first_first) THEN
21    ALLOCATE(first(klon))
22    first(:)=.TRUE.
23   
24    CALL wake_first(klev, dtime)
25
26    first_first=.FALSE.
27  ENDIF
28
29END SUBROUTINE calwake_first
30
31
32SUBROUTINE calwake(iflag_wake_tend, paprs, pplay, dtime, &
33    t, q, omgb, &
34    dt_dwn, dq_dwn, m_dwn, m_up, dt_a, dq_a, wgen, &
35    sigd, Cin, &
36    wake_deltat, wake_deltaq, wake_s, awake_s, wake_dens, awake_dens, &
37    wake_dth, wake_h, &
38    wake_pe, wake_fip, wake_gfl, &
39    dt_wake, dq_wake, wake_k, t_x, q_x, wake_omgbdth, &
40    wake_dp_omgb, &
41    wake_dtke, wake_dqke, &
42    wake_omg, wake_dp_deltomg, &
43    wake_spread, wake_cstar, wake_d_deltat_gw, &
44    wake_ddeltat, wake_ddeltaq, wake_ds, awake_ds, wake_ddens, awake_ddens)
45  ! **************************************************************
46  ! *
47  ! CALWAKE                                                     *
48  ! interface avec le schema de calcul de la poche    *
49  ! froide                                            *
50  ! *
51  ! written by   : CHERUY Frederique, 13/03/2000, 10.31.05      *
52  ! modified by :  ROEHRIG Romain,    01/30/2007                *
53  ! **************************************************************
54
55  USE dimphy
56  USE phys_state_var_mod, ONLY: pctsrf
57  USE indice_sol_mod, ONLY: is_oce
58  USE print_control_mod, ONLY: lunout, prt_level
59  USE lmdz_wake, ONLY : wake
60           USE lmdz_wake2, ONLY : wake2
61           USE lmdz_wake3, ONLY : wake3
62  USE alpale_mod, ONLY: iflag_wake
63  USE yomcst_mod_h
64IMPLICIT NONE
65  ! ======================================================================
66
67
68  ! Arguments
69  ! ----------
70  ! Input
71  ! ----
72  INTEGER,                       INTENT (IN)         :: iflag_wake_tend
73  REAL,                          INTENT (IN)         :: dtime
74  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: pplay
75  REAL, DIMENSION(klon, klev+1), INTENT (IN)         :: paprs
76  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: t, q, omgb
77  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_dwn, dq_dwn
78  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: m_up, m_dwn
79  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_a, dq_a
80  REAL, DIMENSION(klon),         INTENT (IN)         :: wgen
81  REAL, DIMENSION(klon),         INTENT (IN)         :: sigd
82  REAL, DIMENSION(klon),         INTENT (IN)         :: Cin
83  ! Input/Output
84  ! ------------
85  REAL, DIMENSION(klon, klev),   INTENT (INOUT)      :: wake_deltat, wake_deltaq
86  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_s, awake_s
87  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_dens, awake_dens
88  ! Output
89  ! ------
90  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: dt_wake, dq_wake
91!!jyg  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_k
92  INTEGER, DIMENSION(klon),      INTENT (OUT)        :: wake_k
93  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_d_deltat_gw
94  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_h
95  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dth
96  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_pe, wake_fip, wake_gfl
97  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: t_x, q_x
98  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omgbdth, wake_dp_omgb
99  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dtke, wake_dqke
100  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omg, wake_dp_deltomg
101  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_spread
102  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_cstar
103  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_ddeltat, wake_ddeltaq
104  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_ds, awake_ds, wake_ddens, awake_ddens
105
106
107  ! Variable internes
108  ! -----------------
109  INTEGER                                            :: i, l
110  INTEGER, DIMENSION(klon)                           :: znatsurf    ! 0 if pctsrf(is_oce)>0.1; 1 else.
111  REAL                                               :: aire
112  REAL, DIMENSION(klon, klev)                        :: p,  pi
113  REAL, DIMENSION(klon, klev+1)                      ::  ph
114  REAL, DIMENSION(klon, klev)                        ::  omgbe
115  REAL, DIMENSION(klon, klev)                        :: te, qe
116  REAL, DIMENSION(klon, klev)                        :: dtdwn, dqdwn
117  REAL, DIMENSION(klon, klev)                        :: dta, dqa
118  REAL, DIMENSION(klon, klev)                        :: amdwn, amup
119  REAL, DIMENSION(klon, klev)                        :: dtw, dqw, dth
120  REAL, DIMENSION(klon, klev)                        :: dtls, dqls
121  REAL, DIMENSION(klon, klev)                        :: tx, qx
122  REAL, DIMENSION(klon)                              :: hw, wape, fip, gfl
123  REAL, DIMENSION(klon)                              :: sigmaw, asigmaw, wdens, awdens
124  REAL, DIMENSION(klon, klev)                        :: omgbdth
125  REAL, DIMENSION(klon, klev)                        :: dp_omgb
126  REAL, DIMENSION(klon, klev)                        :: dtke, dqke
127  REAL, DIMENSION(klon, klev)                        :: omg
128  REAL, DIMENSION(klon, klev)                        :: dp_deltomg, spread
129  REAL, DIMENSION(klon)                              :: cstar
130  REAL, DIMENSION(klon)                              :: sigd0
131  INTEGER, DIMENSION(klon)                           :: ktopw
132  REAL, DIMENSION(klon, klev)                        :: d_deltat_gw
133  REAL, DIMENSION(klon, klev)                        :: d_deltatw, d_deltaqw
134  REAL, DIMENSION(klon)                              :: d_sigmaw, d_asigmaw, d_wdens, d_awdens
135
136  REAL                                               :: rdcp
137
138
139  IF (prt_level >= 10) THEN
140    print *, '-> calwake, wake_s, awake_s, wgen input ', wake_s(1), awake_s(1), wgen(1)
141  ENDIF
142
143  rdcp = 1./3.5
144
145  znatsurf(:) = 0
146  DO i = 1,klon
147    IF (pctsrf(i,is_oce) < 0.1) znatsurf(i) = 1
148  ENDDO
149
150
151  ! -----------------------------------------------------------
152  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
153  ! ----------------------------------------------------------
154
155
156  DO l = 1, klev
157    DO i = 1, klon
158      p(i, l) = pplay(i, l)
159      ph(i, l) = paprs(i, l)
160      pi(i, l) = (pplay(i,l)/100000.)**rdcp
161
162      te(i, l) = t(i, l)
163      qe(i, l) = q(i, l)
164      omgbe(i, l) = omgb(i, l)
165
166      dtdwn(i, l) = dt_dwn(i, l)
167      dqdwn(i, l) = dq_dwn(i, l)
168      dta(i, l) = dt_a(i, l)
169      dqa(i, l) = dq_a(i, l)
170    END DO
171  END DO
172
173!----------------------------------------------------------------
174!         Initialize tendencies to zero
175!----------------------------------------------------------------
176dtls(:,:) = 0.
177dqls(:,:) = 0.
178d_deltat_gw(:,:) = 0.
179d_deltatw(:,:) = 0.
180d_deltaqw(:,:) = 0.
181d_sigmaw(:) = 0.
182d_asigmaw(:) = 0.
183d_wdens(:) = 0.
184d_awdens(:) = 0.
185!
186
187  DO i = 1, klon
188    sigd0(i) = sigd(i)
189  END DO
190  ! print*, 'sigd0,sigd', sigd0, sigd(i)
191  DO i = 1, klon
192    ph(i, klev+1) = 0.
193  END DO
194
195!!jyg!  DO i = 1, klon                 
196!!jyg!    ktopw(i) = NINT(wake_k(i))   
197!!jyg!  END DO                         
198
199  DO i = 1, klon
200    hw(i) = wake_h(i)
201  END DO
202!
203!    Make a copy of state variables
204  DO l = 1, klev
205    DO i = 1, klon
206      dtw(i, l) = wake_deltat(i, l)
207      dqw(i, l) = wake_deltaq(i, l)
208    END DO
209  END DO
210
211  DO i = 1, klon
212    sigmaw(i)  = wake_s(i)
213    asigmaw(i) = awake_s(i)
214  END DO
215
216  DO i = 1, klon
217    wdens(i) = max(0., wake_dens(i))
218    awdens(i) = max(0., awake_dens(i))
219  END DO
220
221  ! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
222  ! fkc  on veut le flux de masse au milieu des couches
223
224  DO l = 1, klev - 1
225    DO i = 1, klon
226      amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
227      amdwn(i, l) = (m_dwn(i,l+1))
228    END DO
229  END DO
230
231  ! au sommet le flux de masse est nul
232
233  DO i = 1, klon
234    amdwn(i, klev) = 0.5*m_dwn(i, klev)
235  END DO
236
237  DO l = 1, klev
238    DO i = 1, klon
239      amup(i, l) = m_up(i, l)
240    END DO
241  END DO
242
243
244
245  IF (iflag_wake/10 == 0) THEN
246    CALL wake(klon,klev,znatsurf, p, ph, pi, dtime, &
247      te, qe, omgbe, &
248      dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
249      sigd0, Cin, &
250      dtw, dqw, sigmaw, asigmaw, wdens, awdens, &                      ! state variables
251      dth, hw, wape, fip, gfl, &
252      dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
253      dtke, dqke, omg, dp_deltomg, spread, cstar, &
254      d_deltat_gw, &
255      d_deltatw, d_deltaqw, d_sigmaw, d_asigmaw, d_wdens, d_awdens)      ! tendencies
256
257  ELSE IF (iflag_wake/10 == 2) THEN
258    CALL wake2(klon,klev,znatsurf, p, ph, pi, dtime, &
259      te, qe, omgbe, &
260      dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
261      sigd0, Cin, &
262      dtw, dqw, sigmaw, asigmaw, wdens, awdens, &                      ! state variables
263      dth, hw, wape, fip, gfl, &
264      dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
265      dtke, dqke, omg, dp_deltomg, spread, cstar, &
266      d_deltat_gw, &
267      d_deltatw, d_deltaqw, d_sigmaw, d_asigmaw, d_wdens, d_awdens)      ! tendencies
268
269  ELSE IF (iflag_wake/10 == 3) THEN
270    CALL wake3(klon,klev,znatsurf, p, ph, pi, dtime, &
271      te, qe, omgbe, &
272      dtdwn, dqdwn, amdwn, amup, dta, dqa, wgen, &
273      sigd0, Cin, &
274      dtw, dqw, sigmaw, asigmaw, wdens, awdens, &                      ! state variables
275      dth, hw, wape, fip, gfl, &
276      dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
277      dtke, dqke, omg, dp_deltomg, spread, cstar, &
278      d_deltat_gw, &
279      d_deltatw, d_deltaqw, d_sigmaw, d_asigmaw, d_wdens, d_awdens)      ! tendencies
280
281  END IF  !(iflag_wake/10 == 0)
282
283
284!
285  DO l = 1, klev
286    DO i = 1, klon
287      IF (ktopw(i)>0) THEN
288        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
289        wake_omgbdth(i, l) = omgbdth(i, l)
290        wake_dp_omgb(i, l) = dp_omgb(i, l)
291        wake_dtke(i, l) = dtke(i, l)
292        wake_dqke(i, l) = dqke(i, l)
293        wake_omg(i, l) = omg(i, l)
294        wake_dp_deltomg(i, l) = dp_deltomg(i, l)
295        wake_spread(i, l) = spread(i, l)
296        wake_dth(i, l) = dth(i, l)
297        dt_wake(i, l) = dtls(i, l)*dtime         ! derivative -> tendency
298        dq_wake(i, l) = dqls(i, l)*dtime         ! derivative -> tendency
299        t_x(i, l) = tx(i, l)
300        q_x(i, l) = qx(i, l)
301      ELSE
302        wake_d_deltat_gw(i, l) = 0.
303        wake_omgbdth(i, l) = 0.
304        wake_dp_omgb(i, l) = 0.
305        wake_dtke(i, l) = 0.
306        wake_dqke(i, l) = 0.
307        wake_omg(i, l) = 0.
308        wake_dp_deltomg(i, l) = 0.
309        wake_spread(i, l) = 0.
310        wake_dth(i, l) = 0.
311        dt_wake(i, l) = 0.
312        dq_wake(i, l) = 0.
313        t_x(i, l) = te(i, l)
314        q_x(i, l) = qe(i, l)
315      END IF
316    END DO
317  END DO
318
319  DO i = 1, klon
320    wake_h(i) = hw(i)
321    wake_pe(i) = wape(i)
322    wake_fip(i) = fip(i)
323    wake_gfl(i) = gfl(i)
324    wake_k(i) = ktopw(i)
325    wake_cstar(i) = cstar(i)
326  END DO
327
328!  Tendencies of state variables
329  DO l = 1, klev
330    DO i = 1, klon
331      IF (ktopw(i)>0) THEN
332        wake_ddeltat(i, l) = d_deltatw(i, l)*dtime
333        wake_ddeltaq(i, l) = d_deltaqw(i, l)*dtime
334      ELSE
335        wake_ddeltat(i, l) = -wake_deltat(i, l)
336        wake_ddeltaq(i, l) = -wake_deltaq(i, l)
337      END IF
338    END DO
339  END DO
340  DO i = 1, klon
341    IF (ktopw(i)>0) THEN
342      wake_ds(i) = d_sigmaw(i)*dtime
343      awake_ds(i) = d_asigmaw(i)*dtime
344      awake_ddens(i) = d_awdens(i)*dtime
345      wake_ddens(i) = d_wdens(i)*dtime
346    ELSE
347      wake_ds(i)    = -wake_s(i)
348      awake_ds(i)   = -awake_s(i)
349      wake_ddens(i) = -wake_dens(i)
350      awake_ddens(i)= -awake_dens(i)
351    END IF
352  END DO
353!
354
355!jyg< 
356  IF (iflag_wake_tend .EQ. 0) THEN
357!  Update State variables
358    DO l = 1, klev
359      DO i = 1, klon
360        IF (ktopw(i)>0) THEN
361          wake_deltat(i, l) = dtw(i, l)
362          wake_deltaq(i, l) = dqw(i, l)
363        ELSE
364          wake_deltat(i, l) = 0.
365          wake_deltaq(i, l) = 0.
366        END IF
367      END DO
368    END DO
369    DO i = 1, klon
370      wake_s(i) = sigmaw(i)
371      awake_s(i) = asigmaw(i)
372      awake_dens(i) = awdens(i)
373      wake_dens(i) = wdens(i)
374    END DO
375  ENDIF  ! (iflag_wake_tend .EQ. 0)
376!
377  DO i = 1,klon
378    IF (first(i)) THEN
379      IF (wake_dens(i) < -1.) THEN
380        wake_dens(i) = wdens(i)
381      ENDIF
382      first(i)=.FALSE.
383    ENDIF 
384  ENDDO
385   
386!>jyg
387  IF (prt_level >= 10) THEN
388    print *, 'calwake ->, wake_s, awake_s ', wake_s(1), awake_s(1)
389  ENDIF
390
391  RETURN
392END SUBROUTINE calwake
393
394END MODULE calwake_mod
Note: See TracBrowser for help on using the repository browser.