source: LMDZ5/branches/Cold_pool_death/libf/phylmd/calwake.F90 @ 5409

Last change on this file since 5409 was 3899, checked in by lguez, 4 years ago

Old work on cold pool death.
  • 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: 9.7 KB
RevLine 
[1992]1
[1403]2! $Id: calwake.F90 3899 2021-05-14 17:12:13Z evignon $
[879]3
[2641]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, &
7    sigd, &
8    wake_deltat, wake_deltaq, wake_s, 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, &
[3899]16    wake_ddeltat, wake_ddeltaq, wake_ds, wake_ddens, itap)
[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
[2787]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
[1992]31  IMPLICIT NONE
32  ! ======================================================================
33  include "YOMCST.h"
[974]34
[1992]35  ! Arguments
36  ! ----------
[2641]37  ! Input
38  ! ----
39  INTEGER,                       INTENT (IN)         :: iflag_wake_tend
40  REAL,                          INTENT (IN)         :: dtime
41  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: pplay
42  REAL, DIMENSION(klon, klev+1), INTENT (IN)         :: paprs
43  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: t, q, omgb
44  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_dwn, dq_dwn
45  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: m_up, m_dwn
46  REAL, DIMENSION(klon, klev),   INTENT (IN)         :: dt_a, dq_a
47  REAL, DIMENSION(klon),         INTENT (IN)         :: sigd
48  ! Input/Output
49  ! ------------
50  REAL, DIMENSION(klon, klev),   INTENT (INOUT)      :: wake_deltat, wake_deltaq
51  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_s
52  REAL, DIMENSION(klon),         INTENT (INOUT)      :: wake_dens
53  ! Output
54  ! ------
55  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: dt_wake, dq_wake
[2870]56!!jyg  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_k
57  INTEGER, DIMENSION(klon),      INTENT (OUT)        :: wake_k
[2641]58  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_d_deltat_gw
59  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_h
60  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dth
61  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_pe, wake_fip, wake_gfl
62  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: t_x, q_x
63  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omgbdth, wake_dp_omgb
64  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_dtke, wake_dqke
65  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_omg, wake_dp_deltomg
66  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_spread
67  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_cstar
68  REAL, DIMENSION(klon, klev),   INTENT (OUT)        :: wake_ddeltat, wake_ddeltaq
69  REAL, DIMENSION(klon),         INTENT (OUT)        :: wake_ds, wake_ddens
[3899]70  integer, intent(in):: itap ! index of call to physiq
[974]71
72
[1992]73  ! Variable internes
74  ! -----------------
[2641]75  INTEGER                                            :: i, l
[2787]76  INTEGER, DIMENSION(klon)                           :: znatsurf    ! 0 if pctsrf(is_oce)>0.1; 1 else.
[2641]77  REAL                                               :: aire
78  REAL, DIMENSION(klon, klev)                        :: p,  pi
[2720]79  REAL, DIMENSION(klon, klev+1)                      ::  ph
80  REAL, DIMENSION(klon, klev)                        ::  omgbe
[2641]81  REAL, DIMENSION(klon, klev)                        :: te, qe
82  REAL, DIMENSION(klon, klev)                        :: dtdwn, dqdwn
83  REAL, DIMENSION(klon, klev)                        :: dta, dqa
84  REAL, DIMENSION(klon, klev)                        :: amdwn, amup
85  REAL, DIMENSION(klon, klev)                        :: dtw, dqw, dth
86  REAL, DIMENSION(klon, klev)                        :: dtls, dqls
87  REAL, DIMENSION(klon, klev)                        :: tx, qx
88  REAL, DIMENSION(klon)                              :: hw, wape, fip, gfl
89  REAL, DIMENSION(klon)                              :: sigmaw, wdens
[2720]90  REAL, DIMENSION(klon, klev)                        :: omgbdth
[2641]91  REAL, DIMENSION(klon, klev)                        :: dp_omgb
92  REAL, DIMENSION(klon, klev)                        :: dtke, dqke
[2720]93  REAL, DIMENSION(klon, klev)                        :: omg
[2641]94  REAL, DIMENSION(klon, klev)                        :: dp_deltomg, spread
95  REAL, DIMENSION(klon)                              :: cstar
96  REAL, DIMENSION(klon)                              :: sigd0
97  INTEGER, DIMENSION(klon)                           :: ktopw
98  REAL, DIMENSION(klon, klev)                        :: d_deltat_gw
99  REAL, DIMENSION(klon, klev)                        :: d_deltatw, d_deltaqw
100  REAL, DIMENSION(klon)                              :: d_sigmaw, d_wdens
[974]101
[2641]102  REAL                                               :: rdcp
[974]103
104
[2787]105  IF (prt_level >= 10) THEN
106    print *, '-> calwake, wake_s input ', wake_s(1)
107  ENDIF
[990]108
[1992]109  rdcp = 1./3.5
[974]110
[2787]111  znatsurf(:) = 0
112  DO i = 1,klon
113    IF (pctsrf(i,is_oce) < 0.1) znatsurf(i) = 1
114  ENDDO
[974]115
[2787]116
[1992]117  ! -----------------------------------------------------------
118  ! IM 290108     DO 999 i=1,klon   ! a vectoriser
119  ! ----------------------------------------------------------
[974]120
121
[1992]122  DO l = 1, klev
123    DO i = 1, klon
124      p(i, l) = pplay(i, l)
125      ph(i, l) = paprs(i, l)
126      pi(i, l) = (pplay(i,l)/100000.)**rdcp
[990]127
[1992]128      te(i, l) = t(i, l)
129      qe(i, l) = q(i, l)
130      omgbe(i, l) = omgb(i, l)
[974]131
[1992]132      dtdwn(i, l) = dt_dwn(i, l)
133      dqdwn(i, l) = dq_dwn(i, l)
134      dta(i, l) = dt_a(i, l)
135      dqa(i, l) = dq_a(i, l)
136    END DO
137  END DO
[974]138
[2787]139!----------------------------------------------------------------
140!         Initialize tendencies to zero
141!----------------------------------------------------------------
142dtls(:,:) = 0.
143dqls(:,:) = 0.
144d_deltat_gw(:,:) = 0.
145d_deltatw(:,:) = 0.
146d_deltaqw(:,:) = 0.
147d_sigmaw(:) = 0.
148d_wdens(:) = 0.
149!
150
[1992]151  DO i = 1, klon
152    sigd0(i) = sigd(i)
153  END DO
154  ! print*, 'sigd0,sigd', sigd0, sigd(i)
155  DO i = 1, klon
156    ph(i, klev+1) = 0.
157  END DO
[974]158
[2787]159!!jyg!  DO i = 1, klon                 
160!!jyg!    ktopw(i) = NINT(wake_k(i))   
161!!jyg!  END DO                         
[974]162
[2641]163  DO i = 1, klon
164    hw(i) = wake_h(i)
165  END DO
166!
167!    Make a copy of state variables
[1992]168  DO l = 1, klev
169    DO i = 1, klon
170      dtw(i, l) = wake_deltat(i, l)
171      dqw(i, l) = wake_deltaq(i, l)
172    END DO
173  END DO
[974]174
[2641]175  DO i = 1, klon
176    sigmaw(i) = wake_s(i)
[1992]177  END DO
[974]178
[1992]179  DO i = 1, klon
[2641]180    wdens(i) = wake_dens(i)
[1992]181  END DO
[974]182
[1992]183  ! fkc les flux de masses sont evalues aux niveaux et valent 0 a la surface
184  ! fkc  on veut le flux de masse au milieu des couches
[974]185
[1992]186  DO l = 1, klev - 1
187    DO i = 1, klon
188      amdwn(i, l) = 0.5*(m_dwn(i,l)+m_dwn(i,l+1))
189      amdwn(i, l) = (m_dwn(i,l+1))
190    END DO
191  END DO
[1403]192
[1992]193  ! au sommet le flux de masse est nul
[974]194
[1992]195  DO i = 1, klon
196    amdwn(i, klev) = 0.5*m_dwn(i, klev)
197  END DO
[879]198
[1992]199  DO l = 1, klev
200    DO i = 1, klon
201      amup(i, l) = m_up(i, l)
202    END DO
203  END DO
[879]204
[2787]205  CALL wake(znatsurf, p, ph, pi, dtime, &
[2641]206    te, qe, omgbe, &
207    dtdwn, dqdwn, amdwn, amup, dta, dqa, &
208    sigd0, &
209    dtw, dqw, sigmaw, wdens, &                                   ! state variables
210    dth, hw, wape, fip, gfl, &
211    dtls, dqls, ktopw, omgbdth, dp_omgb, tx, qx, &
212    dtke, dqke, omg, dp_deltomg, spread, cstar, &
213    d_deltat_gw, &
[3899]214    d_deltatw, d_deltaqw, d_sigmaw, d_wdens, itap)                     ! tendencies
[879]215
[2641]216!
[1992]217  DO l = 1, klev
218    DO i = 1, klon
219      IF (ktopw(i)>0) THEN
220        wake_d_deltat_gw(i, l) = d_deltat_gw(i, l)
221        wake_omgbdth(i, l) = omgbdth(i, l)
222        wake_dp_omgb(i, l) = dp_omgb(i, l)
223        wake_dtke(i, l) = dtke(i, l)
224        wake_dqke(i, l) = dqke(i, l)
225        wake_omg(i, l) = omg(i, l)
226        wake_dp_deltomg(i, l) = dp_deltomg(i, l)
227        wake_spread(i, l) = spread(i, l)
228        wake_dth(i, l) = dth(i, l)
[2641]229        dt_wake(i, l) = dtls(i, l)*dtime         ! derivative -> tendency
230        dq_wake(i, l) = dqls(i, l)*dtime         ! derivative -> tendency
231        t_x(i, l) = tx(i, l)
232        q_x(i, l) = qx(i, l)
[1992]233      ELSE
234        wake_d_deltat_gw(i, l) = 0.
235        wake_omgbdth(i, l) = 0.
236        wake_dp_omgb(i, l) = 0.
237        wake_dtke(i, l) = 0.
238        wake_dqke(i, l) = 0.
239        wake_omg(i, l) = 0.
240        wake_dp_deltomg(i, l) = 0.
241        wake_spread(i, l) = 0.
242        wake_dth(i, l) = 0.
243        dt_wake(i, l) = 0.
244        dq_wake(i, l) = 0.
[2641]245        t_x(i, l) = te(i, l)
246        q_x(i, l) = qe(i, l)
[1992]247      END IF
248    END DO
249  END DO
[879]250
[1992]251  DO i = 1, klon
252    wake_h(i) = hw(i)
253    wake_pe(i) = wape(i)
254    wake_fip(i) = fip(i)
255    wake_gfl(i) = gfl(i)
256    wake_k(i) = ktopw(i)
257    wake_cstar(i) = cstar(i)
258  END DO
[879]259
[2641]260!  Tendencies of state variables
261  DO l = 1, klev
262    DO i = 1, klon
263      IF (ktopw(i)>0) THEN
264        wake_ddeltat(i, l) = d_deltatw(i, l)*dtime
265        wake_ddeltaq(i, l) = d_deltaqw(i, l)*dtime
266      ELSE
267        wake_ddeltat(i, l) = -wake_deltat(i, l)
268        wake_ddeltaq(i, l) = -wake_deltaq(i, l)
269      END IF
270    END DO
271  END DO
272  DO i = 1, klon
273    IF (ktopw(i)>0) THEN
274      wake_ds(i) = d_sigmaw(i)*dtime
275      wake_ddens(i) = d_wdens(i)*dtime
276    ELSE
277      wake_ds(i)   = -wake_s(i)
278      wake_ddens(i)= -wake_dens(i)
279    END IF
280  END DO
[2787]281!
[2641]282
283!jyg< 
284  IF (iflag_wake_tend .EQ. 0) THEN
285!  Update State variables
286    DO l = 1, klev
287      DO i = 1, klon
288        IF (ktopw(i)>0) THEN
289          wake_deltat(i, l) = dtw(i, l)
290          wake_deltaq(i, l) = dqw(i, l)
291        ELSE
292          wake_deltat(i, l) = 0.
293          wake_deltaq(i, l) = 0.
294        END IF
295      END DO
296    END DO
297    DO i = 1, klon
298      wake_s(i) = sigmaw(i)
299      wake_dens(i) = wdens(i)
300    END DO
301  ENDIF
302!>jyg
303
[1992]304  RETURN
305END SUBROUTINE calwake
[2641]306
Note: See TracBrowser for help on using the repository browser.