1 |
guez |
23 |
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 |
guez |
38 |
USE suphec_m |
53 |
guez |
23 |
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 |