[1403] | 1 | ! $Id: orografi.F90 5144 2024-07-29 21:01:04Z abarral $ |
---|
[524] | 2 | |
---|
[1992] | 3 | SUBROUTINE drag_noro(nlon, nlev, dtime, paprs, pplay, pmea, pstd, psig, pgam, & |
---|
[5111] | 4 | pthe, ppic, pval, kgwd, kdx, ktest, t, u, v, pulow, pvlow, pustr, pvstr, & |
---|
| 5 | d_t, d_u, d_v) |
---|
[524] | 6 | |
---|
[1992] | 7 | USE dimphy |
---|
[5144] | 8 | USE lmdz_yomcst |
---|
| 9 | |
---|
[1992] | 10 | IMPLICIT NONE |
---|
| 11 | ! ====================================================================== |
---|
| 12 | ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201 |
---|
| 13 | ! Objet: Frottement de la montagne Interface |
---|
| 14 | ! ====================================================================== |
---|
| 15 | ! Arguments: |
---|
| 16 | ! dtime---input-R- pas d'integration (s) |
---|
| 17 | ! paprs---input-R-pression pour chaque inter-couche (en Pa) |
---|
| 18 | ! pplay---input-R-pression pour le mileu de chaque couche (en Pa) |
---|
| 19 | ! t-------input-R-temperature (K) |
---|
| 20 | ! u-------input-R-vitesse horizontale (m/s) |
---|
| 21 | ! v-------input-R-vitesse horizontale (m/s) |
---|
[524] | 22 | |
---|
[1992] | 23 | ! d_t-----output-R-increment de la temperature |
---|
| 24 | ! d_u-----output-R-increment de la vitesse u |
---|
| 25 | ! d_v-----output-R-increment de la vitesse v |
---|
| 26 | ! ====================================================================== |
---|
[524] | 27 | |
---|
[1992] | 28 | ! ARGUMENTS |
---|
[524] | 29 | |
---|
[1992] | 30 | INTEGER nlon, nlev |
---|
| 31 | REAL dtime |
---|
[5111] | 32 | REAL paprs(klon, klev + 1) |
---|
[1992] | 33 | REAL pplay(klon, klev) |
---|
| 34 | REAL pmea(nlon), pstd(nlon), psig(nlon), pgam(nlon), pthe(nlon) |
---|
| 35 | REAL ppic(nlon), pval(nlon) |
---|
| 36 | REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon) |
---|
| 37 | REAL t(nlon, nlev), u(nlon, nlev), v(nlon, nlev) |
---|
| 38 | REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev) |
---|
[524] | 39 | |
---|
[1992] | 40 | INTEGER i, k, kgwd, kdx(nlon), ktest(nlon) |
---|
[524] | 41 | |
---|
[1992] | 42 | ! Variables locales: |
---|
[524] | 43 | |
---|
[1992] | 44 | REAL zgeom(klon, klev) |
---|
| 45 | REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev) |
---|
| 46 | REAL pt(klon, klev), pu(klon, klev), pv(klon, klev) |
---|
[5111] | 47 | REAL papmf(klon, klev), papmh(klon, klev + 1) |
---|
[524] | 48 | |
---|
[1992] | 49 | ! initialiser les variables de sortie (pour securite) |
---|
[524] | 50 | |
---|
[1992] | 51 | DO i = 1, klon |
---|
| 52 | pulow(i) = 0.0 |
---|
| 53 | pvlow(i) = 0.0 |
---|
| 54 | pustr(i) = 0.0 |
---|
| 55 | pvstr(i) = 0.0 |
---|
| 56 | END DO |
---|
| 57 | DO k = 1, klev |
---|
| 58 | DO i = 1, klon |
---|
| 59 | d_t(i, k) = 0.0 |
---|
| 60 | d_u(i, k) = 0.0 |
---|
| 61 | d_v(i, k) = 0.0 |
---|
| 62 | pdudt(i, k) = 0.0 |
---|
| 63 | pdvdt(i, k) = 0.0 |
---|
| 64 | pdtdt(i, k) = 0.0 |
---|
| 65 | END DO |
---|
| 66 | END DO |
---|
[524] | 67 | |
---|
[1992] | 68 | ! preparer les variables d'entree (attention: l'ordre des niveaux |
---|
| 69 | ! verticaux augmente du haut vers le bas) |
---|
[524] | 70 | |
---|
[1992] | 71 | DO k = 1, klev |
---|
| 72 | DO i = 1, klon |
---|
[5111] | 73 | pt(i, k) = t(i, klev - k + 1) |
---|
| 74 | pu(i, k) = u(i, klev - k + 1) |
---|
| 75 | pv(i, k) = v(i, klev - k + 1) |
---|
| 76 | papmf(i, k) = pplay(i, klev - k + 1) |
---|
[1992] | 77 | END DO |
---|
| 78 | END DO |
---|
| 79 | DO k = 1, klev + 1 |
---|
| 80 | DO i = 1, klon |
---|
[5111] | 81 | papmh(i, k) = paprs(i, klev - k + 2) |
---|
[1992] | 82 | END DO |
---|
| 83 | END DO |
---|
| 84 | DO i = 1, klon |
---|
[5111] | 85 | zgeom(i, klev) = rd * pt(i, klev) * log(papmh(i, klev + 1) / papmf(i, klev)) |
---|
[1992] | 86 | END DO |
---|
| 87 | DO k = klev - 1, 1, -1 |
---|
| 88 | DO i = 1, klon |
---|
[5111] | 89 | zgeom(i, k) = zgeom(i, k + 1) + rd * (pt(i, k) + pt(i, k + 1)) / 2.0 * log(papmf(i, k + & |
---|
| 90 | 1) / papmf(i, k)) |
---|
[1992] | 91 | END DO |
---|
| 92 | END DO |
---|
[524] | 93 | |
---|
[1992] | 94 | ! appeler la routine principale |
---|
[524] | 95 | |
---|
[1992] | 96 | CALL orodrag(klon, klev, kgwd, kdx, ktest, dtime, papmh, papmf, zgeom, pt, & |
---|
[5111] | 97 | pu, pv, pmea, pstd, psig, pgam, pthe, ppic, pval, pulow, pvlow, pdudt, & |
---|
| 98 | pdvdt, pdtdt) |
---|
[524] | 99 | |
---|
[1992] | 100 | DO k = 1, klev |
---|
| 101 | DO i = 1, klon |
---|
[5111] | 102 | d_u(i, klev + 1 - k) = dtime * pdudt(i, k) |
---|
| 103 | d_v(i, klev + 1 - k) = dtime * pdvdt(i, k) |
---|
| 104 | d_t(i, klev + 1 - k) = dtime * pdtdt(i, k) |
---|
[1992] | 105 | pustr(i) = pustr(i) & ! IM BUG . |
---|
[5111] | 106 | ! +rg*pdudt(i,k)*(papmh(i,k+1)-papmh(i,k)) |
---|
| 107 | + pdudt(i, k) * (papmh(i, k + 1) - papmh(i, k)) / rg |
---|
[1992] | 108 | pvstr(i) = pvstr(i) & ! IM BUG . |
---|
[5111] | 109 | ! +rg*pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k)) |
---|
| 110 | + pdvdt(i, k) * (papmh(i, k + 1) - papmh(i, k)) / rg |
---|
[1992] | 111 | END DO |
---|
| 112 | END DO |
---|
[524] | 113 | |
---|
[1992] | 114 | END SUBROUTINE drag_noro |
---|
| 115 | SUBROUTINE orodrag(nlon, nlev, kgwd, kdx, ktest, ptsphy, paphm1, papm1, & |
---|
[5111] | 116 | pgeom1, ptm1, pum1, pvm1, pmea, pstd, psig, pgamma, ptheta, ppic, pval & |
---|
| 117 | ! outputs |
---|
| 118 | , pulow, pvlow, pvom, pvol, pte) |
---|
[524] | 119 | |
---|
[1992] | 120 | USE dimphy |
---|
[5143] | 121 | USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, & |
---|
| 122 | GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat |
---|
| 123 | USE lmdz_libmath, ONLY: ismax, ismin |
---|
[5144] | 124 | USE lmdz_yomcst |
---|
[5143] | 125 | |
---|
[1992] | 126 | IMPLICIT NONE |
---|
[524] | 127 | |
---|
| 128 | |
---|
| 129 | |
---|
[1992] | 130 | ! **** *gwdrag* - does the gravity wave parametrization. |
---|
[524] | 131 | |
---|
[1992] | 132 | ! purpose. |
---|
| 133 | ! -------- |
---|
[524] | 134 | |
---|
[1992] | 135 | ! this routine computes the physical tendencies of the |
---|
| 136 | ! prognostic variables u,v and t due to vertical transports by |
---|
| 137 | ! subgridscale orographically excited gravity waves |
---|
[524] | 138 | |
---|
[1992] | 139 | ! ** interface. |
---|
| 140 | ! ---------- |
---|
| 141 | ! called from *callpar*. |
---|
[524] | 142 | |
---|
[1992] | 143 | ! the routine takes its input from the long-term storage: |
---|
| 144 | ! u,v,t and p at t-1. |
---|
[524] | 145 | |
---|
[1992] | 146 | ! explicit arguments : |
---|
| 147 | ! -------------------- |
---|
| 148 | ! ==== inputs === |
---|
| 149 | ! ==== outputs === |
---|
[524] | 150 | |
---|
[1992] | 151 | ! implicit arguments : none |
---|
| 152 | ! -------------------- |
---|
[524] | 153 | |
---|
[5117] | 154 | ! implicit LOGICAL (l) |
---|
[524] | 155 | |
---|
[1992] | 156 | ! author. |
---|
| 157 | ! ------- |
---|
| 158 | ! m.miller + b.ritter e.c.m.w.f. 15/06/86. |
---|
[524] | 159 | |
---|
[1992] | 160 | ! f.lott + m. miller e.c.m.w.f. 22/11/94 |
---|
| 161 | ! ----------------------------------------------------------------------- |
---|
[524] | 162 | |
---|
[1992] | 163 | ! * 0.1 arguments |
---|
| 164 | ! --------- |
---|
[524] | 165 | |
---|
| 166 | |
---|
[1992] | 167 | ! ym integer nlon, nlev, klevm1 |
---|
| 168 | INTEGER nlon, nlev |
---|
| 169 | INTEGER kgwd, jl, ilevp1, jk, ji |
---|
| 170 | REAL zdelp, ztemp, zforc, ztend |
---|
| 171 | REAL rover, zb, zc, zconb, zabsv |
---|
| 172 | REAL zzd1, ratio, zbet, zust, zvst, zdis |
---|
| 173 | REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(klon), & |
---|
[5111] | 174 | pvlow(klon) |
---|
[1992] | 175 | REAL pum1(nlon, nlev), pvm1(nlon, nlev), ptm1(nlon, nlev), pmea(nlon), & |
---|
[5111] | 176 | pstd(nlon), psig(nlon), pgamma(nlon), ptheta(nlon), ppic(nlon), & |
---|
| 177 | pval(nlon), pgeom1(nlon, nlev), papm1(nlon, nlev), paphm1(nlon, nlev + 1) |
---|
[524] | 178 | |
---|
[1992] | 179 | INTEGER kdx(nlon), ktest(nlon) |
---|
| 180 | ! ----------------------------------------------------------------------- |
---|
[524] | 181 | |
---|
[1992] | 182 | ! * 0.2 local arrays |
---|
| 183 | ! ------------ |
---|
| 184 | INTEGER isect(klon), icrit(klon), ikcrith(klon), ikenvh(klon), iknu(klon), & |
---|
[5111] | 185 | iknu2(klon), ikcrit(klon), ikhlim(klon) |
---|
[524] | 186 | |
---|
[5111] | 187 | REAL ztau(klon, klev + 1), ztauf(klon, klev + 1), zstab(klon, klev + 1), & |
---|
| 188 | zvph(klon, klev + 1), zrho(klon, klev + 1), zri(klon, klev + 1), & |
---|
| 189 | zpsi(klon, klev + 1), zzdep(klon, klev) |
---|
[1992] | 190 | REAL zdudt(klon), zdvdt(klon), zdtdt(klon), zdedt(klon), zvidis(klon), & |
---|
[5111] | 191 | znu(klon), zd1(klon), zd2(klon), zdmod(klon) |
---|
[1992] | 192 | REAL ztmst, ptsphy, zrtmst |
---|
[524] | 193 | |
---|
[1992] | 194 | ! ------------------------------------------------------------------ |
---|
[524] | 195 | |
---|
[1992] | 196 | ! * 1. initialization |
---|
| 197 | ! -------------- |
---|
[524] | 198 | |
---|
| 199 | |
---|
[1992] | 200 | ! ------------------------------------------------------------------ |
---|
[524] | 201 | |
---|
[1992] | 202 | ! * 1.1 computational constants |
---|
| 203 | ! ----------------------- |
---|
[524] | 204 | |
---|
| 205 | |
---|
[1992] | 206 | ! ztmst=twodt |
---|
[5117] | 207 | ! IF(nstep.EQ.nstart) ztmst=0.5*twodt |
---|
[1992] | 208 | ! ym klevm1=klev-1 |
---|
| 209 | ztmst = ptsphy |
---|
[5111] | 210 | zrtmst = 1. / ztmst |
---|
[524] | 211 | |
---|
[1992] | 212 | ! ------------------------------------------------------------------ |
---|
[524] | 213 | |
---|
[1992] | 214 | ! * 1.3 check whether row contains point for printing |
---|
| 215 | ! --------------------------------------------- |
---|
[524] | 216 | |
---|
| 217 | |
---|
[1992] | 218 | ! ------------------------------------------------------------------ |
---|
[524] | 219 | |
---|
[1992] | 220 | ! * 2. precompute basic state variables. |
---|
| 221 | ! * ---------- ----- ----- ---------- |
---|
| 222 | ! * define low level wind, project winds in plane of |
---|
| 223 | ! * low level wind, determine sector in which to take |
---|
| 224 | ! * the variance and set indicator for critical levels. |
---|
[524] | 225 | |
---|
[1992] | 226 | CALL orosetup(nlon, ktest, ikcrit, ikcrith, icrit, ikenvh, iknu, iknu2, & |
---|
[5111] | 227 | paphm1, papm1, pum1, pvm1, ptm1, pgeom1, pstd, zrho, zri, zstab, ztau, & |
---|
| 228 | zvph, zpsi, zzdep, pulow, pvlow, ptheta, pgamma, pmea, ppic, pval, znu, & |
---|
| 229 | zd1, zd2, zdmod) |
---|
[524] | 230 | |
---|
[1992] | 231 | ! *********************************************************** |
---|
[524] | 232 | |
---|
| 233 | |
---|
[1992] | 234 | ! * 3. compute low level stresses using subcritical and |
---|
| 235 | ! * supercritical forms.computes anisotropy coefficient |
---|
| 236 | ! * as measure of orographic twodimensionality. |
---|
[524] | 237 | |
---|
[1992] | 238 | CALL gwstress(nlon, nlev, ktest, icrit, ikenvh, iknu, zrho, zstab, zvph, & |
---|
[5111] | 239 | pstd, psig, pmea, ppic, ztau, pgeom1, zdmod) |
---|
[1992] | 240 | |
---|
| 241 | ! * 4. compute stress profile. |
---|
| 242 | ! * ------- ------ -------- |
---|
| 243 | |
---|
| 244 | CALL gwprofil(nlon, nlev, kgwd, kdx, ktest, ikcrith, icrit, paphm1, zrho, & |
---|
[5111] | 245 | zstab, zvph, zri, ztau, zdmod, psig, pstd) |
---|
[1992] | 246 | |
---|
| 247 | ! * 5. compute tendencies. |
---|
| 248 | ! * ------------------- |
---|
| 249 | |
---|
| 250 | |
---|
| 251 | ! explicit solution at all levels for the gravity wave |
---|
| 252 | ! implicit solution for the blocked levels |
---|
| 253 | |
---|
| 254 | DO jl = kidia, kfdia |
---|
| 255 | zvidis(jl) = 0.0 |
---|
| 256 | zdudt(jl) = 0.0 |
---|
| 257 | zdvdt(jl) = 0.0 |
---|
| 258 | zdtdt(jl) = 0.0 |
---|
| 259 | END DO |
---|
| 260 | |
---|
| 261 | ilevp1 = klev + 1 |
---|
| 262 | |
---|
| 263 | DO jk = 1, klev |
---|
| 264 | |
---|
| 265 | |
---|
| 266 | ! do 523 jl=1,kgwd |
---|
| 267 | ! ji=kdx(jl) |
---|
| 268 | ! Modif vectorisation 02/04/2004 |
---|
| 269 | DO ji = kidia, kfdia |
---|
| 270 | IF (ktest(ji)==1) THEN |
---|
| 271 | |
---|
[5111] | 272 | zdelp = paphm1(ji, jk + 1) - paphm1(ji, jk) |
---|
| 273 | ztemp = -rg * (ztau(ji, jk + 1) - ztau(ji, jk)) / (zvph(ji, ilevp1) * zdelp) |
---|
| 274 | zdudt(ji) = (pulow(ji) * zd1(ji) - pvlow(ji) * zd2(ji)) * ztemp / zdmod(ji) |
---|
| 275 | zdvdt(ji) = (pvlow(ji) * zd1(ji) + pulow(ji) * zd2(ji)) * ztemp / zdmod(ji) |
---|
[1992] | 276 | |
---|
| 277 | ! controle des overshoots: |
---|
| 278 | |
---|
[5111] | 279 | zforc = sqrt(zdudt(ji)**2 + zdvdt(ji)**2) + 1.E-12 |
---|
| 280 | ztend = sqrt(pum1(ji, jk)**2 + pvm1(ji, jk)**2) / ztmst + 1.E-12 |
---|
[1992] | 281 | rover = 0.25 |
---|
[5111] | 282 | IF (zforc>=rover * ztend) THEN |
---|
| 283 | zdudt(ji) = rover * ztend / zforc * zdudt(ji) |
---|
| 284 | zdvdt(ji) = rover * ztend / zforc * zdvdt(ji) |
---|
[1992] | 285 | END IF |
---|
| 286 | |
---|
| 287 | ! fin du controle des overshoots |
---|
| 288 | |
---|
| 289 | IF (jk>=ikenvh(ji)) THEN |
---|
[5111] | 290 | zb = 1.0 - 0.18 * pgamma(ji) - 0.04 * pgamma(ji)**2 |
---|
| 291 | zc = 0.48 * pgamma(ji) + 0.3 * pgamma(ji)**2 |
---|
| 292 | zconb = 2. * ztmst * gkwake * psig(ji) / (4. * pstd(ji)) |
---|
| 293 | zabsv = sqrt(pum1(ji, jk)**2 + pvm1(ji, jk)**2) / 2. |
---|
| 294 | zzd1 = zb * cos(zpsi(ji, jk))**2 + zc * sin(zpsi(ji, jk))**2 |
---|
| 295 | ratio = (cos(zpsi(ji, jk))**2 + pgamma(ji) * sin(zpsi(ji, & |
---|
| 296 | jk))**2) / (pgamma(ji) * cos(zpsi(ji, jk))**2 + sin(zpsi(ji, jk))**2) |
---|
| 297 | zbet = max(0., 2. - 1. / ratio) * zconb * zzdep(ji, jk) * zzd1 * zabsv |
---|
[1992] | 298 | |
---|
| 299 | ! simplement oppose au vent |
---|
| 300 | |
---|
[5111] | 301 | zdudt(ji) = -pum1(ji, jk) / ztmst |
---|
| 302 | zdvdt(ji) = -pvm1(ji, jk) / ztmst |
---|
[1992] | 303 | |
---|
| 304 | ! projection dans la direction de l'axe principal de l'orographie |
---|
| 305 | ! mod zdudt(ji)=-(pum1(ji,jk)*cos(ptheta(ji)*rpi/180.) |
---|
| 306 | ! mod * +pvm1(ji,jk)*sin(ptheta(ji)*rpi/180.)) |
---|
| 307 | ! mod * *cos(ptheta(ji)*rpi/180.)/ztmst |
---|
| 308 | ! mod zdvdt(ji)=-(pum1(ji,jk)*cos(ptheta(ji)*rpi/180.) |
---|
| 309 | ! mod * +pvm1(ji,jk)*sin(ptheta(ji)*rpi/180.)) |
---|
| 310 | ! mod * *sin(ptheta(ji)*rpi/180.)/ztmst |
---|
[5111] | 311 | zdudt(ji) = zdudt(ji) * (zbet / (1. + zbet)) |
---|
| 312 | zdvdt(ji) = zdvdt(ji) * (zbet / (1. + zbet)) |
---|
[1992] | 313 | END IF |
---|
| 314 | pvom(ji, jk) = zdudt(ji) |
---|
| 315 | pvol(ji, jk) = zdvdt(ji) |
---|
[5111] | 316 | zust = pum1(ji, jk) + ztmst * zdudt(ji) |
---|
| 317 | zvst = pvm1(ji, jk) + ztmst * zdvdt(ji) |
---|
| 318 | zdis = 0.5 * (pum1(ji, jk)**2 + pvm1(ji, jk)**2 - zust**2 - zvst**2) |
---|
| 319 | zdedt(ji) = zdis / ztmst |
---|
| 320 | zvidis(ji) = zvidis(ji) + zdis * zdelp |
---|
| 321 | zdtdt(ji) = zdedt(ji) / rcpd |
---|
[1992] | 322 | ! pte(ji,jk)=zdtdt(ji) |
---|
| 323 | |
---|
| 324 | ! ENCORE UN TRUC POUR EVITER LES EXPLOSIONS |
---|
| 325 | |
---|
| 326 | pte(ji, jk) = 0.0 |
---|
| 327 | |
---|
| 328 | END IF |
---|
| 329 | END DO |
---|
| 330 | |
---|
| 331 | END DO |
---|
| 332 | |
---|
| 333 | END SUBROUTINE orodrag |
---|
| 334 | SUBROUTINE orosetup(nlon, ktest, kkcrit, kkcrith, kcrit, kkenvh, kknu, kknu2, & |
---|
[5111] | 335 | paphm1, papm1, pum1, pvm1, ptm1, pgeom1, pstd, prho, pri, pstab, ptau, & |
---|
| 336 | pvph, ppsi, pzdep, pulow, pvlow, ptheta, pgamma, pmea, ppic, pval, pnu, & |
---|
| 337 | pd1, pd2, pdmod) |
---|
[1992] | 338 | |
---|
| 339 | ! **** *gwsetup* |
---|
| 340 | |
---|
| 341 | ! purpose. |
---|
| 342 | ! -------- |
---|
| 343 | |
---|
| 344 | ! ** interface. |
---|
| 345 | ! ---------- |
---|
| 346 | ! from *orodrag* |
---|
| 347 | |
---|
| 348 | ! explicit arguments : |
---|
| 349 | ! -------------------- |
---|
| 350 | ! ==== inputs === |
---|
| 351 | ! ==== outputs === |
---|
| 352 | |
---|
| 353 | ! implicit arguments : none |
---|
| 354 | ! -------------------- |
---|
| 355 | |
---|
| 356 | ! method. |
---|
| 357 | ! ------- |
---|
| 358 | |
---|
| 359 | |
---|
| 360 | ! externals. |
---|
| 361 | ! ---------- |
---|
| 362 | |
---|
| 363 | |
---|
| 364 | ! reference. |
---|
| 365 | ! ---------- |
---|
| 366 | |
---|
| 367 | ! see ecmwf research department documentation of the "i.f.s." |
---|
| 368 | |
---|
| 369 | ! author. |
---|
| 370 | ! ------- |
---|
| 371 | |
---|
| 372 | ! modifications. |
---|
| 373 | ! -------------- |
---|
| 374 | ! f.lott for the new-gwdrag scheme november 1993 |
---|
| 375 | |
---|
| 376 | ! ----------------------------------------------------------------------- |
---|
| 377 | USE dimphy |
---|
[5143] | 378 | USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, & |
---|
| 379 | GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat |
---|
[5144] | 380 | USE lmdz_yomcst |
---|
[5143] | 381 | |
---|
[1992] | 382 | IMPLICIT NONE |
---|
| 383 | |
---|
| 384 | ! ----------------------------------------------------------------------- |
---|
| 385 | |
---|
| 386 | ! * 0.1 arguments |
---|
| 387 | ! --------- |
---|
| 388 | |
---|
| 389 | INTEGER nlon |
---|
| 390 | INTEGER jl, jk |
---|
| 391 | REAL zdelp |
---|
| 392 | |
---|
| 393 | INTEGER kkcrit(nlon), kkcrith(nlon), kcrit(nlon), ktest(nlon), kkenvh(nlon) |
---|
| 394 | |
---|
[5111] | 395 | REAL paphm1(nlon, klev + 1), papm1(nlon, klev), pum1(nlon, klev), & |
---|
| 396 | pvm1(nlon, klev), ptm1(nlon, klev), pgeom1(nlon, klev), & |
---|
| 397 | prho(nlon, klev + 1), pri(nlon, klev + 1), pstab(nlon, klev + 1), & |
---|
| 398 | ptau(nlon, klev + 1), pvph(nlon, klev + 1), ppsi(nlon, klev + 1), & |
---|
| 399 | pzdep(nlon, klev) |
---|
[1992] | 400 | REAL pulow(nlon), pvlow(nlon), ptheta(nlon), pgamma(nlon), pnu(nlon), & |
---|
[5111] | 401 | pd1(nlon), pd2(nlon), pdmod(nlon) |
---|
[1992] | 402 | REAL pstd(nlon), pmea(nlon), ppic(nlon), pval(nlon) |
---|
| 403 | |
---|
| 404 | ! ----------------------------------------------------------------------- |
---|
| 405 | |
---|
| 406 | ! * 0.2 local arrays |
---|
| 407 | ! ------------ |
---|
| 408 | |
---|
| 409 | INTEGER ilevm1, ilevm2, ilevh |
---|
| 410 | REAL zcons1, zcons2, zcons3, zhgeo |
---|
| 411 | REAL zu, zphi, zvt1, zvt2, zst, zvar, zdwind, zwind |
---|
| 412 | REAL zstabm, zstabp, zrhom, zrhop, alpha |
---|
| 413 | REAL zggeenv, zggeom1, zgvar |
---|
| 414 | LOGICAL lo |
---|
[5111] | 415 | LOGICAL ll1(klon, klev + 1) |
---|
[1992] | 416 | INTEGER kknu(klon), kknu2(klon), kknub(klon), kknul(klon), kentp(klon), & |
---|
[5111] | 417 | ncount(klon) |
---|
[1992] | 418 | |
---|
| 419 | REAL zhcrit(klon, klev), zvpf(klon, klev), zdp(klon, klev) |
---|
| 420 | REAL znorm(klon), zb(klon), zc(klon), zulow(klon), zvlow(klon), znup(klon), & |
---|
[5111] | 421 | znum(klon) |
---|
[1992] | 422 | |
---|
| 423 | ! ------------------------------------------------------------------ |
---|
| 424 | |
---|
| 425 | ! * 1. initialization |
---|
| 426 | ! -------------- |
---|
| 427 | |
---|
| 428 | ! print *,' entree gwsetup' |
---|
| 429 | |
---|
| 430 | ! ------------------------------------------------------------------ |
---|
| 431 | |
---|
| 432 | ! * 1.1 computational constants |
---|
| 433 | ! ----------------------- |
---|
| 434 | |
---|
| 435 | ilevm1 = klev - 1 |
---|
| 436 | ilevm2 = klev - 2 |
---|
[5111] | 437 | ilevh = klev / 3 |
---|
[1992] | 438 | |
---|
[5111] | 439 | zcons1 = 1. / rd |
---|
[1992] | 440 | ! old zcons2=g**2/cpd |
---|
[5111] | 441 | zcons2 = rg**2 / rcpd |
---|
[1992] | 442 | ! old zcons3=1.5*api |
---|
[5111] | 443 | zcons3 = 1.5 * rpi |
---|
[1992] | 444 | |
---|
| 445 | ! ------------------------------------------------------------------ |
---|
| 446 | |
---|
| 447 | ! * 2. |
---|
| 448 | ! -------------- |
---|
| 449 | |
---|
| 450 | |
---|
| 451 | ! ------------------------------------------------------------------ |
---|
| 452 | |
---|
| 453 | ! * 2.1 define low level wind, project winds in plane of |
---|
| 454 | ! * low level wind, determine sector in which to take |
---|
| 455 | ! * the variance and set indicator for critical levels. |
---|
| 456 | |
---|
| 457 | DO jl = kidia, kfdia |
---|
| 458 | kknu(jl) = klev |
---|
| 459 | kknu2(jl) = klev |
---|
| 460 | kknub(jl) = klev |
---|
| 461 | kknul(jl) = klev |
---|
| 462 | pgamma(jl) = max(pgamma(jl), gtsec) |
---|
[5111] | 463 | ll1(jl, klev + 1) = .FALSE. |
---|
[1992] | 464 | END DO |
---|
| 465 | |
---|
| 466 | ! Ajouter une initialisation (L. Li, le 23fev99): |
---|
| 467 | |
---|
| 468 | DO jk = klev, ilevh, -1 |
---|
| 469 | DO jl = kidia, kfdia |
---|
| 470 | ll1(jl, jk) = .FALSE. |
---|
| 471 | END DO |
---|
| 472 | END DO |
---|
| 473 | |
---|
| 474 | ! * define top of low level flow |
---|
| 475 | ! ---------------------------- |
---|
| 476 | DO jk = klev, ilevh, -1 |
---|
| 477 | DO jl = kidia, kfdia |
---|
[5111] | 478 | lo = (paphm1(jl, jk) / paphm1(jl, klev + 1)) >= gsigcr |
---|
[1992] | 479 | IF (lo) THEN |
---|
| 480 | kkcrit(jl) = jk |
---|
| 481 | END IF |
---|
| 482 | zhcrit(jl, jk) = ppic(jl) |
---|
[5111] | 483 | zhgeo = pgeom1(jl, jk) / rg |
---|
| 484 | ll1(jl, jk) = (zhgeo>zhcrit(jl, jk)) |
---|
| 485 | IF (ll1(jl, jk) .NEQV. ll1(jl, jk + 1)) THEN |
---|
[1992] | 486 | kknu(jl) = jk |
---|
| 487 | END IF |
---|
[5111] | 488 | IF (.NOT. ll1(jl, ilevh)) kknu(jl) = ilevh |
---|
[1992] | 489 | END DO |
---|
| 490 | END DO |
---|
| 491 | DO jk = klev, ilevh, -1 |
---|
| 492 | DO jl = kidia, kfdia |
---|
| 493 | zhcrit(jl, jk) = ppic(jl) - pval(jl) |
---|
[5111] | 494 | zhgeo = pgeom1(jl, jk) / rg |
---|
| 495 | ll1(jl, jk) = (zhgeo>zhcrit(jl, jk)) |
---|
| 496 | IF (ll1(jl, jk) .NEQV. ll1(jl, jk + 1)) THEN |
---|
[1992] | 497 | kknu2(jl) = jk |
---|
| 498 | END IF |
---|
[5111] | 499 | IF (.NOT. ll1(jl, ilevh)) kknu2(jl) = ilevh |
---|
[1992] | 500 | END DO |
---|
| 501 | END DO |
---|
| 502 | DO jk = klev, ilevh, -1 |
---|
| 503 | DO jl = kidia, kfdia |
---|
[5111] | 504 | zhcrit(jl, jk) = amax1(ppic(jl) - pmea(jl), pmea(jl) - pval(jl)) |
---|
| 505 | zhgeo = pgeom1(jl, jk) / rg |
---|
| 506 | ll1(jl, jk) = (zhgeo>zhcrit(jl, jk)) |
---|
| 507 | IF (ll1(jl, jk) .NEQV. ll1(jl, jk + 1)) THEN |
---|
[1992] | 508 | kknub(jl) = jk |
---|
| 509 | END IF |
---|
[5111] | 510 | IF (.NOT. ll1(jl, ilevh)) kknub(jl) = ilevh |
---|
[1992] | 511 | END DO |
---|
| 512 | END DO |
---|
| 513 | |
---|
| 514 | DO jl = kidia, kfdia |
---|
| 515 | kknu(jl) = min(kknu(jl), nktopg) |
---|
| 516 | kknu2(jl) = min(kknu2(jl), nktopg) |
---|
| 517 | kknub(jl) = min(kknub(jl), nktopg) |
---|
| 518 | kknul(jl) = klev |
---|
| 519 | END DO |
---|
| 520 | |
---|
| 521 | ! c* initialize various arrays |
---|
| 522 | |
---|
| 523 | DO jl = kidia, kfdia |
---|
[5111] | 524 | prho(jl, klev + 1) = 0.0 |
---|
| 525 | pstab(jl, klev + 1) = 0.0 |
---|
[1992] | 526 | pstab(jl, 1) = 0.0 |
---|
[5111] | 527 | pri(jl, klev + 1) = 9999.0 |
---|
| 528 | ppsi(jl, klev + 1) = 0.0 |
---|
[1992] | 529 | pri(jl, 1) = 0.0 |
---|
| 530 | pvph(jl, 1) = 0.0 |
---|
| 531 | pulow(jl) = 0.0 |
---|
| 532 | pvlow(jl) = 0.0 |
---|
| 533 | zulow(jl) = 0.0 |
---|
| 534 | zvlow(jl) = 0.0 |
---|
| 535 | kkcrith(jl) = klev |
---|
| 536 | kkenvh(jl) = klev |
---|
| 537 | kentp(jl) = klev |
---|
| 538 | kcrit(jl) = 1 |
---|
| 539 | ncount(jl) = 0 |
---|
[5111] | 540 | ll1(jl, klev + 1) = .FALSE. |
---|
[1992] | 541 | END DO |
---|
| 542 | |
---|
| 543 | ! * define low-level flow |
---|
| 544 | ! --------------------- |
---|
| 545 | |
---|
| 546 | DO jk = klev, 2, -1 |
---|
| 547 | DO jl = kidia, kfdia |
---|
| 548 | IF (ktest(jl)==1) THEN |
---|
[5111] | 549 | zdp(jl, jk) = papm1(jl, jk) - papm1(jl, jk - 1) |
---|
| 550 | prho(jl, jk) = 2. * paphm1(jl, jk) * zcons1 / (ptm1(jl, jk) + ptm1(jl, jk - 1)) |
---|
| 551 | pstab(jl, jk) = 2. * zcons2 / (ptm1(jl, jk) + ptm1(jl, jk - 1)) * & |
---|
| 552 | (1. - rcpd * prho(jl, jk) * (ptm1(jl, jk) - ptm1(jl, jk - 1)) / zdp(jl, jk)) |
---|
| 553 | pstab(jl, jk) = max(pstab(jl, jk), gssec) |
---|
[1992] | 554 | END IF |
---|
| 555 | END DO |
---|
| 556 | END DO |
---|
| 557 | |
---|
| 558 | ! ******************************************************************** |
---|
| 559 | |
---|
| 560 | ! * define blocked flow |
---|
| 561 | ! ------------------- |
---|
| 562 | DO jk = klev, ilevh, -1 |
---|
| 563 | DO jl = kidia, kfdia |
---|
| 564 | IF (jk>=kknub(jl) .AND. jk<=kknul(jl)) THEN |
---|
[5111] | 565 | pulow(jl) = pulow(jl) + pum1(jl, jk) * (paphm1(jl, jk + 1) - paphm1(jl, jk)) |
---|
| 566 | pvlow(jl) = pvlow(jl) + pvm1(jl, jk) * (paphm1(jl, jk + 1) - paphm1(jl, jk)) |
---|
[1992] | 567 | END IF |
---|
| 568 | END DO |
---|
| 569 | END DO |
---|
| 570 | DO jl = kidia, kfdia |
---|
[5111] | 571 | pulow(jl) = pulow(jl) / (paphm1(jl, kknul(jl) + 1) - paphm1(jl, kknub(jl))) |
---|
| 572 | pvlow(jl) = pvlow(jl) / (paphm1(jl, kknul(jl) + 1) - paphm1(jl, kknub(jl))) |
---|
| 573 | znorm(jl) = max(sqrt(pulow(jl)**2 + pvlow(jl)**2), gvsec) |
---|
| 574 | pvph(jl, klev + 1) = znorm(jl) |
---|
[1992] | 575 | END DO |
---|
| 576 | |
---|
| 577 | ! ******* setup orography axes and define plane of profiles ******* |
---|
| 578 | |
---|
| 579 | DO jl = kidia, kfdia |
---|
| 580 | lo = (pulow(jl)<gvsec) .AND. (pulow(jl)>=-gvsec) |
---|
| 581 | IF (lo) THEN |
---|
[5111] | 582 | zu = pulow(jl) + 2. * gvsec |
---|
[1992] | 583 | ELSE |
---|
| 584 | zu = pulow(jl) |
---|
| 585 | END IF |
---|
[5111] | 586 | zphi = atan(pvlow(jl) / zu) |
---|
| 587 | ppsi(jl, klev + 1) = ptheta(jl) * rpi / 180. - zphi |
---|
| 588 | zb(jl) = 1. - 0.18 * pgamma(jl) - 0.04 * pgamma(jl)**2 |
---|
| 589 | zc(jl) = 0.48 * pgamma(jl) + 0.3 * pgamma(jl)**2 |
---|
| 590 | pd1(jl) = zb(jl) - (zb(jl) - zc(jl)) * (sin(ppsi(jl, klev + 1))**2) |
---|
| 591 | pd2(jl) = (zb(jl) - zc(jl)) * sin(ppsi(jl, klev + 1)) * cos(ppsi(jl, klev + 1)) |
---|
| 592 | pdmod(jl) = sqrt(pd1(jl)**2 + pd2(jl)**2) |
---|
[1992] | 593 | END DO |
---|
| 594 | |
---|
| 595 | ! ************ define flow in plane of lowlevel stress ************* |
---|
| 596 | |
---|
| 597 | DO jk = 1, klev |
---|
| 598 | DO jl = kidia, kfdia |
---|
| 599 | IF (ktest(jl)==1) THEN |
---|
[5111] | 600 | zvt1 = pulow(jl) * pum1(jl, jk) + pvlow(jl) * pvm1(jl, jk) |
---|
| 601 | zvt2 = -pvlow(jl) * pum1(jl, jk) + pulow(jl) * pvm1(jl, jk) |
---|
| 602 | zvpf(jl, jk) = (zvt1 * pd1(jl) + zvt2 * pd2(jl)) / (znorm(jl) * pdmod(jl)) |
---|
[1992] | 603 | END IF |
---|
| 604 | ptau(jl, jk) = 0.0 |
---|
| 605 | pzdep(jl, jk) = 0.0 |
---|
| 606 | ppsi(jl, jk) = 0.0 |
---|
| 607 | ll1(jl, jk) = .FALSE. |
---|
| 608 | END DO |
---|
| 609 | END DO |
---|
| 610 | DO jk = 2, klev |
---|
| 611 | DO jl = kidia, kfdia |
---|
| 612 | IF (ktest(jl)==1) THEN |
---|
[5111] | 613 | zdp(jl, jk) = papm1(jl, jk) - papm1(jl, jk - 1) |
---|
| 614 | pvph(jl, jk) = ((paphm1(jl, jk) - papm1(jl, jk - 1)) * zvpf(jl, jk) + (papm1(jl, & |
---|
| 615 | jk) - paphm1(jl, jk)) * zvpf(jl, jk - 1)) / zdp(jl, jk) |
---|
| 616 | IF (pvph(jl, jk)<gvsec) THEN |
---|
[1992] | 617 | pvph(jl, jk) = gvsec |
---|
| 618 | kcrit(jl) = jk |
---|
| 619 | END IF |
---|
| 620 | END IF |
---|
| 621 | END DO |
---|
| 622 | END DO |
---|
| 623 | |
---|
| 624 | ! * 2.2 brunt-vaisala frequency and density at half levels. |
---|
| 625 | |
---|
| 626 | DO jk = ilevh, klev |
---|
| 627 | DO jl = kidia, kfdia |
---|
| 628 | IF (ktest(jl)==1) THEN |
---|
[5111] | 629 | IF (jk>=(kknub(jl) + 1) .AND. jk<=kknul(jl)) THEN |
---|
| 630 | zst = zcons2 / ptm1(jl, jk) * (1. - rcpd * prho(jl, jk) * (ptm1(jl, & |
---|
| 631 | jk) - ptm1(jl, jk - 1)) / zdp(jl, jk)) |
---|
| 632 | pstab(jl, klev + 1) = pstab(jl, klev + 1) + zst * zdp(jl, jk) |
---|
| 633 | pstab(jl, klev + 1) = max(pstab(jl, klev + 1), gssec) |
---|
| 634 | prho(jl, klev + 1) = prho(jl, klev + 1) + paphm1(jl, jk) * 2. * zdp(jl, jk) & |
---|
| 635 | * zcons1 / (ptm1(jl, jk) + ptm1(jl, jk - 1)) |
---|
[1992] | 636 | END IF |
---|
| 637 | END IF |
---|
| 638 | END DO |
---|
| 639 | END DO |
---|
| 640 | |
---|
| 641 | DO jl = kidia, kfdia |
---|
[5111] | 642 | pstab(jl, klev + 1) = pstab(jl, klev + 1) / (papm1(jl, kknul(jl)) - papm1(jl, kknub & |
---|
| 643 | (jl))) |
---|
| 644 | prho(jl, klev + 1) = prho(jl, klev + 1) / (papm1(jl, kknul(jl)) - papm1(jl, kknub(& |
---|
| 645 | jl))) |
---|
[1992] | 646 | zvar = pstd(jl) |
---|
| 647 | END DO |
---|
| 648 | |
---|
| 649 | ! * 2.3 mean flow richardson number. |
---|
| 650 | ! * and critical height for froude layer |
---|
| 651 | |
---|
| 652 | DO jk = 2, klev |
---|
| 653 | DO jl = kidia, kfdia |
---|
| 654 | IF (ktest(jl)==1) THEN |
---|
[5111] | 655 | zdwind = max(abs(zvpf(jl, jk) - zvpf(jl, jk - 1)), gvsec) |
---|
| 656 | pri(jl, jk) = pstab(jl, jk) * (zdp(jl, jk) / (rg * prho(jl, jk) * zdwind))**2 |
---|
| 657 | pri(jl, jk) = max(pri(jl, jk), grcrit) |
---|
[1992] | 658 | END IF |
---|
| 659 | END DO |
---|
| 660 | END DO |
---|
| 661 | |
---|
| 662 | |
---|
| 663 | |
---|
| 664 | ! * define top of 'envelope' layer |
---|
| 665 | ! ---------------------------- |
---|
| 666 | |
---|
| 667 | DO jl = kidia, kfdia |
---|
| 668 | pnu(jl) = 0.0 |
---|
| 669 | znum(jl) = 0.0 |
---|
| 670 | END DO |
---|
| 671 | |
---|
| 672 | DO jk = 2, klev - 1 |
---|
| 673 | DO jl = kidia, kfdia |
---|
| 674 | |
---|
| 675 | IF (ktest(jl)==1) THEN |
---|
| 676 | |
---|
| 677 | IF (jk>=kknub(jl)) THEN |
---|
| 678 | |
---|
| 679 | znum(jl) = pnu(jl) |
---|
[5111] | 680 | zwind = (pulow(jl) * pum1(jl, jk) + pvlow(jl) * pvm1(jl, jk)) / & |
---|
| 681 | max(sqrt(pulow(jl)**2 + pvlow(jl)**2), gvsec) |
---|
[1992] | 682 | zwind = max(sqrt(zwind**2), gvsec) |
---|
[5111] | 683 | zdelp = paphm1(jl, jk + 1) - paphm1(jl, jk) |
---|
| 684 | zstabm = sqrt(max(pstab(jl, jk), gssec)) |
---|
| 685 | zstabp = sqrt(max(pstab(jl, jk + 1), gssec)) |
---|
[1992] | 686 | zrhom = prho(jl, jk) |
---|
[5111] | 687 | zrhop = prho(jl, jk + 1) |
---|
| 688 | pnu(jl) = pnu(jl) + (zdelp / rg) * ((zstabp / zrhop + zstabm / zrhom) / 2.) / & |
---|
| 689 | zwind |
---|
| 690 | IF ((znum(jl)<=gfrcrit) .AND. (pnu(jl)>gfrcrit) .AND. (kkenvh(& |
---|
| 691 | jl)==klev)) kkenvh(jl) = jk |
---|
[1992] | 692 | |
---|
| 693 | END IF |
---|
| 694 | |
---|
| 695 | END IF |
---|
| 696 | |
---|
| 697 | END DO |
---|
| 698 | END DO |
---|
| 699 | |
---|
| 700 | ! calculation of a dynamical mixing height for the breaking |
---|
| 701 | ! of gravity waves: |
---|
| 702 | |
---|
| 703 | DO jl = kidia, kfdia |
---|
| 704 | znup(jl) = 0.0 |
---|
| 705 | znum(jl) = 0.0 |
---|
| 706 | END DO |
---|
| 707 | |
---|
| 708 | DO jk = klev - 1, 2, -1 |
---|
| 709 | DO jl = kidia, kfdia |
---|
| 710 | |
---|
| 711 | IF (ktest(jl)==1) THEN |
---|
| 712 | |
---|
| 713 | znum(jl) = znup(jl) |
---|
[5111] | 714 | zwind = (pulow(jl) * pum1(jl, jk) + pvlow(jl) * pvm1(jl, jk)) / & |
---|
| 715 | max(sqrt(pulow(jl)**2 + pvlow(jl)**2), gvsec) |
---|
[1992] | 716 | zwind = max(sqrt(zwind**2), gvsec) |
---|
[5111] | 717 | zdelp = paphm1(jl, jk + 1) - paphm1(jl, jk) |
---|
| 718 | zstabm = sqrt(max(pstab(jl, jk), gssec)) |
---|
| 719 | zstabp = sqrt(max(pstab(jl, jk + 1), gssec)) |
---|
[1992] | 720 | zrhom = prho(jl, jk) |
---|
[5111] | 721 | zrhop = prho(jl, jk + 1) |
---|
| 722 | znup(jl) = znup(jl) + (zdelp / rg) * ((zstabp / zrhop + zstabm / zrhom) / 2.) / & |
---|
| 723 | zwind |
---|
| 724 | IF ((znum(jl)<=rpi / 2.) .AND. (znup(jl)>rpi / 2.) .AND. (kkcrith(& |
---|
| 725 | jl)==klev)) kkcrith(jl) = jk |
---|
[1992] | 726 | |
---|
| 727 | END IF |
---|
| 728 | |
---|
| 729 | END DO |
---|
| 730 | END DO |
---|
| 731 | |
---|
| 732 | DO jl = kidia, kfdia |
---|
| 733 | kkcrith(jl) = min0(kkcrith(jl), kknu2(jl)) |
---|
[5111] | 734 | kkcrith(jl) = max0(kkcrith(jl), ilevh * 2) |
---|
[1992] | 735 | END DO |
---|
| 736 | |
---|
| 737 | ! directional info for flow blocking ************************* |
---|
| 738 | |
---|
| 739 | DO jk = ilevh, klev |
---|
| 740 | DO jl = kidia, kfdia |
---|
| 741 | IF (jk>=kkenvh(jl)) THEN |
---|
[5111] | 742 | lo = (pum1(jl, jk)<gvsec) .AND. (pum1(jl, jk)>=-gvsec) |
---|
[1992] | 743 | IF (lo) THEN |
---|
[5111] | 744 | zu = pum1(jl, jk) + 2. * gvsec |
---|
[1992] | 745 | ELSE |
---|
| 746 | zu = pum1(jl, jk) |
---|
| 747 | END IF |
---|
[5111] | 748 | zphi = atan(pvm1(jl, jk) / zu) |
---|
| 749 | ppsi(jl, jk) = ptheta(jl) * rpi / 180. - zphi |
---|
[1992] | 750 | END IF |
---|
| 751 | END DO |
---|
| 752 | END DO |
---|
| 753 | ! forms the vertical 'leakiness' ************************** |
---|
| 754 | |
---|
| 755 | alpha = 3. |
---|
| 756 | |
---|
| 757 | DO jk = ilevh, klev |
---|
| 758 | DO jl = kidia, kfdia |
---|
| 759 | IF (jk>=kkenvh(jl)) THEN |
---|
[5111] | 760 | zggeenv = amax1(1., (pgeom1(jl, kkenvh(jl)) + pgeom1(jl, & |
---|
| 761 | kkenvh(jl) - 1)) / 2.) |
---|
| 762 | zggeom1 = amax1(pgeom1(jl, jk), 1.) |
---|
| 763 | zgvar = amax1(pstd(jl) * rg, 1.) |
---|
[1992] | 764 | ! mod pzdep(jl,jk)=sqrt((zggeenv-zggeom1)/(zggeom1+zgvar)) |
---|
[5111] | 765 | pzdep(jl, jk) = (pgeom1(jl, kkenvh(jl) - 1) - pgeom1(jl, jk)) / & |
---|
| 766 | (pgeom1(jl, kkenvh(jl) - 1) - pgeom1(jl, klev)) |
---|
[1992] | 767 | END IF |
---|
| 768 | END DO |
---|
| 769 | END DO |
---|
| 770 | |
---|
| 771 | END SUBROUTINE orosetup |
---|
| 772 | SUBROUTINE gwstress(nlon, nlev, ktest, kcrit, kkenvh, kknu, prho, pstab, & |
---|
[5111] | 773 | pvph, pstd, psig, pmea, ppic, ptau, pgeom1, pdmod) |
---|
[1992] | 774 | |
---|
| 775 | ! **** *gwstress* |
---|
| 776 | |
---|
| 777 | ! purpose. |
---|
| 778 | ! -------- |
---|
| 779 | |
---|
| 780 | ! ** interface. |
---|
| 781 | ! ---------- |
---|
[5103] | 782 | ! CALL *gwstress* from *gwdrag* |
---|
[1992] | 783 | |
---|
| 784 | ! explicit arguments : |
---|
| 785 | ! -------------------- |
---|
| 786 | ! ==== inputs === |
---|
| 787 | ! ==== outputs === |
---|
| 788 | |
---|
| 789 | ! implicit arguments : none |
---|
| 790 | ! -------------------- |
---|
| 791 | |
---|
| 792 | ! method. |
---|
| 793 | ! ------- |
---|
| 794 | |
---|
| 795 | |
---|
| 796 | ! externals. |
---|
| 797 | ! ---------- |
---|
| 798 | |
---|
| 799 | |
---|
| 800 | ! reference. |
---|
| 801 | ! ---------- |
---|
| 802 | |
---|
| 803 | ! see ecmwf research department documentation of the "i.f.s." |
---|
| 804 | |
---|
| 805 | ! author. |
---|
| 806 | ! ------- |
---|
| 807 | |
---|
| 808 | ! modifications. |
---|
| 809 | ! -------------- |
---|
| 810 | ! f. lott put the new gwd on ifs 22/11/93 |
---|
| 811 | |
---|
| 812 | ! ----------------------------------------------------------------------- |
---|
| 813 | USE dimphy |
---|
[5143] | 814 | USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, & |
---|
| 815 | GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat |
---|
[5144] | 816 | USE lmdz_yomcst |
---|
[5143] | 817 | |
---|
[1992] | 818 | IMPLICIT NONE |
---|
| 819 | |
---|
| 820 | ! ----------------------------------------------------------------------- |
---|
| 821 | |
---|
| 822 | ! * 0.1 arguments |
---|
| 823 | ! --------- |
---|
| 824 | |
---|
| 825 | INTEGER nlon, nlev |
---|
| 826 | INTEGER kcrit(nlon), ktest(nlon), kkenvh(nlon), kknu(nlon) |
---|
| 827 | |
---|
[5111] | 828 | REAL prho(nlon, nlev + 1), pstab(nlon, nlev + 1), ptau(nlon, nlev + 1), & |
---|
| 829 | pvph(nlon, nlev + 1), pgeom1(nlon, nlev), pstd(nlon) |
---|
[1992] | 830 | |
---|
| 831 | REAL psig(nlon) |
---|
| 832 | REAL pmea(nlon), ppic(nlon) |
---|
| 833 | REAL pdmod(nlon) |
---|
| 834 | |
---|
| 835 | ! ----------------------------------------------------------------------- |
---|
| 836 | |
---|
| 837 | ! * 0.2 local arrays |
---|
| 838 | ! ------------ |
---|
| 839 | INTEGER jl |
---|
| 840 | REAL zblock, zvar, zeff |
---|
| 841 | LOGICAL lo |
---|
| 842 | |
---|
| 843 | ! ----------------------------------------------------------------------- |
---|
| 844 | |
---|
| 845 | ! * 0.3 functions |
---|
| 846 | ! --------- |
---|
| 847 | ! ------------------------------------------------------------------ |
---|
| 848 | |
---|
| 849 | ! * 1. initialization |
---|
| 850 | ! -------------- |
---|
| 851 | |
---|
| 852 | |
---|
| 853 | ! * 3.1 gravity wave stress. |
---|
| 854 | |
---|
| 855 | DO jl = kidia, kfdia |
---|
| 856 | IF (ktest(jl)==1) THEN |
---|
| 857 | |
---|
| 858 | ! effective mountain height above the blocked flow |
---|
| 859 | |
---|
| 860 | IF (kkenvh(jl)==klev) THEN |
---|
| 861 | zblock = 0.0 |
---|
[524] | 862 | ELSE |
---|
[5111] | 863 | zblock = (pgeom1(jl, kkenvh(jl)) + pgeom1(jl, kkenvh(jl) + 1)) / 2. / rg |
---|
[1992] | 864 | END IF |
---|
[524] | 865 | |
---|
[1992] | 866 | zvar = ppic(jl) - pmea(jl) |
---|
[5111] | 867 | zeff = amax1(0., zvar - zblock) |
---|
[1992] | 868 | |
---|
[5111] | 869 | ptau(jl, klev + 1) = prho(jl, klev + 1) * gkdrag * psig(jl) * zeff**2 / 4. / & |
---|
| 870 | pstd(jl) * pvph(jl, klev + 1) * pdmod(jl) * sqrt(pstab(jl, klev + 1)) |
---|
[1992] | 871 | |
---|
| 872 | ! too small value of stress or low level flow include critical level |
---|
| 873 | ! or low level flow: gravity wave stress nul. |
---|
| 874 | |
---|
[5111] | 875 | lo = (ptau(jl, klev + 1)<gtsec) .OR. (kcrit(jl)>=kknu(jl)) .OR. & |
---|
| 876 | (pvph(jl, klev + 1)<gvcrit) |
---|
[5116] | 877 | ! IF(lo) ptau(jl,klev+1)=0.0 |
---|
[1992] | 878 | |
---|
| 879 | ELSE |
---|
| 880 | |
---|
[5111] | 881 | ptau(jl, klev + 1) = 0.0 |
---|
[1992] | 882 | |
---|
| 883 | END IF |
---|
| 884 | |
---|
| 885 | END DO |
---|
| 886 | |
---|
| 887 | END SUBROUTINE gwstress |
---|
| 888 | SUBROUTINE gwprofil(nlon, nlev, kgwd, kdx, ktest, kkcrith, kcrit, paphm1, & |
---|
[5111] | 889 | prho, pstab, pvph, pri, ptau, pdmod, psig, pvar) |
---|
[1992] | 890 | |
---|
| 891 | ! **** *GWPROFIL* |
---|
| 892 | |
---|
| 893 | ! PURPOSE. |
---|
| 894 | ! -------- |
---|
| 895 | |
---|
| 896 | ! ** INTERFACE. |
---|
| 897 | ! ---------- |
---|
| 898 | ! FROM *GWDRAG* |
---|
| 899 | |
---|
| 900 | ! EXPLICIT ARGUMENTS : |
---|
| 901 | ! -------------------- |
---|
| 902 | ! ==== INPUTS === |
---|
| 903 | ! ==== OUTPUTS === |
---|
| 904 | |
---|
| 905 | ! IMPLICIT ARGUMENTS : NONE |
---|
| 906 | ! -------------------- |
---|
| 907 | |
---|
| 908 | ! METHOD: |
---|
| 909 | ! ------- |
---|
| 910 | ! THE STRESS PROFILE FOR GRAVITY WAVES IS COMPUTED AS FOLLOWS: |
---|
| 911 | ! IT IS CONSTANT (NO GWD) AT THE LEVELS BETWEEN THE GROUND |
---|
| 912 | ! AND THE TOP OF THE BLOCKED LAYER (KKENVH). |
---|
| 913 | ! IT DECREASES LINEARLY WITH HEIGHTS FROM THE TOP OF THE |
---|
| 914 | ! BLOCKED LAYER TO 3*VAROR (kKNU), TO SIMULATES LEE WAVES OR |
---|
| 915 | ! NONLINEAR GRAVITY WAVE BREAKING. |
---|
| 916 | ! ABOVE IT IS CONSTANT, EXCEPT WHEN THE WAVE ENCOUNTERS A CRITICAL |
---|
| 917 | ! LEVEL (KCRIT) OR WHEN IT BREAKS. |
---|
| 918 | |
---|
| 919 | |
---|
| 920 | |
---|
| 921 | ! EXTERNALS. |
---|
| 922 | ! ---------- |
---|
| 923 | |
---|
| 924 | |
---|
| 925 | ! REFERENCE. |
---|
| 926 | ! ---------- |
---|
| 927 | |
---|
| 928 | ! SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S." |
---|
| 929 | |
---|
| 930 | ! AUTHOR. |
---|
| 931 | ! ------- |
---|
| 932 | |
---|
| 933 | ! MODIFICATIONS. |
---|
| 934 | ! -------------- |
---|
| 935 | ! PASSAGE OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93) |
---|
| 936 | ! ----------------------------------------------------------------------- |
---|
| 937 | USE dimphy |
---|
[5143] | 938 | USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, & |
---|
| 939 | GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat |
---|
[5144] | 940 | USE lmdz_yomcst |
---|
[5143] | 941 | |
---|
[1992] | 942 | IMPLICIT NONE |
---|
| 943 | |
---|
| 944 | ! ----------------------------------------------------------------------- |
---|
| 945 | |
---|
| 946 | ! * 0.1 ARGUMENTS |
---|
| 947 | ! --------- |
---|
| 948 | |
---|
| 949 | INTEGER nlon, nlev |
---|
| 950 | INTEGER kkcrith(nlon), kcrit(nlon), kdx(nlon), ktest(nlon) |
---|
| 951 | |
---|
[5111] | 952 | REAL paphm1(nlon, nlev + 1), pstab(nlon, nlev + 1), prho(nlon, nlev + 1), & |
---|
| 953 | pvph(nlon, nlev + 1), pri(nlon, nlev + 1), ptau(nlon, nlev + 1) |
---|
[1992] | 954 | |
---|
| 955 | REAL pdmod(nlon), psig(nlon), pvar(nlon) |
---|
| 956 | |
---|
| 957 | ! ----------------------------------------------------------------------- |
---|
| 958 | |
---|
| 959 | ! * 0.2 LOCAL ARRAYS |
---|
| 960 | ! ------------ |
---|
| 961 | |
---|
| 962 | INTEGER ilevh, ji, kgwd, jl, jk |
---|
| 963 | REAL zsqr, zalfa, zriw, zdel, zb, zalpha, zdz2n |
---|
| 964 | REAL zdelp, zdelpt |
---|
| 965 | REAL zdz2(klon, klev), znorm(klon), zoro(klon) |
---|
[5111] | 966 | REAL ztau(klon, klev + 1) |
---|
[1992] | 967 | |
---|
| 968 | ! ----------------------------------------------------------------------- |
---|
| 969 | |
---|
| 970 | ! * 1. INITIALIZATION |
---|
| 971 | ! -------------- |
---|
| 972 | |
---|
| 973 | ! print *,' entree gwprofil' |
---|
| 974 | |
---|
| 975 | |
---|
| 976 | ! * COMPUTATIONAL CONSTANTS. |
---|
| 977 | ! ------------- ---------- |
---|
| 978 | |
---|
[5111] | 979 | ilevh = klev / 3 |
---|
[1992] | 980 | |
---|
| 981 | ! DO 400 ji=1,kgwd |
---|
| 982 | ! jl=kdx(ji) |
---|
| 983 | ! Modif vectorisation 02/04/2004 |
---|
| 984 | DO jl = kidia, kfdia |
---|
| 985 | IF (ktest(jl)==1) THEN |
---|
[5111] | 986 | zoro(jl) = psig(jl) * pdmod(jl) / 4. / max(pvar(jl), 1.0) |
---|
| 987 | ztau(jl, klev + 1) = ptau(jl, klev + 1) |
---|
[1992] | 988 | END IF |
---|
| 989 | END DO |
---|
| 990 | |
---|
| 991 | DO jk = klev, 2, -1 |
---|
| 992 | |
---|
| 993 | ! * 4.1 CONSTANT WAVE STRESS UNTIL TOP OF THE |
---|
| 994 | ! BLOCKING LAYER. |
---|
| 995 | |
---|
| 996 | ! DO 411 ji=1,kgwd |
---|
| 997 | ! jl=kdx(ji) |
---|
| 998 | ! Modif vectorisation 02/04/2004 |
---|
| 999 | DO jl = kidia, kfdia |
---|
| 1000 | IF (ktest(jl)==1) THEN |
---|
| 1001 | IF (jk>kkcrith(jl)) THEN |
---|
[5111] | 1002 | ptau(jl, jk) = ztau(jl, klev + 1) |
---|
[1992] | 1003 | ! ENDIF |
---|
| 1004 | ! IF(JK.EQ.KKCRITH(JL)) THEN |
---|
[524] | 1005 | ELSE |
---|
[5111] | 1006 | ptau(jl, jk) = grahilo * ztau(jl, klev + 1) |
---|
[1992] | 1007 | END IF |
---|
| 1008 | END IF |
---|
| 1009 | END DO |
---|
[524] | 1010 | |
---|
[1992] | 1011 | ! * 4.15 CONSTANT SHEAR STRESS UNTIL THE TOP OF THE |
---|
| 1012 | ! LOW LEVEL FLOW LAYER. |
---|
[524] | 1013 | |
---|
[1992] | 1014 | |
---|
| 1015 | ! * 4.2 WAVE DISPLACEMENT AT NEXT LEVEL. |
---|
| 1016 | |
---|
| 1017 | |
---|
| 1018 | ! DO 421 ji=1,kgwd |
---|
| 1019 | ! jl=kdx(ji) |
---|
| 1020 | ! Modif vectorisation 02/04/2004 |
---|
| 1021 | DO jl = kidia, kfdia |
---|
| 1022 | IF (ktest(jl)==1) THEN |
---|
| 1023 | IF (jk<kkcrith(jl)) THEN |
---|
[5111] | 1024 | znorm(jl) = gkdrag * prho(jl, jk) * sqrt(pstab(jl, jk)) * pvph(jl, jk) * & |
---|
| 1025 | zoro(jl) |
---|
| 1026 | zdz2(jl, jk) = ptau(jl, jk + 1) / max(znorm(jl), gssec) |
---|
[1992] | 1027 | END IF |
---|
| 1028 | END IF |
---|
| 1029 | END DO |
---|
| 1030 | |
---|
| 1031 | ! * 4.3 WAVE RICHARDSON NUMBER, NEW WAVE DISPLACEMENT |
---|
| 1032 | ! * AND STRESS: BREAKING EVALUATION AND CRITICAL |
---|
| 1033 | ! LEVEL |
---|
| 1034 | |
---|
| 1035 | |
---|
| 1036 | ! DO 431 ji=1,kgwd |
---|
| 1037 | ! jl=Kdx(ji) |
---|
| 1038 | ! Modif vectorisation 02/04/2004 |
---|
| 1039 | DO jl = kidia, kfdia |
---|
| 1040 | IF (ktest(jl)==1) THEN |
---|
| 1041 | |
---|
| 1042 | IF (jk<kkcrith(jl)) THEN |
---|
[5111] | 1043 | IF ((ptau(jl, jk + 1)<gtsec) .OR. (jk<=kcrit(jl))) THEN |
---|
[1992] | 1044 | ptau(jl, jk) = 0.0 |
---|
| 1045 | ELSE |
---|
[5111] | 1046 | zsqr = sqrt(pri(jl, jk)) |
---|
| 1047 | zalfa = sqrt(pstab(jl, jk) * zdz2(jl, jk)) / pvph(jl, jk) |
---|
| 1048 | zriw = pri(jl, jk) * (1. - zalfa) / (1 + zalfa * zsqr)**2 |
---|
[1992] | 1049 | IF (zriw<grcrit) THEN |
---|
[5111] | 1050 | zdel = 4. / zsqr / grcrit + 1. / grcrit**2 + 4. / grcrit |
---|
| 1051 | zb = 1. / grcrit + 2. / zsqr |
---|
| 1052 | zalpha = 0.5 * (-zb + sqrt(zdel)) |
---|
| 1053 | zdz2n = (pvph(jl, jk) * zalpha)**2 / pstab(jl, jk) |
---|
| 1054 | ptau(jl, jk) = znorm(jl) * zdz2n |
---|
[1992] | 1055 | ELSE |
---|
[5111] | 1056 | ptau(jl, jk) = znorm(jl) * zdz2(jl, jk) |
---|
[1992] | 1057 | END IF |
---|
[5111] | 1058 | ptau(jl, jk) = min(ptau(jl, jk), ptau(jl, jk + 1)) |
---|
[1992] | 1059 | END IF |
---|
| 1060 | END IF |
---|
| 1061 | END IF |
---|
| 1062 | END DO |
---|
| 1063 | |
---|
| 1064 | END DO |
---|
| 1065 | |
---|
| 1066 | ! REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL |
---|
| 1067 | |
---|
| 1068 | ! DO 530 ji=1,kgwd |
---|
| 1069 | ! jl=kdx(ji) |
---|
| 1070 | ! Modif vectorisation 02/04/2004 |
---|
| 1071 | DO jl = kidia, kfdia |
---|
| 1072 | IF (ktest(jl)==1) THEN |
---|
| 1073 | ztau(jl, kkcrith(jl)) = ptau(jl, kkcrith(jl)) |
---|
| 1074 | ztau(jl, nstra) = ptau(jl, nstra) |
---|
| 1075 | END IF |
---|
| 1076 | END DO |
---|
| 1077 | |
---|
| 1078 | DO jk = 1, klev |
---|
| 1079 | |
---|
| 1080 | ! DO 532 ji=1,kgwd |
---|
| 1081 | ! jl=kdx(ji) |
---|
| 1082 | ! Modif vectorisation 02/04/2004 |
---|
| 1083 | DO jl = kidia, kfdia |
---|
| 1084 | IF (ktest(jl)==1) THEN |
---|
| 1085 | |
---|
| 1086 | IF (jk>kkcrith(jl)) THEN |
---|
| 1087 | |
---|
[5111] | 1088 | zdelp = paphm1(jl, jk) - paphm1(jl, klev + 1) |
---|
| 1089 | zdelpt = paphm1(jl, kkcrith(jl)) - paphm1(jl, klev + 1) |
---|
| 1090 | ptau(jl, jk) = ztau(jl, klev + 1) + (ztau(jl, kkcrith(jl)) - ztau(jl, & |
---|
| 1091 | klev + 1)) * zdelp / zdelpt |
---|
[1992] | 1092 | |
---|
| 1093 | END IF |
---|
| 1094 | |
---|
| 1095 | END IF |
---|
| 1096 | END DO |
---|
| 1097 | |
---|
| 1098 | ! REORGANISATION IN THE STRATOSPHERE |
---|
| 1099 | |
---|
| 1100 | ! DO 533 ji=1,kgwd |
---|
| 1101 | ! jl=kdx(ji) |
---|
| 1102 | ! Modif vectorisation 02/04/2004 |
---|
| 1103 | DO jl = kidia, kfdia |
---|
| 1104 | IF (ktest(jl)==1) THEN |
---|
| 1105 | |
---|
| 1106 | IF (jk<nstra) THEN |
---|
| 1107 | |
---|
| 1108 | zdelp = paphm1(jl, nstra) |
---|
| 1109 | zdelpt = paphm1(jl, jk) |
---|
[5111] | 1110 | ptau(jl, jk) = ztau(jl, nstra) * zdelpt / zdelp |
---|
[1992] | 1111 | |
---|
| 1112 | END IF |
---|
| 1113 | |
---|
| 1114 | END IF |
---|
| 1115 | END DO |
---|
| 1116 | |
---|
| 1117 | ! REORGANISATION IN THE TROPOSPHERE |
---|
| 1118 | |
---|
| 1119 | ! DO 534 ji=1,kgwd |
---|
| 1120 | ! jl=kdx(ji) |
---|
| 1121 | ! Modif vectorisation 02/04/2004 |
---|
| 1122 | DO jl = kidia, kfdia |
---|
| 1123 | IF (ktest(jl)==1) THEN |
---|
| 1124 | |
---|
| 1125 | IF (jk<kkcrith(jl) .AND. jk>nstra) THEN |
---|
| 1126 | |
---|
| 1127 | zdelp = paphm1(jl, jk) - paphm1(jl, kkcrith(jl)) |
---|
| 1128 | zdelpt = paphm1(jl, nstra) - paphm1(jl, kkcrith(jl)) |
---|
[5111] | 1129 | ptau(jl, jk) = ztau(jl, kkcrith(jl)) + (ztau(jl, nstra) - ztau(jl, & |
---|
| 1130 | kkcrith(jl))) * zdelp / zdelpt |
---|
[1992] | 1131 | |
---|
| 1132 | END IF |
---|
| 1133 | END IF |
---|
| 1134 | END DO |
---|
| 1135 | |
---|
| 1136 | END DO |
---|
| 1137 | |
---|
| 1138 | END SUBROUTINE gwprofil |
---|
| 1139 | SUBROUTINE lift_noro(nlon, nlev, dtime, paprs, pplay, plat, pmea, pstd, ppic, & |
---|
[5111] | 1140 | ktest, t, u, v, pulow, pvlow, pustr, pvstr, d_t, d_u, d_v) |
---|
[1992] | 1141 | |
---|
| 1142 | USE dimphy |
---|
[5144] | 1143 | USE lmdz_yomcst |
---|
| 1144 | |
---|
[1992] | 1145 | IMPLICIT NONE |
---|
| 1146 | ! ====================================================================== |
---|
| 1147 | ! Auteur(s): F.Lott (LMD/CNRS) date: 19950201 |
---|
| 1148 | ! Objet: Frottement de la montagne Interface |
---|
| 1149 | ! ====================================================================== |
---|
| 1150 | ! Arguments: |
---|
| 1151 | ! dtime---input-R- pas d'integration (s) |
---|
| 1152 | ! paprs---input-R-pression pour chaque inter-couche (en Pa) |
---|
| 1153 | ! pplay---input-R-pression pour le mileu de chaque couche (en Pa) |
---|
| 1154 | ! t-------input-R-temperature (K) |
---|
| 1155 | ! u-------input-R-vitesse horizontale (m/s) |
---|
| 1156 | ! v-------input-R-vitesse horizontale (m/s) |
---|
| 1157 | |
---|
| 1158 | ! d_t-----output-R-increment de la temperature |
---|
| 1159 | ! d_u-----output-R-increment de la vitesse u |
---|
| 1160 | ! d_v-----output-R-increment de la vitesse v |
---|
| 1161 | ! ====================================================================== |
---|
| 1162 | |
---|
| 1163 | ! ARGUMENTS |
---|
| 1164 | |
---|
| 1165 | INTEGER nlon, nlev |
---|
| 1166 | REAL dtime |
---|
[5111] | 1167 | REAL paprs(klon, klev + 1) |
---|
[1992] | 1168 | REAL pplay(klon, klev) |
---|
| 1169 | REAL plat(nlon), pmea(nlon) |
---|
| 1170 | REAL pstd(nlon) |
---|
| 1171 | REAL ppic(nlon) |
---|
| 1172 | REAL pulow(nlon), pvlow(nlon), pustr(nlon), pvstr(nlon) |
---|
| 1173 | REAL t(nlon, nlev), u(nlon, nlev), v(nlon, nlev) |
---|
| 1174 | REAL d_t(nlon, nlev), d_u(nlon, nlev), d_v(nlon, nlev) |
---|
| 1175 | |
---|
| 1176 | INTEGER i, k, ktest(nlon) |
---|
| 1177 | |
---|
| 1178 | ! Variables locales: |
---|
| 1179 | |
---|
| 1180 | REAL zgeom(klon, klev) |
---|
| 1181 | REAL pdtdt(klon, klev), pdudt(klon, klev), pdvdt(klon, klev) |
---|
| 1182 | REAL pt(klon, klev), pu(klon, klev), pv(klon, klev) |
---|
[5111] | 1183 | REAL papmf(klon, klev), papmh(klon, klev + 1) |
---|
[1992] | 1184 | |
---|
| 1185 | ! initialiser les variables de sortie (pour securite) |
---|
| 1186 | |
---|
| 1187 | DO i = 1, klon |
---|
| 1188 | pulow(i) = 0.0 |
---|
| 1189 | pvlow(i) = 0.0 |
---|
| 1190 | pustr(i) = 0.0 |
---|
| 1191 | pvstr(i) = 0.0 |
---|
| 1192 | END DO |
---|
| 1193 | DO k = 1, klev |
---|
| 1194 | DO i = 1, klon |
---|
| 1195 | d_t(i, k) = 0.0 |
---|
| 1196 | d_u(i, k) = 0.0 |
---|
| 1197 | d_v(i, k) = 0.0 |
---|
| 1198 | pdudt(i, k) = 0.0 |
---|
| 1199 | pdvdt(i, k) = 0.0 |
---|
| 1200 | pdtdt(i, k) = 0.0 |
---|
| 1201 | END DO |
---|
| 1202 | END DO |
---|
| 1203 | |
---|
| 1204 | ! preparer les variables d'entree (attention: l'ordre des niveaux |
---|
| 1205 | ! verticaux augmente du haut vers le bas) |
---|
| 1206 | |
---|
| 1207 | DO k = 1, klev |
---|
| 1208 | DO i = 1, klon |
---|
[5111] | 1209 | pt(i, k) = t(i, klev - k + 1) |
---|
| 1210 | pu(i, k) = u(i, klev - k + 1) |
---|
| 1211 | pv(i, k) = v(i, klev - k + 1) |
---|
| 1212 | papmf(i, k) = pplay(i, klev - k + 1) |
---|
[1992] | 1213 | END DO |
---|
| 1214 | END DO |
---|
| 1215 | DO k = 1, klev + 1 |
---|
| 1216 | DO i = 1, klon |
---|
[5111] | 1217 | papmh(i, k) = paprs(i, klev - k + 2) |
---|
[1992] | 1218 | END DO |
---|
| 1219 | END DO |
---|
| 1220 | DO i = 1, klon |
---|
[5111] | 1221 | zgeom(i, klev) = rd * pt(i, klev) * log(papmh(i, klev + 1) / papmf(i, klev)) |
---|
[1992] | 1222 | END DO |
---|
| 1223 | DO k = klev - 1, 1, -1 |
---|
| 1224 | DO i = 1, klon |
---|
[5111] | 1225 | zgeom(i, k) = zgeom(i, k + 1) + rd * (pt(i, k) + pt(i, k + 1)) / 2.0 * log(papmf(i, k + & |
---|
| 1226 | 1) / papmf(i, k)) |
---|
[1992] | 1227 | END DO |
---|
| 1228 | END DO |
---|
| 1229 | |
---|
| 1230 | ! appeler la routine principale |
---|
| 1231 | |
---|
| 1232 | CALL orolift(klon, klev, ktest, dtime, papmh, zgeom, pt, pu, pv, plat, & |
---|
[5111] | 1233 | pmea, pstd, ppic, pulow, pvlow, pdudt, pdvdt, pdtdt) |
---|
[1992] | 1234 | |
---|
| 1235 | DO k = 1, klev |
---|
| 1236 | DO i = 1, klon |
---|
[5111] | 1237 | d_u(i, klev + 1 - k) = dtime * pdudt(i, k) |
---|
| 1238 | d_v(i, klev + 1 - k) = dtime * pdvdt(i, k) |
---|
| 1239 | d_t(i, klev + 1 - k) = dtime * pdtdt(i, k) |
---|
[1992] | 1240 | pustr(i) = pustr(i) & ! IM BUG . |
---|
[5111] | 1241 | ! +RG*pdudt(i,k)*(papmh(i,k+1)-papmh(i,k)) |
---|
| 1242 | + pdudt(i, k) * (papmh(i, k + 1) - papmh(i, k)) / rg |
---|
[1992] | 1243 | pvstr(i) = pvstr(i) & ! IM BUG . |
---|
[5111] | 1244 | ! +RG*pdvdt(i,k)*(papmh(i,k+1)-papmh(i,k)) |
---|
| 1245 | + pdvdt(i, k) * (papmh(i, k + 1) - papmh(i, k)) / rg |
---|
[1992] | 1246 | END DO |
---|
| 1247 | END DO |
---|
| 1248 | |
---|
| 1249 | END SUBROUTINE lift_noro |
---|
| 1250 | SUBROUTINE orolift(nlon, nlev, ktest, ptsphy, paphm1, pgeom1, ptm1, pum1, & |
---|
[5111] | 1251 | pvm1, plat, pmea, pvaror, ppic & ! OUTPUTS |
---|
| 1252 | , pulow, pvlow, pvom, pvol, pte) |
---|
[1992] | 1253 | |
---|
| 1254 | |
---|
| 1255 | ! **** *OROLIFT: SIMULATE THE GEOSTROPHIC LIFT. |
---|
| 1256 | |
---|
| 1257 | ! PURPOSE. |
---|
| 1258 | ! -------- |
---|
| 1259 | |
---|
| 1260 | ! ** INTERFACE. |
---|
| 1261 | ! ---------- |
---|
| 1262 | ! CALLED FROM *lift_noro |
---|
| 1263 | ! ---------- |
---|
| 1264 | |
---|
| 1265 | ! AUTHOR. |
---|
| 1266 | ! ------- |
---|
| 1267 | ! F.LOTT LMD 22/11/95 |
---|
| 1268 | |
---|
| 1269 | USE dimphy |
---|
[5111] | 1270 | USE lmdz_abort_physic, ONLY: abort_physic |
---|
[5143] | 1271 | USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, & |
---|
| 1272 | GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat |
---|
[5144] | 1273 | USE lmdz_yomcst |
---|
[5143] | 1274 | |
---|
[1992] | 1275 | IMPLICIT NONE |
---|
| 1276 | |
---|
| 1277 | ! * 0.1 ARGUMENTS |
---|
| 1278 | ! --------- |
---|
| 1279 | |
---|
| 1280 | INTEGER nlon, nlev |
---|
| 1281 | REAL pte(nlon, nlev), pvol(nlon, nlev), pvom(nlon, nlev), pulow(nlon), & |
---|
[5111] | 1282 | pvlow(nlon) |
---|
[1992] | 1283 | REAL pum1(nlon, nlev), pvm1(nlon, nlev), ptm1(nlon, nlev), plat(nlon), & |
---|
[5111] | 1284 | pmea(nlon), pvaror(nlon), ppic(nlon), pgeom1(nlon, nlev), & |
---|
| 1285 | paphm1(nlon, nlev + 1) |
---|
[1992] | 1286 | |
---|
| 1287 | INTEGER ktest(nlon) |
---|
| 1288 | REAL ptsphy |
---|
| 1289 | ! ----------------------------------------------------------------------- |
---|
| 1290 | |
---|
| 1291 | ! * 0.2 LOCAL ARRAYS |
---|
| 1292 | ! ------------ |
---|
| 1293 | LOGICAL lifthigh |
---|
| 1294 | ! ym integer klevm1, jl, ilevh, jk |
---|
| 1295 | INTEGER jl, ilevh, jk |
---|
| 1296 | REAL zcons1, ztmst, zrtmst, zpi, zhgeo |
---|
| 1297 | REAL zdelp, zslow, zsqua, zscav, zbet |
---|
| 1298 | INTEGER iknub(klon), iknul(klon) |
---|
[5111] | 1299 | LOGICAL ll1(klon, klev + 1) |
---|
[1992] | 1300 | |
---|
[5111] | 1301 | REAL ztau(klon, klev + 1), ztav(klon, klev + 1), zrho(klon, klev + 1) |
---|
[1992] | 1302 | REAL zdudt(klon), zdvdt(klon) |
---|
| 1303 | REAL zhcrit(klon, klev) |
---|
[5111] | 1304 | CHARACTER (LEN = 20) :: modname = 'orografi' |
---|
| 1305 | CHARACTER (LEN = 80) :: abort_message |
---|
[1992] | 1306 | ! ----------------------------------------------------------------------- |
---|
| 1307 | |
---|
| 1308 | ! * 1.1 INITIALIZATIONS |
---|
| 1309 | ! --------------- |
---|
| 1310 | |
---|
| 1311 | lifthigh = .FALSE. |
---|
| 1312 | |
---|
| 1313 | IF (nlon/=klon .OR. nlev/=klev) THEN |
---|
| 1314 | abort_message = 'pb dimension' |
---|
[2311] | 1315 | CALL abort_physic(modname, abort_message, 1) |
---|
[1992] | 1316 | END IF |
---|
[5111] | 1317 | zcons1 = 1. / rd |
---|
[1992] | 1318 | ! ym KLEVM1=KLEV-1 |
---|
| 1319 | ztmst = ptsphy |
---|
[5111] | 1320 | zrtmst = 1. / ztmst |
---|
[1992] | 1321 | zpi = acos(-1.) |
---|
| 1322 | |
---|
| 1323 | DO jl = kidia, kfdia |
---|
[5111] | 1324 | zrho(jl, klev + 1) = 0.0 |
---|
[1992] | 1325 | pulow(jl) = 0.0 |
---|
| 1326 | pvlow(jl) = 0.0 |
---|
| 1327 | iknub(jl) = klev |
---|
| 1328 | iknul(jl) = klev |
---|
[5111] | 1329 | ilevh = klev / 3 |
---|
| 1330 | ll1(jl, klev + 1) = .FALSE. |
---|
[1992] | 1331 | DO jk = 1, klev |
---|
| 1332 | pvom(jl, jk) = 0.0 |
---|
| 1333 | pvol(jl, jk) = 0.0 |
---|
| 1334 | pte(jl, jk) = 0.0 |
---|
| 1335 | END DO |
---|
| 1336 | END DO |
---|
| 1337 | |
---|
| 1338 | |
---|
| 1339 | ! * 2.1 DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF |
---|
| 1340 | ! * LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE |
---|
| 1341 | ! * THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS. |
---|
| 1342 | |
---|
| 1343 | DO jk = klev, 1, -1 |
---|
| 1344 | DO jl = kidia, kfdia |
---|
| 1345 | IF (ktest(jl)==1) THEN |
---|
[5111] | 1346 | zhcrit(jl, jk) = amax1(ppic(jl) - pmea(jl), 100.) |
---|
| 1347 | zhgeo = pgeom1(jl, jk) / rg |
---|
| 1348 | ll1(jl, jk) = (zhgeo>zhcrit(jl, jk)) |
---|
| 1349 | IF (ll1(jl, jk) .NEQV. ll1(jl, jk + 1)) THEN |
---|
[1992] | 1350 | iknub(jl) = jk |
---|
| 1351 | END IF |
---|
| 1352 | END IF |
---|
| 1353 | END DO |
---|
| 1354 | END DO |
---|
| 1355 | |
---|
| 1356 | DO jl = kidia, kfdia |
---|
| 1357 | IF (ktest(jl)==1) THEN |
---|
[5111] | 1358 | iknub(jl) = max(iknub(jl), klev / 2) |
---|
| 1359 | iknul(jl) = max(iknul(jl), 2 * klev / 3) |
---|
[1992] | 1360 | IF (iknub(jl)>nktopg) iknub(jl) = nktopg |
---|
| 1361 | IF (iknub(jl)==nktopg) iknul(jl) = klev |
---|
| 1362 | IF (iknub(jl)==iknul(jl)) iknub(jl) = iknul(jl) - 1 |
---|
| 1363 | END IF |
---|
| 1364 | END DO |
---|
| 1365 | |
---|
| 1366 | ! do 2011 jl=kidia,kfdia |
---|
| 1367 | ! IF(KTEST(JL).EQ.1) THEN |
---|
| 1368 | ! print *,' iknul= ',iknul(jl),' iknub=',iknub(jl) |
---|
| 1369 | ! ENDIF |
---|
| 1370 | ! 2011 continue |
---|
| 1371 | |
---|
| 1372 | ! PRINT *,' DANS OROLIFT: 2010' |
---|
| 1373 | |
---|
| 1374 | DO jk = klev, 2, -1 |
---|
| 1375 | DO jl = kidia, kfdia |
---|
[5111] | 1376 | zrho(jl, jk) = 2. * paphm1(jl, jk) * zcons1 / (ptm1(jl, jk) + ptm1(jl, jk - 1)) |
---|
[1992] | 1377 | END DO |
---|
| 1378 | END DO |
---|
| 1379 | ! PRINT *,' DANS OROLIFT: 223' |
---|
| 1380 | |
---|
| 1381 | ! ******************************************************************** |
---|
| 1382 | |
---|
| 1383 | ! * DEFINE LOW LEVEL FLOW |
---|
| 1384 | ! ------------------- |
---|
| 1385 | DO jk = klev, 1, -1 |
---|
| 1386 | DO jl = kidia, kfdia |
---|
| 1387 | IF (ktest(jl)==1) THEN |
---|
| 1388 | IF (jk>=iknub(jl) .AND. jk<=iknul(jl)) THEN |
---|
[5111] | 1389 | pulow(jl) = pulow(jl) + pum1(jl, jk) * (paphm1(jl, jk + 1) - paphm1(jl, jk) & |
---|
| 1390 | ) |
---|
| 1391 | pvlow(jl) = pvlow(jl) + pvm1(jl, jk) * (paphm1(jl, jk + 1) - paphm1(jl, jk) & |
---|
| 1392 | ) |
---|
| 1393 | zrho(jl, klev + 1) = zrho(jl, klev + 1) + zrho(jl, jk) * (paphm1(jl, jk + 1) & |
---|
| 1394 | - paphm1(jl, jk)) |
---|
[1992] | 1395 | END IF |
---|
| 1396 | END IF |
---|
| 1397 | END DO |
---|
| 1398 | END DO |
---|
| 1399 | DO jl = kidia, kfdia |
---|
| 1400 | IF (ktest(jl)==1) THEN |
---|
[5111] | 1401 | pulow(jl) = pulow(jl) / (paphm1(jl, iknul(jl) + 1) - paphm1(jl, iknub(jl))) |
---|
| 1402 | pvlow(jl) = pvlow(jl) / (paphm1(jl, iknul(jl) + 1) - paphm1(jl, iknub(jl))) |
---|
| 1403 | zrho(jl, klev + 1) = zrho(jl, klev + 1) / (paphm1(jl, iknul(jl) + 1) - paphm1(jl, & |
---|
| 1404 | iknub(jl))) |
---|
[1992] | 1405 | END IF |
---|
| 1406 | END DO |
---|
| 1407 | |
---|
| 1408 | ! *********************************************************** |
---|
| 1409 | |
---|
| 1410 | ! * 3. COMPUTE MOUNTAIN LIFT |
---|
| 1411 | |
---|
| 1412 | DO jl = kidia, kfdia |
---|
| 1413 | IF (ktest(jl)==1) THEN |
---|
[5111] | 1414 | ztau(jl, klev + 1) = -gklift * zrho(jl, klev + 1) * 2. * romega * & ! * |
---|
| 1415 | ! (2*PVAROR(JL)+PMEA(JL))* |
---|
| 1416 | 2 * pvaror(jl) * sin(zpi / 180. * plat(jl)) * pvlow(jl) |
---|
| 1417 | ztav(jl, klev + 1) = gklift * zrho(jl, klev + 1) * 2. * romega * & ! * |
---|
| 1418 | ! (2*PVAROR(JL)+PMEA(JL))* |
---|
| 1419 | 2 * pvaror(jl) * sin(zpi / 180. * plat(jl)) * pulow(jl) |
---|
[1992] | 1420 | ELSE |
---|
[5111] | 1421 | ztau(jl, klev + 1) = 0.0 |
---|
| 1422 | ztav(jl, klev + 1) = 0.0 |
---|
[1992] | 1423 | END IF |
---|
| 1424 | END DO |
---|
| 1425 | |
---|
| 1426 | ! * 4. COMPUTE LIFT PROFILE |
---|
| 1427 | ! * -------------------- |
---|
| 1428 | |
---|
| 1429 | DO jk = 1, klev |
---|
| 1430 | DO jl = kidia, kfdia |
---|
| 1431 | IF (ktest(jl)==1) THEN |
---|
[5111] | 1432 | ztau(jl, jk) = ztau(jl, klev + 1) * paphm1(jl, jk) / paphm1(jl, klev + 1) |
---|
| 1433 | ztav(jl, jk) = ztav(jl, klev + 1) * paphm1(jl, jk) / paphm1(jl, klev + 1) |
---|
[524] | 1434 | ELSE |
---|
[1992] | 1435 | ztau(jl, jk) = 0.0 |
---|
| 1436 | ztav(jl, jk) = 0.0 |
---|
| 1437 | END IF |
---|
| 1438 | END DO |
---|
| 1439 | END DO |
---|
[524] | 1440 | |
---|
| 1441 | |
---|
[1992] | 1442 | ! * 5. COMPUTE TENDENCIES. |
---|
| 1443 | ! * ------------------- |
---|
| 1444 | IF (lifthigh) THEN |
---|
| 1445 | ! PRINT *,' DANS OROLIFT: 500' |
---|
[524] | 1446 | |
---|
[1992] | 1447 | ! EXPLICIT SOLUTION AT ALL LEVELS |
---|
[766] | 1448 | |
---|
[1992] | 1449 | DO jk = 1, klev |
---|
| 1450 | DO jl = kidia, kfdia |
---|
| 1451 | IF (ktest(jl)==1) THEN |
---|
[5111] | 1452 | zdelp = paphm1(jl, jk + 1) - paphm1(jl, jk) |
---|
| 1453 | zdudt(jl) = -rg * (ztau(jl, jk + 1) - ztau(jl, jk)) / zdelp |
---|
| 1454 | zdvdt(jl) = -rg * (ztav(jl, jk + 1) - ztav(jl, jk)) / zdelp |
---|
[1992] | 1455 | END IF |
---|
| 1456 | END DO |
---|
| 1457 | END DO |
---|
[766] | 1458 | |
---|
[1992] | 1459 | ! PROJECT PERPENDICULARLY TO U NOT TO DESTROY ENERGY |
---|
[766] | 1460 | |
---|
[1992] | 1461 | DO jk = 1, klev |
---|
| 1462 | DO jl = kidia, kfdia |
---|
| 1463 | IF (ktest(jl)==1) THEN |
---|
[766] | 1464 | |
---|
[5111] | 1465 | zslow = sqrt(pulow(jl)**2 + pvlow(jl)**2) |
---|
| 1466 | zsqua = amax1(sqrt(pum1(jl, jk)**2 + pvm1(jl, jk)**2), gvsec) |
---|
| 1467 | zscav = -zdudt(jl) * pvm1(jl, jk) + zdvdt(jl) * pum1(jl, jk) |
---|
[1992] | 1468 | IF (zsqua>gvsec) THEN |
---|
[5111] | 1469 | pvom(jl, jk) = -zscav * pvm1(jl, jk) / zsqua**2 |
---|
| 1470 | pvol(jl, jk) = zscav * pum1(jl, jk) / zsqua**2 |
---|
[1992] | 1471 | ELSE |
---|
| 1472 | pvom(jl, jk) = 0.0 |
---|
| 1473 | pvol(jl, jk) = 0.0 |
---|
| 1474 | END IF |
---|
[5111] | 1475 | zsqua = sqrt(pum1(jl, jk)**2 + pum1(jl, jk)**2) |
---|
[1992] | 1476 | IF (zsqua<zslow) THEN |
---|
[5111] | 1477 | pvom(jl, jk) = zsqua / zslow * pvom(jl, jk) |
---|
| 1478 | pvol(jl, jk) = zsqua / zslow * pvol(jl, jk) |
---|
[1992] | 1479 | END IF |
---|
[766] | 1480 | |
---|
[1992] | 1481 | END IF |
---|
| 1482 | END DO |
---|
| 1483 | END DO |
---|
| 1484 | |
---|
| 1485 | ! 6. LOW LEVEL LIFT, SEMI IMPLICIT: |
---|
| 1486 | ! ---------------------------------- |
---|
| 1487 | |
---|
| 1488 | ELSE |
---|
| 1489 | |
---|
| 1490 | DO jl = kidia, kfdia |
---|
| 1491 | IF (ktest(jl)==1) THEN |
---|
| 1492 | DO jk = klev, iknub(jl), -1 |
---|
[5111] | 1493 | zbet = gklift * 2. * romega * sin(zpi / 180. * plat(jl)) * ztmst * & |
---|
| 1494 | (pgeom1(jl, iknub(jl) - 1) - pgeom1(jl, jk)) / & |
---|
| 1495 | (pgeom1(jl, iknub(jl) - 1) - pgeom1(jl, klev)) |
---|
| 1496 | zdudt(jl) = -pum1(jl, jk) / ztmst / (1 + zbet**2) |
---|
| 1497 | zdvdt(jl) = -pvm1(jl, jk) / ztmst / (1 + zbet**2) |
---|
| 1498 | pvom(jl, jk) = zbet**2 * zdudt(jl) - zbet * zdvdt(jl) |
---|
| 1499 | pvol(jl, jk) = zbet * zdudt(jl) + zbet**2 * zdvdt(jl) |
---|
[1992] | 1500 | END DO |
---|
| 1501 | END IF |
---|
| 1502 | END DO |
---|
| 1503 | |
---|
| 1504 | END IF |
---|
| 1505 | |
---|
| 1506 | END SUBROUTINE orolift |
---|
| 1507 | |
---|
| 1508 | |
---|
| 1509 | SUBROUTINE sugwd(nlon, nlev, paprs, pplay) |
---|
| 1510 | USE dimphy |
---|
[5110] | 1511 | USE lmdz_phys_para |
---|
| 1512 | USE lmdz_grid_phy |
---|
[5143] | 1513 | USE lmdz_YOEGWD, ONLY: GFRCRIT, GKWAKE, GRCRIT, GVCRIT, GKDRAG, GKLIFT, GHMAX, GRAHILO, GSIGCR, NKTOPG, NSTRA, GSSEC, GTSEC, GVSEC, & |
---|
| 1514 | GWD_RANDO_RUWMAX, gwd_rando_sat, GWD_FRONT_RUWMAX, gwd_front_sat |
---|
[1992] | 1515 | ! USE parallel |
---|
| 1516 | |
---|
| 1517 | ! **** *SUGWD* INITIALIZE COMMON YOEGWD CONTROLLING GRAVITY WAVE DRAG |
---|
| 1518 | |
---|
| 1519 | ! PURPOSE. |
---|
| 1520 | ! -------- |
---|
| 1521 | ! INITIALIZE YOEGWD, THE COMMON THAT CONTROLS THE |
---|
| 1522 | ! GRAVITY WAVE DRAG PARAMETRIZATION. |
---|
| 1523 | |
---|
| 1524 | ! ** INTERFACE. |
---|
| 1525 | ! ---------- |
---|
| 1526 | ! CALL *SUGWD* FROM *SUPHEC* |
---|
| 1527 | ! ----- ------ |
---|
| 1528 | |
---|
| 1529 | ! EXPLICIT ARGUMENTS : |
---|
| 1530 | ! -------------------- |
---|
| 1531 | ! PSIG : VERTICAL COORDINATE TABLE |
---|
| 1532 | ! NLEV : NUMBER OF MODEL LEVELS |
---|
| 1533 | |
---|
| 1534 | ! IMPLICIT ARGUMENTS : |
---|
| 1535 | ! -------------------- |
---|
| 1536 | ! COMMON YOEGWD |
---|
| 1537 | |
---|
| 1538 | ! METHOD. |
---|
| 1539 | ! ------- |
---|
| 1540 | ! SEE DOCUMENTATION |
---|
| 1541 | |
---|
| 1542 | ! EXTERNALS. |
---|
| 1543 | ! ---------- |
---|
| 1544 | ! NONE |
---|
| 1545 | |
---|
| 1546 | ! REFERENCE. |
---|
| 1547 | ! ---------- |
---|
| 1548 | ! ECMWF Research Department documentation of the IFS |
---|
| 1549 | |
---|
| 1550 | ! AUTHOR. |
---|
| 1551 | ! ------- |
---|
| 1552 | ! MARTIN MILLER *ECMWF* |
---|
| 1553 | |
---|
| 1554 | ! MODIFICATIONS. |
---|
| 1555 | ! -------------- |
---|
| 1556 | ! ORIGINAL : 90-01-01 |
---|
| 1557 | ! ------------------------------------------------------------------ |
---|
| 1558 | IMPLICIT NONE |
---|
| 1559 | |
---|
| 1560 | INTEGER nlon, nlev, jk |
---|
[5111] | 1561 | REAL paprs(nlon, nlev + 1) |
---|
[1992] | 1562 | REAL pplay(nlon, nlev) |
---|
| 1563 | REAL zpr, zstra, zsigt, zpm1r |
---|
| 1564 | REAL :: pplay_glo(klon_glo, nlev) |
---|
[5111] | 1565 | REAL :: paprs_glo(klon_glo, nlev + 1) |
---|
[1992] | 1566 | |
---|
| 1567 | ! * 1. SET THE VALUES OF THE PARAMETERS |
---|
| 1568 | ! -------------------------------- |
---|
| 1569 | |
---|
| 1570 | PRINT *, ' DANS SUGWD NLEV=', nlev |
---|
| 1571 | ghmax = 10000. |
---|
| 1572 | |
---|
| 1573 | zpr = 100000. |
---|
| 1574 | zstra = 0.1 |
---|
| 1575 | zsigt = 0.94 |
---|
| 1576 | ! old ZPR=80000. |
---|
| 1577 | ! old ZSIGT=0.85 |
---|
| 1578 | |
---|
| 1579 | CALL gather(pplay, pplay_glo) |
---|
| 1580 | CALL bcast(pplay_glo) |
---|
| 1581 | CALL gather(paprs, paprs_glo) |
---|
| 1582 | CALL bcast(paprs_glo) |
---|
| 1583 | |
---|
| 1584 | DO jk = 1, nlev |
---|
[5111] | 1585 | zpm1r = pplay_glo((klon_glo / 2) + 1, jk) / paprs_glo((klon_glo / 2) + 1, 1) |
---|
[1992] | 1586 | IF (zpm1r>=zsigt) THEN |
---|
| 1587 | nktopg = jk |
---|
| 1588 | END IF |
---|
[5111] | 1589 | zpm1r = pplay_glo((klon_glo / 2) + 1, jk) / paprs_glo((klon_glo / 2) + 1, 1) |
---|
[1992] | 1590 | IF (zpm1r>=zstra) THEN |
---|
| 1591 | nstra = jk |
---|
| 1592 | END IF |
---|
| 1593 | END DO |
---|
| 1594 | |
---|
| 1595 | |
---|
| 1596 | |
---|
| 1597 | ! inversion car dans orodrag on compte les niveaux a l'envers |
---|
| 1598 | nktopg = nlev - nktopg + 1 |
---|
| 1599 | nstra = nlev - nstra |
---|
| 1600 | PRINT *, ' DANS SUGWD nktopg=', nktopg |
---|
| 1601 | PRINT *, ' DANS SUGWD nstra=', nstra |
---|
| 1602 | |
---|
| 1603 | gsigcr = 0.80 |
---|
| 1604 | |
---|
[5111] | 1605 | ! Values now specified in run.def, or conf_phys_m.F90 |
---|
| 1606 | ! gkdrag = 0.2 |
---|
| 1607 | ! grahilo = 1. |
---|
| 1608 | ! grcrit = 0.01 |
---|
| 1609 | ! gfrcrit = 1.0 |
---|
| 1610 | ! gkwake = 0.50 |
---|
| 1611 | ! gklift = 0.50 |
---|
[1992] | 1612 | gvcrit = 0.0 |
---|
| 1613 | |
---|
| 1614 | ! ---------------------------------------------------------------- |
---|
| 1615 | |
---|
| 1616 | ! * 2. SET VALUES OF SECURITY PARAMETERS |
---|
| 1617 | ! --------------------------------- |
---|
| 1618 | |
---|
| 1619 | gvsec = 0.10 |
---|
| 1620 | gssec = 1.E-12 |
---|
| 1621 | |
---|
| 1622 | gtsec = 1.E-07 |
---|
| 1623 | |
---|
| 1624 | ! ---------------------------------------------------------------- |
---|
| 1625 | |
---|
| 1626 | END SUBROUTINE sugwd |
---|