Context Navigation

orodrag.F @ 1242

Last change on this file since 1242 was 1226, checked in by aslmd, 11 years ago
LMDZ.MARS : Replaced comcstfi and planete includes by modules.
File size: 8.3 KB

Line
1	SUBROUTINE ORODRAG( klon,klev
2	I , KGWD, KGWDIM, KDX, KTEST
3	R , PTSPHY
4	R , PAPHM1,PAPM1,PGEOM1,PTM1,PUM1
5	R , PVM1, PVAROR, PSIG, PGAMMA, PTHETA
6	C OUTPUTS
7	R , PULOW,PVLOW
8	R , PVOM,PVOL,PTE )
9	C
10	C
11	C**** ORODRAG - DOES THE GRAVITY WAVE PARAMETRIZATION.
12	C
13	C PURPOSE.
14	C --------
15	C
16	C THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE
17	C PROGNOSTIC VARIABLES U,V AND T DUE TO VERTICAL TRANSPORTS BY
18	C SUBGRIDSCALE OROGRAPHICALLY EXCITED GRAVITY WAVES
19	C
20	C EXPLICIT ARGUMENTS :
21	C --------------------
22	C
23	C INPUT :
24	C
25	C NLON : NUMBER OF HORIZONTAL GRID POINTS
26	C NLEV : NUMBER OF LEVELS
27	C KGWD : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
28	C KGWDIM : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
29	C KDX(NLON) : POINTS AT WHICH TO CALL THE SCHEME
30	C KTEST(NLON) : MAP OF CALLING POINTS
31	C PTSPHY : LENGTH OF TIME STEP
32	C PAPHM1(NLON,NLEV+1): PRESSURE AT MIDDLE LEVELS
33	C PAPM1(NLON,NLEV) : PRESSURE ON MODEL LEVELS
34	C PGEOM1(NLON,NLEV) : GEOPOTENTIAL HIEGHT OF MODEL LEVELS
35	C PTM1(NLON,NLEV) : TEMPERATURE
36	C PUM1(NLON,NLEV) : ZONAL WIND
37	C PVM1(NLON,NLEV) : MERIDIONAL WIND
38	C PVAROR(NLON) : SUB-GRID SCALE STANDARD DEVIATION
39	C PSIG(NLON) : SUB-GRID SCALE SLOPE
40	C PGAMMA(NLON) : SUB-GRID SCALE ANISOTROPY
41	C PTHETA(NLON) : SUB-GRID SCALE PRINCIPAL AXES ANGLE
42	C
43	C OUTPUT :
44	C
45	C PULOW(NLON) : LOW LEVEL ZONAL WIND
46	C PVLOW(NLON) : LOW LEVEL MERIDIONAL WIND
47	C PVOM(NLON,NLEV) : ZONAL WIND TENDENCY
48	C PVOL(NLON,NLEV) : MERIDIONAL WIND TENDENCY
49	C PTE(NLON,NLEV) : TEMPERATURE TENDENCY
50	C
51	C IMPLICIT ARGUMENTS :
52	C --------------------
53	C
54	C comcstfi.h
55	C dimphys.h
56	C yoegwd.h
57	C
58	C METHOD.
59	C -------
60	C
61	C EXTERNALS.
62	C ----------
63	C
64	C REFERENCE.
65	C ----------
66	C
67	C AUTHOR.
68	C -------
69	C M.MILLER + B.RITTER E.C.M.W.F. 15/06/86.
70	C
71	C F.LOTT + M. MILLER E.C.M.W.F. 22/11/94
72	C-----------------------------------------------------------------------
73	use dimradmars_mod, only: ndlo2
74	USE comcstfi_h
75	implicit none
76	C
77	C
78	#include "dimensions.h"
79	#include "dimphys.h"
80	!#include "dimradmars.h"
81	integer klon,klev,kidia
82	parameter(kidia=1)
83	integer, save :: kfdia ! =NDLO2
84
85	#include "yoegwd.h"
86	C-----------------------------------------------------------------------
87	C
88	C* 0.1 ARGUMENTS
89	C ---------
90	C
91	C
92	REAL PTE(NDLO2,klev),
93	* PVOL(NDLO2,klev),
94	* PVOM(NDLO2,klev),
95	* PULOW(NDLO2),
96	* PVLOW(NDLO2)
97	REAL PUM1(NDLO2,klev),
98	* PVM1(NDLO2,klev),
99	* PTM1(NDLO2,klev),
100	* PVAROR(NDLO2),PSIG(NDLO2),PGAMMA(NDLO2),PTHETA(NDLO2),
101	* PGEOM1(NDLO2,klev),
102	* PAPM1(NDLO2,klev),
103	* PAPHM1(NDLO2,klev+1)
104	C
105	integer kgwd,kgwdim
106	real ptsphy
107	INTEGER KDX(NDLO2),KTEST(NDLO2)
108	C-----------------------------------------------------------------------
109	C
110	C* 0.2 LOCAL ARRAYS
111	C ------------
112	INTEGER ISECT(NDLO2),
113	* ICRIT(NDLO2),
114	* IKCRITH(NDLO2),
115	* IKenvh(NDLO2),
116	* IKNU(NDLO2),
117	* IKNU2(NDLO2),
118	* IKCRIT(NDLO2),
119	* IKHLIM(NDLO2)
120	integer ji,jk,jl,klevm1,ilevp1
121	C real gkwake
122	real ztmst,pvar,ztauf,zrtmst,zdelp,zb,zc,zbet
123	real zconb,zabsv,zzd1,ratio,zust,zvst,zdis,ztemp
124	C
125	REAL ZTAU(NDLO2,nlayermx+1),
126	* ZSTAB(NDLO2,nlayermx+1),
127	* ZVPH(NDLO2,nlayermx+1),
128	* ZRHO(NDLO2,nlayermx+1),
129	* ZRI(NDLO2,nlayermx+1),
130	* ZpsI(NDLO2,nlayermx+1),
131	* Zzdep(NDLO2,nlayermx)
132	REAL ZDUDT(NDLO2),
133	* ZDVDT(NDLO2),
134	* ZDTDT(NDLO2),
135	* ZDEDT(NDLO2),
136	* ZVIDIS(NDLO2),
137	* ZTFR(NDLO2),
138	* Znu(NDLO2),
139	* Zd1(NDLO2),
140	* Zd2(NDLO2),
141	* Zdmod(NDLO2)
142	C
143	C------------------------------------------------------------------
144	C
145	C* 1. INITIALIZATION
146	C --------------
147	C
148	100 CONTINUE
149	C
150	C ------------------------------------------------------------------
151	C
152	C* 1.1 COMPUTATIONAL CONSTANTS
153	C -----------------------
154	C
155	110 CONTINUE
156	C
157	kfdia=NDLO2
158
159	c ZTMST=TWODT
160	c IF(NSTEP.EQ.NSTART) ZTMST=0.5*TWODT
161	KLEVM1=KLEV-1
162	ZTMST=PTSPHY
163	ZRTMST=1./ZTMST
164	C ------------------------------------------------------------------
165	C
166	120 CONTINUE
167	C
168	C ------------------------------------------------------------------
169	C
170	C* 1.3 CHECK WHETHER ROW CONTAINS POINT FOR PRINTING
171	C ---------------------------------------------
172	C
173	130 CONTINUE
174	C
175	C ------------------------------------------------------------------
176	C
177	C* 2. PRECOMPUTE BASIC STATE VARIABLES.
178	C* ---------- ----- ----- ----------
179	C* DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
180	C* LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
181	C* THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
182	C
183	200 CONTINUE
184	C
185	C
186	C
187	CALL OROSETUP
188	* ( klon, klev , KTEST
189	* , IKCRIT, IKCRITH, ICRIT, ISECT, IKHLIM, ikenvh,IKNU,iknu2
190	* , PAPHM1, PAPM1 , PUM1 , PVM1 , PTM1 , PGEOM1, pvaror
191	* , ZRHO , ZRI , ZSTAB , ZTAU , ZVPH , zpsi, zzdep
192	* , PULOW, PVLOW
193	* , ptheta,pgamma,znu ,zd1, zd2, zdmod )
194	C
195	C
196	C
197	C***********************************************************
198	C
199	C
200	C* 3. COMPUTE LOW LEVEL STRESSES USING SUBCRITICAL AND
201	C* SUPERCRITICAL FORMS.COMPUTES ANISOTROPY COEFFICIENT
202	C* AS MEASURE OF OROGRAPHIC TWODIMENSIONALITY.
203	C
204	300 CONTINUE
205	C
206	CALL GWSTRESS
207	* ( klon , klev
208	* , IKCRIT, ISECT, IKHLIM, KTEST, IKCRITH, ICRIT, ikenvh, IKNU
209	* , ZRHO , ZSTAB, ZVPH , PVAR , pvaror, psig
210	* , ZTFR , ZTAU
211	* , pgeom1,pgamma,zd1,zd2,zdmod,znu)
212	C
213	C* 4. COMPUTE STRESS PROFILE.
214	C* ------- ------ --------
215	C
216	400 CONTINUE
217	C
218	C
219	CALL GWPROFIL
220	* ( klon , klev
221	* , kgwd , kdx , KTEST
222	* , IKCRIT, IKCRITH, ICRIT , ikenvh, IKNU
223	* ,iknu2 , pAPHM1, ZRHO , ZSTAB , ZTFR , ZVPH
224	* , ZRI , ZTAU , ztauf
225	* , zdmod , znu , psig , pgamma , pvaror )
226	C
227	C
228	C* 5. COMPUTE TENDENCIES.
229	C* -------------------
230	C
231	500 CONTINUE
232	C
233	C EXPLICIT SOLUTION AT ALL LEVELS FOR THE GRAVITY WAVE
234	C IMPLICIT SOLUTION FOR THE BLOCKED LEVELS
235
236	DO 510 JL=KIDIA,KFDIA
237	ZVIDIS(JL)=0.0
238	ZDUDT(JL)=0.0
239	ZDVDT(JL)=0.0
240	ZDTDT(JL)=0.0
241	510 CONTINUE
242	C
243	ILEVP1=KLEV+1
244	C
245	C
246	DO 524 JK=1,klev
247	C
248	CDIR$ IVDEP
249	C
250	C GKWAKE=0.5
251	C
252	C NOW SET IN SUGWD.F
253	C
254	DO 523 JL=1,KGWD
255	JI=KDX(JL)
256	ZDELP=pAPHM1(Ji,JK+1)-pAPHM1(Ji,JK)
257	ZTEMP=-g(ZTAU(Ji,JK+1)-ZTAU(Ji,JK))/(ZVPH(Ji,ILEVP1)ZDELP)
258	ZDUDT(JI)=(PULOW(JI)Zd1(ji)-pvlow(ji)zd2(ji))*ztemp/zdmod(ji)
259	ZDVDT(JI)=(pvLOW(JI)Zd1(ji)+pulow(ji)zd2(ji))*ztemp/zdmod(ji)
260	if(jk.ge.ikenvh(ji)) then
261	zb=1.0-0.18pgamma(ji)-0.04pgamma(ji)**2
262	zc=0.48pgamma(ji)+0.3pgamma(ji)**2
263	zconb=2.ztmstGKWAKEpsig(ji)/(4.pvaror(ji))
264	zabsv=sqrt(PUM1(JI,JK)2+PVM1(JI,JK)2)/2.
265	zzd1=zbcos(zpsi(ji,jk))2+zcsin(zpsi(ji,jk))**2
266	ratio=(cos(zpsi(ji,jk))*2+pgamma(ji)sin(zpsi(ji,jk))**2)/
267	* (pgamma(ji)cos(zpsi(ji,jk))2+sin(zpsi(ji,jk))*2)
268	zbet=max(0.,2.-1./ratio)zconbzzdep(ji,jk)zzd1zabsv
269	zdudt(ji)=-pum1(ji,jk)/ztmst
270	zdvdt(ji)=-pvm1(ji,jk)/ztmst
271	zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
272	zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
273	end if
274	PVOM(JI,JK)=ZDUDT(JI)
275	PVOL(JI,JK)=ZDVDT(JI)
276	ZUST=PUM1(JI,JK)+ZTMST*ZDUDT(JI)
277	ZVST=PVM1(JI,JK)+ZTMST*ZDVDT(JI)
278	ZDIS=0.5(PUM1(JI,JK)2+PVM1(JI,JK)2-ZUST2-ZVST*2)
279	ZDEDT(JI)=ZDIS/ZTMST
280	ZVIDIS(JI)=ZVIDIS(JI)+ZDIS*ZDELP
281	ZDTDT(JI)=ZDEDT(JI)/cpp
282	PTE(JI,JK)=ZDTDT(JI)
283
284	523 CONTINUE
285
286	524 CONTINUE
287	C
288	C
289	RETURN
290	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format