[5140] | 1 | ! Replaces conema3.h |
---|
[5099] | 2 | |
---|
[5140] | 3 | MODULE lmdz_conema3 |
---|
| 4 | IMPLICIT NONE; PRIVATE |
---|
| 5 | PUBLIC epmax, coef_epmax_cape, cvl_comp_threshold, cvl_sig2feed |
---|
| 6 | PUBLIC iflag_cvl_sigd, iflag_clw, ok_adj_ema |
---|
| 7 | PUBLIC conema3 |
---|
[5099] | 8 | |
---|
[5140] | 9 | REAL epmax ! 0.993 |
---|
| 10 | REAL coef_epmax_cape ! 0.993 |
---|
| 11 | REAL cvl_comp_threshold ! 0. |
---|
| 12 | LOGICAL ok_adj_ema ! F |
---|
| 13 | INTEGER iflag_clw ! 0 |
---|
| 14 | INTEGER iflag_cvl_sigd |
---|
| 15 | REAL cvl_sig2feed ! 0.97 |
---|
[524] | 16 | |
---|
[5140] | 17 | !$OMP THREADPRIVATE(epmax,coef_epmax_cape, cvl_comp_threshold, cvl_sig2feed) |
---|
| 18 | !$OMP THREADPRIVATE(iflag_cvl_sigd, iflag_clw, ok_adj_ema) |
---|
[879] | 19 | |
---|
[5140] | 20 | CONTAINS |
---|
[2253] | 21 | |
---|
[5140] | 22 | SUBROUTINE conema3(dtime, paprs, pplay, t, q, u, v, tra, ntra, work1, work2, & |
---|
| 23 | d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwdbis, & |
---|
| 24 | bas, top, ma, cape, tvp, rflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, & |
---|
| 25 | dplcldr, qcond_incld) |
---|
| 26 | |
---|
| 27 | USE dimphy |
---|
| 28 | USE infotrac_phy, ONLY: nbtr |
---|
[5144] | 29 | USE lmdz_yoethf |
---|
[5153] | 30 | |
---|
[5144] | 31 | USE lmdz_yomcst |
---|
[5143] | 32 | |
---|
[5140] | 33 | IMPLICIT NONE |
---|
[5153] | 34 | INCLUDE "FCTTRE.h" |
---|
[5140] | 35 | ! ====================================================================== |
---|
| 36 | ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818 |
---|
| 37 | ! Objet: schema de convection de Emanuel (1991) interface |
---|
| 38 | ! Mai 1998: Interface modifiee pour implementation dans LMDZ |
---|
| 39 | ! ====================================================================== |
---|
| 40 | ! Arguments: |
---|
| 41 | ! dtime---input-R-pas d'integration (s) |
---|
| 42 | ! paprs---input-R-pression inter-couches (Pa) |
---|
| 43 | ! pplay---input-R-pression au milieu des couches (Pa) |
---|
| 44 | ! t-------input-R-temperature (K) |
---|
| 45 | ! q-------input-R-humidite specifique (kg/kg) |
---|
| 46 | ! u-------input-R-vitesse du vent zonal (m/s) |
---|
| 47 | ! v-------input-R-vitesse duvent meridien (m/s) |
---|
| 48 | ! tra-----input-R-tableau de rapport de melange des traceurs |
---|
| 49 | ! work*: input et output: deux variables de travail, |
---|
| 50 | ! on peut les mettre a 0 au debut |
---|
| 51 | |
---|
| 52 | ! d_t-----output-R-increment de la temperature |
---|
| 53 | ! d_q-----output-R-increment de la vapeur d'eau |
---|
| 54 | ! d_u-----output-R-increment de la vitesse zonale |
---|
| 55 | ! d_v-----output-R-increment de la vitesse meridienne |
---|
| 56 | ! d_tra---output-R-increment du contenu en traceurs |
---|
| 57 | ! rain----output-R-la pluie (mm/s) |
---|
| 58 | ! snow----output-R-la neige (mm/s) |
---|
| 59 | ! kbas----output-R-bas du nuage (integer) |
---|
| 60 | ! ktop----output-R-haut du nuage (integer) |
---|
| 61 | ! upwd----output-R-saturated updraft mass flux (kg/m**2/s) |
---|
| 62 | ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s) |
---|
| 63 | ! dnwdbis-output-R-unsaturated downdraft mass flux (kg/m**2/s) |
---|
| 64 | ! bas-----output-R-bas du nuage (real) |
---|
| 65 | ! top-----output-R-haut du nuage (real) |
---|
| 66 | ! Ma------output-R-flux ascendant non dilue (kg/m**2/s) |
---|
| 67 | ! cape----output-R-CAPE |
---|
| 68 | ! tvp-----output-R-virtual temperature of the lifted parcel |
---|
| 69 | ! rflag---output-R-flag sur le fonctionnement de convect |
---|
| 70 | ! pbase---output-R-pression a la base du nuage (Pa) |
---|
| 71 | ! bbase---output-R-buoyancy a la base du nuage (K) |
---|
| 72 | ! dtvpdt1-output-R-derivative of parcel virtual temp wrt T1 |
---|
| 73 | ! dtvpdq1-output-R-derivative of parcel virtual temp wrt Q1 |
---|
| 74 | ! dplcldt-output-R-derivative of the PCP pressure wrt T1 |
---|
| 75 | ! dplcldr-output-R-derivative of the PCP pressure wrt Q1 |
---|
| 76 | ! ====================================================================== |
---|
| 77 | |
---|
| 78 | INTEGER i, l, m, itra |
---|
| 79 | INTEGER ntra ! if no tracer transport |
---|
| 80 | ! is needed, set ntra = 1 (or 0) |
---|
| 81 | REAL dtime |
---|
| 82 | |
---|
| 83 | REAL d_t2(klon, klev), d_q2(klon, klev) ! sbl |
---|
| 84 | REAL d_u2(klon, klev), d_v2(klon, klev) ! sbl |
---|
| 85 | REAL em_d_t2(klev), em_d_q2(klev) ! sbl |
---|
| 86 | REAL em_d_u2(klev), em_d_v2(klev) ! sbl |
---|
| 87 | |
---|
| 88 | REAL paprs(klon, klev + 1), pplay(klon, klev) |
---|
| 89 | REAL t(klon, klev), q(klon, klev), d_t(klon, klev), d_q(klon, klev) |
---|
| 90 | REAL u(klon, klev), v(klon, klev), tra(klon, klev, ntra) |
---|
| 91 | REAL d_u(klon, klev), d_v(klon, klev), d_tra(klon, klev, ntra) |
---|
| 92 | REAL work1(klon, klev), work2(klon, klev) |
---|
| 93 | REAL upwd(klon, klev), dnwd(klon, klev), dnwdbis(klon, klev) |
---|
| 94 | REAL rain(klon) |
---|
| 95 | REAL snow(klon) |
---|
| 96 | REAL cape(klon), tvp(klon, klev), rflag(klon) |
---|
| 97 | REAL pbase(klon), bbase(klon) |
---|
| 98 | REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev) |
---|
| 99 | REAL dplcldt(klon), dplcldr(klon) |
---|
| 100 | INTEGER kbas(klon), ktop(klon) |
---|
| 101 | |
---|
| 102 | REAL wd(klon) |
---|
| 103 | REAL qcond_incld(klon, klev) |
---|
| 104 | |
---|
| 105 | LOGICAL, SAVE :: first = .TRUE. |
---|
| 106 | !$OMP THREADPRIVATE(first) |
---|
| 107 | |
---|
| 108 | ! ym REAL em_t(klev) |
---|
| 109 | REAL, ALLOCATABLE, SAVE :: em_t(:) |
---|
| 110 | !$OMP THREADPRIVATE(em_t) |
---|
| 111 | ! ym REAL em_q(klev) |
---|
| 112 | REAL, ALLOCATABLE, SAVE :: em_q(:) |
---|
| 113 | !$OMP THREADPRIVATE(em_q) |
---|
| 114 | ! ym REAL em_qs(klev) |
---|
| 115 | REAL, ALLOCATABLE, SAVE :: em_qs(:) |
---|
| 116 | !$OMP THREADPRIVATE(em_qs) |
---|
| 117 | ! ym REAL em_u(klev), em_v(klev), em_tra(klev,nbtr) |
---|
| 118 | REAL, ALLOCATABLE, SAVE :: em_u(:), em_v(:), em_tra(:, :) |
---|
| 119 | !$OMP THREADPRIVATE(em_u,em_v,em_tra) |
---|
| 120 | ! ym REAL em_ph(klev+1), em_p(klev) |
---|
| 121 | REAL, ALLOCATABLE, SAVE :: em_ph(:), em_p(:) |
---|
| 122 | !$OMP THREADPRIVATE(em_ph,em_p) |
---|
| 123 | ! ym REAL em_work1(klev), em_work2(klev) |
---|
| 124 | REAL, ALLOCATABLE, SAVE :: em_work1(:), em_work2(:) |
---|
| 125 | !$OMP THREADPRIVATE(em_work1,em_work2) |
---|
| 126 | ! ym REAL em_precip, em_d_t(klev), em_d_q(klev) |
---|
| 127 | REAL, SAVE :: em_precip |
---|
| 128 | !$OMP THREADPRIVATE(em_precip) |
---|
| 129 | REAL, ALLOCATABLE, SAVE :: em_d_t(:), em_d_q(:) |
---|
| 130 | !$OMP THREADPRIVATE(em_d_t,em_d_q) |
---|
| 131 | ! ym REAL em_d_u(klev), em_d_v(klev), em_d_tra(klev,nbtr) |
---|
| 132 | REAL, ALLOCATABLE, SAVE :: em_d_u(:), em_d_v(:), em_d_tra(:, :) |
---|
| 133 | !$OMP THREADPRIVATE(em_d_u,em_d_v,em_d_tra) |
---|
| 134 | ! ym REAL em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev) |
---|
| 135 | REAL, ALLOCATABLE, SAVE :: em_upwd(:), em_dnwd(:), em_dnwdbis(:) |
---|
| 136 | !$OMP THREADPRIVATE(em_upwd,em_dnwd,em_dnwdbis) |
---|
| 137 | REAL em_dtvpdt1(klev), em_dtvpdq1(klev) |
---|
| 138 | REAL em_dplcldt, em_dplcldr |
---|
| 139 | ! ym SAVE em_t,em_q, em_qs, em_ph, em_p, em_work1, em_work2 |
---|
| 140 | ! ym SAVE em_u,em_v, em_tra |
---|
| 141 | ! ym SAVE em_d_u,em_d_v, em_d_tra |
---|
| 142 | ! ym SAVE em_precip, em_d_t, em_d_q, em_upwd, em_dnwd, em_dnwdbis |
---|
| 143 | |
---|
| 144 | INTEGER em_bas, em_top |
---|
| 145 | SAVE em_bas, em_top |
---|
| 146 | !$OMP THREADPRIVATE(em_bas,em_top) |
---|
| 147 | REAL em_wd |
---|
| 148 | REAL em_qcond(klev) |
---|
| 149 | REAL em_qcondc(klev) |
---|
| 150 | |
---|
| 151 | REAL zx_t, zx_qs, zdelta, zcor |
---|
| 152 | INTEGER iflag |
---|
| 153 | REAL sigsum |
---|
| 154 | ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 155 | ! VARIABLES A SORTIR |
---|
| 156 | ! ccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 157 | |
---|
| 158 | ! ym REAL emmip(klev) !variation de flux ascnon dilue i et i+1 |
---|
| 159 | REAL, ALLOCATABLE, SAVE :: emmip(:) |
---|
| 160 | !$OMP THREADPRIVATE(emmip) |
---|
| 161 | ! ym SAVE emmip |
---|
| 162 | ! ym real emMke(klev) |
---|
| 163 | REAL, ALLOCATABLE, SAVE :: emmke(:) |
---|
| 164 | !$OMP THREADPRIVATE(emMke) |
---|
| 165 | ! ym save emMke |
---|
| 166 | REAL top |
---|
| 167 | REAL bas |
---|
| 168 | ! ym real emMa(klev) |
---|
| 169 | REAL, ALLOCATABLE, SAVE :: emma(:) |
---|
| 170 | !$OMP THREADPRIVATE(emMa) |
---|
| 171 | ! ym save emMa |
---|
| 172 | REAL ma(klon, klev) |
---|
| 173 | REAL ment(klev, klev) |
---|
| 174 | REAL qent(klev, klev) |
---|
| 175 | REAL tps(klev), tls(klev) |
---|
| 176 | REAL sij(klev, klev) |
---|
| 177 | REAL em_cape, em_tvp(klev) |
---|
| 178 | REAL em_pbase, em_bbase |
---|
| 179 | INTEGER iw, j, k, ix, iy |
---|
| 180 | |
---|
| 181 | ! -- sb: pour schema nuages: |
---|
| 182 | |
---|
| 183 | INTEGER iflagcon |
---|
| 184 | INTEGER em_ifc(klev) |
---|
| 185 | |
---|
| 186 | REAL em_pradj |
---|
| 187 | REAL em_cldf(klev), em_cldq(klev) |
---|
| 188 | REAL em_ftadj(klev), em_fradj(klev) |
---|
| 189 | |
---|
| 190 | INTEGER ifc(klon, klev) |
---|
| 191 | REAL pradj(klon) |
---|
| 192 | REAL cldf(klon, klev), cldq(klon, klev) |
---|
| 193 | REAL ftadj(klon, klev), fqadj(klon, klev) |
---|
| 194 | |
---|
| 195 | IF (first) THEN |
---|
| 196 | |
---|
| 197 | ALLOCATE (em_t(klev)) |
---|
| 198 | ALLOCATE (em_q(klev)) |
---|
| 199 | ALLOCATE (em_qs(klev)) |
---|
| 200 | ALLOCATE (em_u(klev), em_v(klev), em_tra(klev, nbtr)) |
---|
| 201 | ALLOCATE (em_ph(klev + 1), em_p(klev)) |
---|
| 202 | ALLOCATE (em_work1(klev), em_work2(klev)) |
---|
| 203 | ALLOCATE (em_d_t(klev), em_d_q(klev)) |
---|
| 204 | ALLOCATE (em_d_u(klev), em_d_v(klev), em_d_tra(klev, nbtr)) |
---|
| 205 | ALLOCATE (em_upwd(klev), em_dnwd(klev), em_dnwdbis(klev)) |
---|
| 206 | ALLOCATE (emmip(klev)) |
---|
| 207 | ALLOCATE (emmke(klev)) |
---|
| 208 | ALLOCATE (emma(klev)) |
---|
| 209 | |
---|
| 210 | first = .FALSE. |
---|
| 211 | END IF |
---|
| 212 | |
---|
| 213 | qcond_incld(:, :) = 0. |
---|
| 214 | |
---|
| 215 | ! @$$ PRINT*,'debut conema' |
---|
| 216 | |
---|
| 217 | DO i = 1, klon |
---|
| 218 | DO l = 1, klev + 1 |
---|
| 219 | em_ph(l) = paprs(i, l) / 100.0 |
---|
| 220 | END DO |
---|
| 221 | |
---|
| 222 | DO l = 1, klev |
---|
| 223 | em_p(l) = pplay(i, l) / 100.0 |
---|
| 224 | em_t(l) = t(i, l) |
---|
| 225 | em_q(l) = q(i, l) |
---|
| 226 | em_u(l) = u(i, l) |
---|
| 227 | em_v(l) = v(i, l) |
---|
| 228 | DO itra = 1, ntra |
---|
| 229 | em_tra(l, itra) = tra(i, l, itra) |
---|
| 230 | END DO |
---|
| 231 | ! @$$ PRINT*,'em_t',em_t |
---|
| 232 | ! @$$ PRINT*,'em_q',em_q |
---|
| 233 | ! @$$ PRINT*,'em_qs',em_qs |
---|
| 234 | ! @$$ PRINT*,'em_u',em_u |
---|
| 235 | ! @$$ PRINT*,'em_v',em_v |
---|
| 236 | ! @$$ PRINT*,'em_tra',em_tra |
---|
| 237 | ! @$$ PRINT*,'em_p',em_p |
---|
| 238 | |
---|
| 239 | zx_t = em_t(l) |
---|
| 240 | zdelta = max(0., sign(1., rtt - zx_t)) |
---|
| 241 | zx_qs = r2es * foeew(zx_t, zdelta) / em_p(l) / 100.0 |
---|
| 242 | zx_qs = min(0.5, zx_qs) |
---|
| 243 | ! @$$ PRINT*,'zx_qs',zx_qs |
---|
| 244 | zcor = 1. / (1. - retv * zx_qs) |
---|
| 245 | zx_qs = zx_qs * zcor |
---|
| 246 | em_qs(l) = zx_qs |
---|
| 247 | ! @$$ PRINT*,'em_qs',em_qs |
---|
| 248 | |
---|
| 249 | em_work1(l) = work1(i, l) |
---|
| 250 | em_work2(l) = work2(i, l) |
---|
| 251 | emmke(l) = 0 |
---|
| 252 | ! emMa(l)=0 |
---|
| 253 | ! Ma(i,l)=0 |
---|
| 254 | |
---|
| 255 | em_dtvpdt1(l) = 0. |
---|
| 256 | em_dtvpdq1(l) = 0. |
---|
| 257 | dtvpdt1(i, l) = 0. |
---|
| 258 | dtvpdq1(i, l) = 0. |
---|
| 259 | END DO |
---|
| 260 | |
---|
| 261 | em_dplcldt = 0. |
---|
| 262 | em_dplcldr = 0. |
---|
| 263 | rain(i) = 0.0 |
---|
| 264 | snow(i) = 0.0 |
---|
| 265 | kbas(i) = 1 |
---|
| 266 | ktop(i) = 1 |
---|
| 267 | ! ajout SB: |
---|
| 268 | bas = 1 |
---|
| 269 | top = 1 |
---|
| 270 | |
---|
| 271 | |
---|
| 272 | ! sb3d WRITE(*,1792) (em_work1(m),m=1,klev) |
---|
| 273 | 1792 FORMAT ('sig avant convect ', /, 10(1X, E13.5)) |
---|
| 274 | |
---|
| 275 | ! sb d WRITE(*,1793) (em_work2(m),m=1,klev) |
---|
| 276 | 1793 FORMAT ('w avant convect ', /, 10(1X, E13.5)) |
---|
| 277 | |
---|
| 278 | ! @$$ PRINT*,'avant convect' |
---|
| 279 | ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 280 | |
---|
| 281 | |
---|
| 282 | ! PRINT*,'avant convect i=',i |
---|
| 283 | CALL convect3(dtime, epmax, ok_adj_ema, em_t, em_q, em_qs, em_u, em_v, & |
---|
| 284 | em_tra, em_p, em_ph, klev, klev + 1, klev - 1, ntra, dtime, iflag, em_d_t, & |
---|
| 285 | em_d_q, em_d_u, em_d_v, em_d_tra, em_precip, em_bas, em_top, em_upwd, & |
---|
| 286 | em_dnwd, em_dnwdbis, em_work1, em_work2, emmip, emmke, emma, ment, & |
---|
| 287 | qent, tps, tls, sij, em_cape, em_tvp, em_pbase, em_bbase, em_dtvpdt1, & |
---|
| 288 | em_dtvpdq1, em_dplcldt, em_dplcldr, & ! sbl |
---|
| 289 | em_d_t2, em_d_q2, em_d_u2, em_d_v2, em_wd, em_qcond, em_qcondc) !sbl |
---|
| 290 | ! PRINT*,'apres convect ' |
---|
| 291 | |
---|
| 292 | ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 293 | |
---|
| 294 | ! -- sb: Appel schema statistique de nuages couple a la convection |
---|
| 295 | ! (Bony et Emanuel 2001): |
---|
| 296 | |
---|
| 297 | ! -- creer cvthermo.h qui contiendra les cstes thermo de LMDZ: |
---|
| 298 | |
---|
| 299 | iflagcon = 3 |
---|
| 300 | ! CALL cv_thermo(iflagcon) |
---|
| 301 | |
---|
| 302 | ! -- appel schema de nuages: |
---|
| 303 | |
---|
| 304 | ! CALL CLOUDS_SUB_LS(klev,em_q,em_qs,em_t |
---|
| 305 | ! i ,em_p,em_ph,dtime,em_qcondc |
---|
| 306 | ! o ,em_cldf,em_cldq,em_pradj,em_ftadj,em_fradj,em_ifc) |
---|
| 307 | |
---|
| 308 | DO k = 1, klev |
---|
| 309 | cldf(i, k) = em_cldf(k) ! cloud fraction (0-1) |
---|
| 310 | cldq(i, k) = em_cldq(k) ! in-cloud water content (kg/kg) |
---|
| 311 | ftadj(i, k) = em_ftadj(k) ! (dT/dt)_{LS adj} (K/s) |
---|
| 312 | fqadj(i, k) = em_fradj(k) ! (dq/dt)_{LS adj} (kg/kg/s) |
---|
| 313 | ifc(i, k) = em_ifc(k) ! flag convergence clouds_gno (1 ou 2) |
---|
| 314 | END DO |
---|
| 315 | pradj(i) = em_pradj ! precip from LS supersat adj (mm/day) |
---|
| 316 | |
---|
| 317 | ! sb -- |
---|
| 318 | |
---|
| 319 | ! SB: |
---|
| 320 | IF (iflag/=1 .AND. iflag/=4) THEN |
---|
| 321 | em_cape = 0. |
---|
| 322 | DO l = 1, klev |
---|
| 323 | em_upwd(l) = 0. |
---|
| 324 | em_dnwd(l) = 0. |
---|
| 325 | em_dnwdbis(l) = 0. |
---|
| 326 | emma(l) = 0. |
---|
| 327 | em_tvp(l) = 0. |
---|
| 328 | END DO |
---|
| 329 | END IF |
---|
| 330 | ! fin SB |
---|
| 331 | |
---|
| 332 | ! If sig has been set to zero, then set Ma to zero |
---|
| 333 | |
---|
| 334 | sigsum = 0. |
---|
| 335 | DO k = 1, klev |
---|
| 336 | sigsum = sigsum + em_work1(k) |
---|
| 337 | END DO |
---|
| 338 | IF (sigsum==0.0) THEN |
---|
| 339 | DO k = 1, klev |
---|
| 340 | emma(k) = 0. |
---|
| 341 | END DO |
---|
| 342 | END IF |
---|
| 343 | |
---|
| 344 | ! sb3d PRINT*,'i, iflag=',i,iflag |
---|
| 345 | |
---|
| 346 | ! cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 347 | |
---|
| 348 | ! SORTIE DES ICB ET INB |
---|
| 349 | ! en fait inb et icb correspondent au niveau ou se trouve |
---|
| 350 | ! le nuage,le numero d'interface |
---|
| 351 | ! ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc |
---|
| 352 | |
---|
| 353 | ! modif SB: |
---|
| 354 | IF (iflag==1 .OR. iflag==4) THEN |
---|
| 355 | top = em_top |
---|
| 356 | bas = em_bas |
---|
| 357 | kbas(i) = em_bas |
---|
| 358 | ktop(i) = em_top |
---|
| 359 | END IF |
---|
| 360 | |
---|
| 361 | pbase(i) = em_pbase |
---|
| 362 | bbase(i) = em_bbase |
---|
| 363 | rain(i) = em_precip / 86400.0 |
---|
| 364 | snow(i) = 0.0 |
---|
| 365 | cape(i) = em_cape |
---|
| 366 | wd(i) = em_wd |
---|
| 367 | rflag(i) = real(iflag) |
---|
| 368 | ! SB kbas(i) = em_bas |
---|
| 369 | ! SB ktop(i) = em_top |
---|
| 370 | dplcldt(i) = em_dplcldt |
---|
| 371 | dplcldr(i) = em_dplcldr |
---|
| 372 | DO l = 1, klev |
---|
| 373 | d_t2(i, l) = dtime * em_d_t2(l) |
---|
| 374 | d_q2(i, l) = dtime * em_d_q2(l) |
---|
| 375 | d_u2(i, l) = dtime * em_d_u2(l) |
---|
| 376 | d_v2(i, l) = dtime * em_d_v2(l) |
---|
| 377 | |
---|
| 378 | d_t(i, l) = dtime * em_d_t(l) |
---|
| 379 | d_q(i, l) = dtime * em_d_q(l) |
---|
| 380 | d_u(i, l) = dtime * em_d_u(l) |
---|
| 381 | d_v(i, l) = dtime * em_d_v(l) |
---|
| 382 | DO itra = 1, ntra |
---|
| 383 | d_tra(i, l, itra) = dtime * em_d_tra(l, itra) |
---|
| 384 | END DO |
---|
| 385 | upwd(i, l) = em_upwd(l) |
---|
| 386 | dnwd(i, l) = em_dnwd(l) |
---|
| 387 | dnwdbis(i, l) = em_dnwdbis(l) |
---|
| 388 | work1(i, l) = em_work1(l) |
---|
| 389 | work2(i, l) = em_work2(l) |
---|
| 390 | ma(i, l) = emma(l) |
---|
| 391 | tvp(i, l) = em_tvp(l) |
---|
| 392 | dtvpdt1(i, l) = em_dtvpdt1(l) |
---|
| 393 | dtvpdq1(i, l) = em_dtvpdq1(l) |
---|
| 394 | |
---|
| 395 | IF (iflag_clw==0) THEN |
---|
| 396 | qcond_incld(i, l) = em_qcondc(l) |
---|
| 397 | ELSE IF (iflag_clw==1) THEN |
---|
| 398 | qcond_incld(i, l) = em_qcond(l) |
---|
| 399 | END IF |
---|
| 400 | END DO |
---|
| 401 | END DO |
---|
| 402 | |
---|
| 403 | ! On calcule une eau liquide diagnostique en fonction de la |
---|
| 404 | ! precip. |
---|
| 405 | IF (iflag_clw==2) THEN |
---|
| 406 | DO l = 1, klev |
---|
| 407 | DO i = 1, klon |
---|
| 408 | IF (ktop(i) - kbas(i)>0 .AND. l>=kbas(i) .AND. l<=ktop(i)) THEN |
---|
| 409 | qcond_incld(i, l) = rain(i) * 8.E4 & ! s *(pplay(i,l |
---|
| 410 | ! )-paprs(i,ktop(i)+1)) |
---|
| 411 | / (pplay(i, kbas(i)) - pplay(i, ktop(i))) |
---|
| 412 | ! s **2 |
---|
| 413 | ELSE |
---|
| 414 | qcond_incld(i, l) = 0. |
---|
| 415 | END IF |
---|
| 416 | END DO |
---|
| 417 | PRINT *, 'l=', l, ', qcond_incld=', qcond_incld(1, l) |
---|
| 418 | END DO |
---|
| 419 | END IF |
---|
| 420 | |
---|
| 421 | END SUBROUTINE conema3 |
---|
| 422 | END MODULE lmdz_conema3 |
---|
| 423 | |
---|