source: LMDZ6/trunk/libf/phylmdiso/calwake.F90 @ 4797

Last change on this file since 4797 was 4783, checked in by crisi, 11 months ago

fix bug in calwake: a use was in ISO and should be outside

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