source: LMDZ6/trunk/libf/phylmd/calwake_mod.f90

Last change on this file was 6088, checked in by rkazeroni, 4 days ago

Adjust GPUM "horizontal directives" to enable automatic GPU porting

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