source: LMDZ6/branches/Amaury_dev/libf/phylmdiso/calwake.F90 @ 5158

Last change on this file since 5158 was 5158, checked in by abarral, 7 weeks ago

Add missing klon on strataer_emiss_mod.F90
Correct various missing explicit declarations
Replace tabs by spaces (tabs are not part of the fortran charset)
Continue cleaning modules
Removed unused arguments and variables

  • Property svn:keywords set to Id
File size: 14.0 KB
Line 
1
2! $Id: calwake.F90 5158 2024-08-02 12:12:03Z abarral $
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 lmdz_print_control, 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
44USE lmdz_yomcst
45
46  IMPLICIT NONE
47  ! ======================================================================
48
49  ! Arguments
50  ! ----------
51  ! Input
52  ! ----
53  INTEGER,                       INTENT (IN)         :: iflag_wake_tend
54  REAL,                          INTENT (IN)         :: dtime
55  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: pplay
56  REAL, DIMENSION(klon, klev+1), INTENT (IN)         :: paprs
57  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: t, q, omgb
58  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_dwn, dq_dwn
59  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: m_up, m_dwn
60  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_a, dq_a
61  REAL, DIMENSION(klon),         INTENT (IN)         :: wgen
62  REAL, DIMENSION(klon),         INTENT (IN)         :: sigd
63  REAL, DIMENSION(klon),         INTENT (IN)         :: Cin
64#ifdef ISO
65  REAL, DIMENSION(ntraciso,klon, klev),   INTENT (IN) :: xt,dxt_dwn,dxt_a
66#endif
67  ! Input/Output
68  ! ------------
69  REAL, DIMENSION(klon, klev),   INTENT (INOUT)      :: wake_deltat, wake_deltaq
70  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_s
71  REAL, DIMENSION(klon),         INTENT (INOUT)      :: awake_dens, wake_dens
72#ifdef ISO
73  REAL, DIMENSION(ntraciso,klon, klev),   INTENT (INOUT)      :: wake_deltaxt
74#endif
75  ! Output
76  ! ------
77  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: dt_wake, dq_wake
78!!jyg  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_k
79  INTEGER, DIMENSION(klon),      INTENT (OUT)        :: wake_k
80  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_d_deltat_gw
81  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_h
82  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dth
83  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_pe, wake_fip, wake_gfl
84  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: t_x, q_x
85  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omgbdth, wake_dp_omgb
86  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dtke, wake_dqke
87  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omg, wake_dp_deltomg
88  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_spread
89  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_cstar
90  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_ddeltat, wake_ddeltaq
91  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_ds, awake_ddens, wake_ddens
92#ifdef ISO
93  REAL, DIMENSION(ntraciso,klon, klev),   INTENT (OUT)        :: dxt_wake
94  REAL, DIMENSION(ntraciso,klon, klev),   INTENT (OUT)        :: xt_x
95  REAL, DIMENSION(ntraciso,klon, klev),   INTENT (OUT)        :: wake_ddeltaxt
96  REAL, DIMENSION(ntraciso,klon, klev)                        :: wake_dxtke ! pas besoin de la sortir
97#endif
98
99
100  ! Variable internes
101  ! -----------------
102  LOGICAL, SAVE                                      :: first = .TRUE.
103  !$OMP THREADPRIVATE(first)
104  INTEGER                                            :: i, l
105  INTEGER, DIMENSION(klon)                           :: znatsurf    ! 0 if pctsrf(is_oce)>0.1; 1 else.
106  REAL                                               :: aire
107  REAL, DIMENSION(klon, klev)                        :: p,  pi
108  REAL, DIMENSION(klon, klev+1)                      ::  ph
109  REAL, DIMENSION(klon, klev)                        ::  omgbe
110  REAL, DIMENSION(klon, klev)                        :: te, qe
111  REAL, DIMENSION(klon, klev)                        :: dtdwn, dqdwn
112  REAL, DIMENSION(klon, klev)                        :: dta, dqa
113  REAL, DIMENSION(klon, klev)                        :: amdwn, amup
114  REAL, DIMENSION(klon, klev)                        :: dtw, dqw, dth
115  REAL, DIMENSION(klon, klev)                        :: dtls, dqls
116  REAL, DIMENSION(klon, klev)                        :: tx, qx
117  REAL, DIMENSION(klon)                              :: hw, wape, fip, gfl
118  REAL, DIMENSION(klon)                              :: sigmaw, awdens, wdens
119  REAL, DIMENSION(klon, klev)                        :: omgbdth
120  REAL, DIMENSION(klon, klev)                        :: dp_omgb
121  REAL, DIMENSION(klon, klev)                        :: dtke, dqke
122  REAL, DIMENSION(klon, klev)                        :: omg
123  REAL, DIMENSION(klon, klev)                        :: dp_deltomg, spread
124  REAL, DIMENSION(klon)                              :: cstar
125  REAL, DIMENSION(klon)                              :: sigd0
126  INTEGER, DIMENSION(klon)                           :: ktopw
127  REAL, DIMENSION(klon, klev)                        :: d_deltat_gw
128  REAL, DIMENSION(klon, klev)                        :: d_deltatw, d_deltaqw
129  REAL, DIMENSION(klon)                              :: d_sigmaw, d_awdens, d_wdens
130#ifdef ISO
131  REAL, DIMENSION(ntraciso,klon, klev)                        :: xte
132  REAL, DIMENSION(ntraciso,klon, klev)                        :: dxtdwn
133  REAL, DIMENSION(ntraciso,klon, klev)                        :: dxta
134  REAL, DIMENSION(ntraciso,klon, klev)                        :: dxtw
135  REAL, DIMENSION(ntraciso,klon, klev)                        :: dxtls
136  REAL, DIMENSION(ntraciso,klon, klev)                        :: xtx
137  REAL, DIMENSION(ntraciso,klon, klev)                        :: dxtke
138  REAL, DIMENSION(ntraciso,klon, klev)                        :: d_deltaxtw
139  INTEGER                                            :: ixt
140#endif
141
142  REAL                                               :: rdcp
143
144  IF (prt_level >= 10) THEN
145    print *, '-> calwake, wake_s, wgen input ', wake_s(1), wgen(1)
146  ENDIF
147
148  rdcp = 1./3.5
149
150  znatsurf(:) = 0
151  DO i = 1,klon
152    IF (pctsrf(i,is_oce) < 0.1) znatsurf(i) = 1
153  ENDDO
154
155
156  ! -----------------------------------------------------------
157  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
158  ! ----------------------------------------------------------
159
160
161  DO l = 1, klev
162    DO i = 1, klon
163      p(i, l) = pplay(i, l)
164      ph(i, l) = paprs(i, l)
165      pi(i, l) = (pplay(i,l)/100000.)**rdcp
166
167      te(i, l) = t(i, l)
168      qe(i, l) = q(i, l)
169      omgbe(i, l) = omgb(i, l)
170
171      dtdwn(i, l) = dt_dwn(i, l)
172      dqdwn(i, l) = dq_dwn(i, l)
173      dta(i, l) = dt_a(i, l)
174      dqa(i, l) = dq_a(i, l)
175#ifdef ISO
176      DO ixt=1,ntraciso
177        xte(ixt,i, l) = xt(ixt,i, l)
178        dxtdwn(ixt,i, l) = dxt_dwn(ixt,i, l)
179        dxta(ixt,i, l) = dxt_a(ixt,i, l)
180      enddo
181#endif
182    END DO
183  END DO
184
185!----------------------------------------------------------------
186!         Initialize tendencies to zero
187!----------------------------------------------------------------
188dtls(:,:) = 0.
189dqls(:,:) = 0.
190d_deltat_gw(:,:) = 0.
191d_deltatw(:,:) = 0.
192d_deltaqw(:,:) = 0.
193d_sigmaw(:) = 0.
194d_awdens(:) = 0.
195d_wdens(:) = 0.
196#ifdef ISO
197dxtls(:,:,:) = 0.
198d_deltaxtw(:,:,:) = 0.
199#endif
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  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!jyg< 
396  IF (iflag_wake_tend == 0) THEN
397!  Update State variables
398    DO l = 1, klev
399      DO i = 1, klon
400        IF (ktopw(i)>0) THEN
401          wake_deltat(i, l) = dtw(i, l)
402          wake_deltaq(i, l) = dqw(i, l)
403#ifdef ISO
404        DO ixt=1,ntraciso
405          wake_deltaxt(ixt,i, l) = dxtw(ixt,i, l)
406        enddo
407#endif
408        ELSE
409          wake_deltat(i, l) = 0.
410          wake_deltaq(i, l) = 0.
411#ifdef ISO
412        DO ixt=1,ntraciso
413          wake_deltaxt(ixt,i, l) = 0.
414        enddo
415#endif
416        END IF
417      END DO
418    END DO
419    DO i = 1, klon
420      wake_s(i) = sigmaw(i)
421      awake_dens(i) = awdens(i)
422      wake_dens(i) = wdens(i)
423    END DO
424  ENDIF  ! (iflag_wake_tend .EQ. 0)
425
426  IF (first) THEN
427    DO i = 1,klon
428      IF (wake_dens(i) < -1.) THEN
429        wake_dens(i) = wdens(i)
430      ENDIF
431    ENDDO
432    first=.FALSE.
433  ENDIF  ! (first)
434!>jyg
435
436
437END SUBROUTINE calwake
438
Note: See TracBrowser for help on using the repository browser.