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

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

As discussed internally, remove generic ONLY: ... for new _mod_h modules

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