Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

orodrag.F @ 414

Last change on this file since 414 was 38, checked in by emillour, 14 years ago
Ajout du modè Martien (mon LMDZ.MARS.BETA, du 28/01/2011) dans le rértoire mars, pour pouvoir suivre plus facilement les modifs. EM
File size: 8.2 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	implicit none
74	C
75	C
76	#include "dimensions.h"
77	#include "dimphys.h"
78	#include "dimradmars.h"
79	integer klon,klev,kidia,kfdia
80	parameter(kidia=1,kfdia=NDLO2)
81
82	#include "comcstfi.h"
83	#include "yoegwd.h"
84	C-----------------------------------------------------------------------
85	C
86	C* 0.1 ARGUMENTS
87	C ---------
88	C
89	C
90	REAL PTE(NDLO2,klev),
91	* PVOL(NDLO2,klev),
92	* PVOM(NDLO2,klev),
93	* PULOW(NDLO2),
94	* PVLOW(NDLO2)
95	REAL PUM1(NDLO2,klev),
96	* PVM1(NDLO2,klev),
97	* PTM1(NDLO2,klev),
98	* PVAROR(NDLO2),PSIG(NDLO2),PGAMMA(NDLO2),PTHETA(NDLO2),
99	* PGEOM1(NDLO2,klev),
100	* PAPM1(NDLO2,klev),
101	* PAPHM1(NDLO2,klev+1)
102	C
103	integer kgwd,kgwdim
104	real ptsphy
105	INTEGER KDX(NDLO2),KTEST(NDLO2)
106	C-----------------------------------------------------------------------
107	C
108	C* 0.2 LOCAL ARRAYS
109	C ------------
110	INTEGER ISECT(NDLO2),
111	* ICRIT(NDLO2),
112	* IKCRITH(NDLO2),
113	* IKenvh(NDLO2),
114	* IKNU(NDLO2),
115	* IKNU2(NDLO2),
116	* IKCRIT(NDLO2),
117	* IKHLIM(NDLO2)
118	integer ji,jk,jl,klevm1,ilevp1
119	C real gkwake
120	real ztmst,pvar,ztauf,zrtmst,zdelp,zb,zc,zbet
121	real zconb,zabsv,zzd1,ratio,zust,zvst,zdis,ztemp
122	C
123	REAL ZTAU(NDLO2,nlayermx+1),
124	* ZSTAB(NDLO2,nlayermx+1),
125	* ZVPH(NDLO2,nlayermx+1),
126	* ZRHO(NDLO2,nlayermx+1),
127	* ZRI(NDLO2,nlayermx+1),
128	* ZpsI(NDLO2,nlayermx+1),
129	* Zzdep(NDLO2,nlayermx)
130	REAL ZDUDT(NDLO2),
131	* ZDVDT(NDLO2),
132	* ZDTDT(NDLO2),
133	* ZDEDT(NDLO2),
134	* ZVIDIS(NDLO2),
135	* ZTFR(NDLO2),
136	* Znu(NDLO2),
137	* Zd1(NDLO2),
138	* Zd2(NDLO2),
139	* Zdmod(NDLO2)
140	C
141	C------------------------------------------------------------------
142	C
143	C* 1. INITIALIZATION
144	C --------------
145	C
146	100 CONTINUE
147	C
148	C ------------------------------------------------------------------
149	C
150	C* 1.1 COMPUTATIONAL CONSTANTS
151	C -----------------------
152	C
153	110 CONTINUE
154	C
155	c ZTMST=TWODT
156	c IF(NSTEP.EQ.NSTART) ZTMST=0.5*TWODT
157	KLEVM1=KLEV-1
158	ZTMST=PTSPHY
159	ZRTMST=1./ZTMST
160	C ------------------------------------------------------------------
161	C
162	120 CONTINUE
163	C
164	C ------------------------------------------------------------------
165	C
166	C* 1.3 CHECK WHETHER ROW CONTAINS POINT FOR PRINTING
167	C ---------------------------------------------
168	C
169	130 CONTINUE
170	C
171	C ------------------------------------------------------------------
172	C
173	C* 2. PRECOMPUTE BASIC STATE VARIABLES.
174	C* ---------- ----- ----- ----------
175	C* DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
176	C* LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
177	C* THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
178	C
179	200 CONTINUE
180	C
181	C
182	C
183	CALL OROSETUP
184	* ( klon, klev , KTEST
185	* , IKCRIT, IKCRITH, ICRIT, ISECT, IKHLIM, ikenvh,IKNU,iknu2
186	* , PAPHM1, PAPM1 , PUM1 , PVM1 , PTM1 , PGEOM1, pvaror
187	* , ZRHO , ZRI , ZSTAB , ZTAU , ZVPH , zpsi, zzdep
188	* , PULOW, PVLOW
189	* , ptheta,pgamma,znu ,zd1, zd2, zdmod )
190	C
191	C
192	C
193	C***********************************************************
194	C
195	C
196	C* 3. COMPUTE LOW LEVEL STRESSES USING SUBCRITICAL AND
197	C* SUPERCRITICAL FORMS.COMPUTES ANISOTROPY COEFFICIENT
198	C* AS MEASURE OF OROGRAPHIC TWODIMENSIONALITY.
199	C
200	300 CONTINUE
201	C
202	CALL GWSTRESS
203	* ( klon , klev
204	* , IKCRIT, ISECT, IKHLIM, KTEST, IKCRITH, ICRIT, ikenvh, IKNU
205	* , ZRHO , ZSTAB, ZVPH , PVAR , pvaror, psig
206	* , ZTFR , ZTAU
207	* , pgeom1,pgamma,zd1,zd2,zdmod,znu)
208	C
209	C* 4. COMPUTE STRESS PROFILE.
210	C* ------- ------ --------
211	C
212	400 CONTINUE
213	C
214	C
215	CALL GWPROFIL
216	* ( klon , klev
217	* , kgwd , kdx , KTEST
218	* , IKCRIT, IKCRITH, ICRIT , ikenvh, IKNU
219	* ,iknu2 , pAPHM1, ZRHO , ZSTAB , ZTFR , ZVPH
220	* , ZRI , ZTAU , ztauf
221	* , zdmod , znu , psig , pgamma , pvaror )
222	C
223	C
224	C* 5. COMPUTE TENDENCIES.
225	C* -------------------
226	C
227	500 CONTINUE
228	C
229	C EXPLICIT SOLUTION AT ALL LEVELS FOR THE GRAVITY WAVE
230	C IMPLICIT SOLUTION FOR THE BLOCKED LEVELS
231
232	DO 510 JL=KIDIA,KFDIA
233	ZVIDIS(JL)=0.0
234	ZDUDT(JL)=0.0
235	ZDVDT(JL)=0.0
236	ZDTDT(JL)=0.0
237	510 CONTINUE
238	C
239	ILEVP1=KLEV+1
240	C
241	C
242	DO 524 JK=1,klev
243	C
244	CDIR$ IVDEP
245	C
246	C GKWAKE=0.5
247	C
248	C NOW SET IN SUGWD.F
249	C
250	DO 523 JL=1,KGWD
251	JI=KDX(JL)
252	ZDELP=pAPHM1(Ji,JK+1)-pAPHM1(Ji,JK)
253	ZTEMP=-g(ZTAU(Ji,JK+1)-ZTAU(Ji,JK))/(ZVPH(Ji,ILEVP1)ZDELP)
254	ZDUDT(JI)=(PULOW(JI)Zd1(ji)-pvlow(ji)zd2(ji))*ztemp/zdmod(ji)
255	ZDVDT(JI)=(pvLOW(JI)Zd1(ji)+pulow(ji)zd2(ji))*ztemp/zdmod(ji)
256	if(jk.ge.ikenvh(ji)) then
257	zb=1.0-0.18pgamma(ji)-0.04pgamma(ji)**2
258	zc=0.48pgamma(ji)+0.3pgamma(ji)**2
259	zconb=2.ztmstGKWAKEpsig(ji)/(4.pvaror(ji))
260	zabsv=sqrt(PUM1(JI,JK)2+PVM1(JI,JK)2)/2.
261	zzd1=zbcos(zpsi(ji,jk))2+zcsin(zpsi(ji,jk))**2
262	ratio=(cos(zpsi(ji,jk))*2+pgamma(ji)sin(zpsi(ji,jk))**2)/
263	* (pgamma(ji)cos(zpsi(ji,jk))2+sin(zpsi(ji,jk))*2)
264	zbet=max(0.,2.-1./ratio)zconbzzdep(ji,jk)zzd1zabsv
265	zdudt(ji)=-pum1(ji,jk)/ztmst
266	zdvdt(ji)=-pvm1(ji,jk)/ztmst
267	zdudt(ji)=zdudt(ji)*(zbet/(1.+zbet))
268	zdvdt(ji)=zdvdt(ji)*(zbet/(1.+zbet))
269	end if
270	PVOM(JI,JK)=ZDUDT(JI)
271	PVOL(JI,JK)=ZDVDT(JI)
272	ZUST=PUM1(JI,JK)+ZTMST*ZDUDT(JI)
273	ZVST=PVM1(JI,JK)+ZTMST*ZDVDT(JI)
274	ZDIS=0.5(PUM1(JI,JK)2+PVM1(JI,JK)2-ZUST2-ZVST*2)
275	ZDEDT(JI)=ZDIS/ZTMST
276	ZVIDIS(JI)=ZVIDIS(JI)+ZDIS*ZDELP
277	ZDTDT(JI)=ZDEDT(JI)/cpp
278	PTE(JI,JK)=ZDTDT(JI)
279
280	523 CONTINUE
281
282	524 CONTINUE
283	C
284	C
285	RETURN
286	END

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

Download in other formats:

Original Format