| 1 |
SUBROUTINE gwprofil(nlon,nlev,kgwd,kdx,ktest,kkcrith,kcrit,paphm1,prho, & |
| 2 |
pstab,pvph,pri,ptau,pdmod,psig,pvar) |
| 3 |
|
| 4 |
!**** *GWPROFIL* |
| 5 |
|
| 6 |
! PURPOSE. |
| 7 |
! -------- |
| 8 |
|
| 9 |
!** INTERFACE. |
| 10 |
! ---------- |
| 11 |
! FROM *GWDRAG* |
| 12 |
|
| 13 |
! EXPLICIT ARGUMENTS : |
| 14 |
! -------------------- |
| 15 |
! ==== INPUTS === |
| 16 |
! ==== OUTPUTS === |
| 17 |
|
| 18 |
! IMPLICIT ARGUMENTS : NONE |
| 19 |
! -------------------- |
| 20 |
|
| 21 |
! METHOD: |
| 22 |
! ------- |
| 23 |
! THE STRESS PROFILE FOR GRAVITY WAVES IS COMPUTED AS FOLLOWS: |
| 24 |
! IT IS CONSTANT (NO GWD) AT THE LEVELS BETWEEN THE GROUND |
| 25 |
! AND THE TOP OF THE BLOCKED LAYER (KKENVH). |
| 26 |
! IT DECREASES LINEARLY WITH HEIGHTS FROM THE TOP OF THE |
| 27 |
! BLOCKED LAYER TO 3*VAROR (kKNU), TO SIMULATES LEE WAVES OR |
| 28 |
! NONLINEAR GRAVITY WAVE BREAKING. |
| 29 |
! ABOVE IT IS CONSTANT, EXCEPT WHEN THE WAVE ENCOUNTERS A CRITICAL |
| 30 |
! LEVEL (KCRIT) OR WHEN IT BREAKS. |
| 31 |
|
| 32 |
|
| 33 |
|
| 34 |
! EXTERNALS. |
| 35 |
! ---------- |
| 36 |
|
| 37 |
|
| 38 |
! REFERENCE. |
| 39 |
! ---------- |
| 40 |
|
| 41 |
! SEE ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S." |
| 42 |
|
| 43 |
! AUTHOR. |
| 44 |
! ------- |
| 45 |
|
| 46 |
! MODIFICATIONS. |
| 47 |
! -------------- |
| 48 |
! PASSAGE OF THE NEW GWDRAG TO I.F.S. (F. LOTT, 22/11/93) |
| 49 |
!----------------------------------------------------------------------- |
| 50 |
USE dimens_m |
| 51 |
USE dimphy |
| 52 |
USE suphec_m |
| 53 |
USE yoegwd |
| 54 |
IMPLICIT NONE |
| 55 |
|
| 56 |
|
| 57 |
|
| 58 |
|
| 59 |
|
| 60 |
!----------------------------------------------------------------------- |
| 61 |
|
| 62 |
!* 0.1 ARGUMENTS |
| 63 |
! --------- |
| 64 |
|
| 65 |
INTEGER nlon, nlev |
| 66 |
INTEGER kkcrith(nlon), kcrit(nlon), kdx(nlon), ktest(nlon) |
| 67 |
|
| 68 |
|
| 69 |
REAL paphm1(nlon,nlev+1), pstab(nlon,nlev+1), prho(nlon,nlev+1), & |
| 70 |
pvph(nlon,nlev+1), pri(nlon,nlev+1), ptau(nlon,nlev+1) |
| 71 |
|
| 72 |
REAL pdmod(nlon) |
| 73 |
REAL, INTENT (IN) :: psig(nlon) |
| 74 |
REAL, INTENT (IN) :: pvar(nlon) |
| 75 |
|
| 76 |
!----------------------------------------------------------------------- |
| 77 |
|
| 78 |
!* 0.2 LOCAL ARRAYS |
| 79 |
! ------------ |
| 80 |
|
| 81 |
INTEGER ilevh, ji, kgwd, jl, jk |
| 82 |
REAL zsqr, zalfa, zriw, zdel, zb, zalpha, zdz2n |
| 83 |
REAL zdelp, zdelpt |
| 84 |
REAL zdz2(klon,klev), znorm(klon), zoro(klon) |
| 85 |
REAL ztau(klon,klev+1) |
| 86 |
|
| 87 |
!----------------------------------------------------------------------- |
| 88 |
|
| 89 |
!* 1. INITIALIZATION |
| 90 |
! -------------- |
| 91 |
|
| 92 |
! print *,' entree gwprofil' |
| 93 |
100 CONTINUE |
| 94 |
|
| 95 |
|
| 96 |
!* COMPUTATIONAL CONSTANTS. |
| 97 |
! ------------- ---------- |
| 98 |
|
| 99 |
ilevh = klev/3 |
| 100 |
|
| 101 |
! DO 400 ji=1,kgwd |
| 102 |
! jl=kdx(ji) |
| 103 |
! Modif vectorisation 02/04/2004 |
| 104 |
DO 400 jl = 1, klon |
| 105 |
IF (ktest(jl)==1) THEN |
| 106 |
zoro(jl) = psig(jl)*pdmod(jl)/4./max(pvar(jl),1.0) |
| 107 |
ztau(jl,klev+1) = ptau(jl,klev+1) |
| 108 |
END IF |
| 109 |
400 CONTINUE |
| 110 |
|
| 111 |
|
| 112 |
DO 430 jk = klev, 2, -1 |
| 113 |
|
| 114 |
|
| 115 |
!* 4.1 CONSTANT WAVE STRESS UNTIL TOP OF THE |
| 116 |
! BLOCKING LAYER. |
| 117 |
410 CONTINUE |
| 118 |
|
| 119 |
! DO 411 ji=1,kgwd |
| 120 |
! jl=kdx(ji) |
| 121 |
! Modif vectorisation 02/04/2004 |
| 122 |
DO 411 jl = 1, klon |
| 123 |
IF (ktest(jl)==1) THEN |
| 124 |
IF (jk>kkcrith(jl)) THEN |
| 125 |
ptau(jl,jk) = ztau(jl,klev+1) |
| 126 |
! ENDIF |
| 127 |
! IF(JK.EQ.KKCRITH(JL)) THEN |
| 128 |
ELSE |
| 129 |
ptau(jl,jk) = grahilo*ztau(jl,klev+1) |
| 130 |
END IF |
| 131 |
END IF |
| 132 |
411 CONTINUE |
| 133 |
|
| 134 |
!* 4.15 CONSTANT SHEAR STRESS UNTIL THE TOP OF THE |
| 135 |
! LOW LEVEL FLOW LAYER. |
| 136 |
415 CONTINUE |
| 137 |
|
| 138 |
|
| 139 |
!* 4.2 WAVE DISPLACEMENT AT NEXT LEVEL. |
| 140 |
|
| 141 |
420 CONTINUE |
| 142 |
|
| 143 |
! DO 421 ji=1,kgwd |
| 144 |
! jl=kdx(ji) |
| 145 |
! Modif vectorisation 02/04/2004 |
| 146 |
DO 421 jl = 1, klon |
| 147 |
IF (ktest(jl)==1) THEN |
| 148 |
IF (jk<kkcrith(jl)) THEN |
| 149 |
znorm(jl) = gkdrag*prho(jl,jk)*sqrt(pstab(jl,jk))*pvph(jl,jk)* & |
| 150 |
zoro(jl) |
| 151 |
zdz2(jl,jk) = ptau(jl,jk+1)/max(znorm(jl),gssec) |
| 152 |
END IF |
| 153 |
END IF |
| 154 |
421 CONTINUE |
| 155 |
|
| 156 |
!* 4.3 WAVE RICHARDSON NUMBER, NEW WAVE DISPLACEMENT |
| 157 |
!* AND STRESS: BREAKING EVALUATION AND CRITICAL |
| 158 |
! LEVEL |
| 159 |
|
| 160 |
|
| 161 |
! DO 431 ji=1,kgwd |
| 162 |
! jl=Kdx(ji) |
| 163 |
! Modif vectorisation 02/04/2004 |
| 164 |
DO 431 jl = 1, klon |
| 165 |
IF (ktest(jl)==1) THEN |
| 166 |
|
| 167 |
IF (jk<kkcrith(jl)) THEN |
| 168 |
IF ((ptau(jl,jk+1)<gtsec) .OR. (jk<=kcrit(jl))) THEN |
| 169 |
ptau(jl,jk) = 0.0 |
| 170 |
ELSE |
| 171 |
zsqr = sqrt(pri(jl,jk)) |
| 172 |
zalfa = sqrt(pstab(jl,jk)*zdz2(jl,jk))/pvph(jl,jk) |
| 173 |
zriw = pri(jl,jk)*(1.-zalfa)/(1+zalfa*zsqr)**2 |
| 174 |
IF (zriw<grcrit) THEN |
| 175 |
zdel = 4./zsqr/grcrit + 1./grcrit**2 + 4./grcrit |
| 176 |
zb = 1./grcrit + 2./zsqr |
| 177 |
zalpha = 0.5*(-zb+sqrt(zdel)) |
| 178 |
zdz2n = (pvph(jl,jk)*zalpha)**2/pstab(jl,jk) |
| 179 |
ptau(jl,jk) = znorm(jl)*zdz2n |
| 180 |
ELSE |
| 181 |
ptau(jl,jk) = znorm(jl)*zdz2(jl,jk) |
| 182 |
END IF |
| 183 |
ptau(jl,jk) = min(ptau(jl,jk),ptau(jl,jk+1)) |
| 184 |
END IF |
| 185 |
END IF |
| 186 |
END IF |
| 187 |
431 CONTINUE |
| 188 |
|
| 189 |
430 CONTINUE |
| 190 |
440 CONTINUE |
| 191 |
|
| 192 |
! REORGANISATION OF THE STRESS PROFILE AT LOW LEVEL |
| 193 |
|
| 194 |
! DO 530 ji=1,kgwd |
| 195 |
! jl=kdx(ji) |
| 196 |
! Modif vectorisation 02/04/2004 |
| 197 |
DO 530 jl = 1, klon |
| 198 |
IF (ktest(jl)==1) THEN |
| 199 |
ztau(jl,kkcrith(jl)) = ptau(jl,kkcrith(jl)) |
| 200 |
ztau(jl,nstra) = ptau(jl,nstra) |
| 201 |
END IF |
| 202 |
530 CONTINUE |
| 203 |
|
| 204 |
DO 531 jk = 1, klev |
| 205 |
|
| 206 |
! DO 532 ji=1,kgwd |
| 207 |
! jl=kdx(ji) |
| 208 |
! Modif vectorisation 02/04/2004 |
| 209 |
DO 532 jl = 1, klon |
| 210 |
IF (ktest(jl)==1) THEN |
| 211 |
|
| 212 |
|
| 213 |
IF (jk>kkcrith(jl)) THEN |
| 214 |
|
| 215 |
zdelp = paphm1(jl,jk) - paphm1(jl,klev+1) |
| 216 |
zdelpt = paphm1(jl,kkcrith(jl)) - paphm1(jl,klev+1) |
| 217 |
ptau(jl,jk) = ztau(jl,klev+1) + (ztau(jl,kkcrith(jl))-ztau(jl, & |
| 218 |
klev+1))*zdelp/zdelpt |
| 219 |
|
| 220 |
END IF |
| 221 |
|
| 222 |
END IF |
| 223 |
532 CONTINUE |
| 224 |
|
| 225 |
! REORGANISATION IN THE STRATOSPHERE |
| 226 |
|
| 227 |
! DO 533 ji=1,kgwd |
| 228 |
! jl=kdx(ji) |
| 229 |
! Modif vectorisation 02/04/2004 |
| 230 |
DO 533 jl = 1, klon |
| 231 |
IF (ktest(jl)==1) THEN |
| 232 |
|
| 233 |
|
| 234 |
IF (jk<nstra) THEN |
| 235 |
|
| 236 |
zdelp = paphm1(jl,nstra) |
| 237 |
zdelpt = paphm1(jl,jk) |
| 238 |
ptau(jl,jk) = ztau(jl,nstra)*zdelpt/zdelp |
| 239 |
|
| 240 |
END IF |
| 241 |
|
| 242 |
END IF |
| 243 |
533 CONTINUE |
| 244 |
|
| 245 |
! REORGANISATION IN THE TROPOSPHERE |
| 246 |
|
| 247 |
! DO 534 ji=1,kgwd |
| 248 |
! jl=kdx(ji) |
| 249 |
! Modif vectorisation 02/04/2004 |
| 250 |
DO 534 jl = 1, klon |
| 251 |
IF (ktest(jl)==1) THEN |
| 252 |
|
| 253 |
|
| 254 |
IF (jk<kkcrith(jl) .AND. jk>nstra) THEN |
| 255 |
|
| 256 |
zdelp = paphm1(jl,jk) - paphm1(jl,kkcrith(jl)) |
| 257 |
zdelpt = paphm1(jl,nstra) - paphm1(jl,kkcrith(jl)) |
| 258 |
ptau(jl,jk) = ztau(jl,kkcrith(jl)) + (ztau(jl,nstra)-ztau(jl, & |
| 259 |
kkcrith(jl)))*zdelp/zdelpt |
| 260 |
|
| 261 |
END IF |
| 262 |
END IF |
| 263 |
534 CONTINUE |
| 264 |
|
| 265 |
|
| 266 |
531 CONTINUE |
| 267 |
|
| 268 |
|
| 269 |
RETURN |
| 270 |
END |
Parent Directory
| 
Revision Log