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

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