source: trunk/LMDZ.MARS/libf/phymars/orodrag.F @ 171

Last change on this file since 171 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
6C OUTPUTS
7     R                 , PULOW,PVLOW
8     R                 , PVOM,PVOL,PTE )
9C
10C
11C**** *ORODRAG* - DOES THE GRAVITY WAVE PARAMETRIZATION.
12C
13C     PURPOSE.
14C     --------
15C
16C          THIS ROUTINE COMPUTES THE PHYSICAL TENDENCIES OF THE
17C          PROGNOSTIC VARIABLES U,V  AND T DUE TO  VERTICAL TRANSPORTS BY
18C          SUBGRIDSCALE OROGRAPHICALLY EXCITED GRAVITY WAVES
19C
20C     EXPLICIT ARGUMENTS :
21C     --------------------
22C
23C     INPUT :
24C
25C     NLON               : NUMBER OF HORIZONTAL GRID POINTS
26C     NLEV               : NUMBER OF LEVELS
27C     KGWD               : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
28C     KGWDIM             : NUMBER OF POINTS AT WHICH THE SCHEME IS CALLED
29C     KDX(NLON)          : POINTS AT WHICH TO CALL THE SCHEME
30C     KTEST(NLON)        : MAP OF CALLING POINTS
31C     PTSPHY             : LENGTH OF TIME STEP
32C     PAPHM1(NLON,NLEV+1): PRESSURE AT MIDDLE LEVELS
33C     PAPM1(NLON,NLEV)   : PRESSURE ON MODEL LEVELS
34C     PGEOM1(NLON,NLEV)  : GEOPOTENTIAL HIEGHT OF MODEL LEVELS
35C     PTM1(NLON,NLEV)    : TEMPERATURE
36C     PUM1(NLON,NLEV)    : ZONAL WIND
37C     PVM1(NLON,NLEV)    : MERIDIONAL WIND
38C     PVAROR(NLON)       : SUB-GRID SCALE STANDARD DEVIATION
39C     PSIG(NLON)         : SUB-GRID SCALE SLOPE
40C     PGAMMA(NLON)       : SUB-GRID SCALE ANISOTROPY
41C     PTHETA(NLON)       : SUB-GRID SCALE PRINCIPAL AXES ANGLE
42C
43C     OUTPUT :
44C
45C     PULOW(NLON)        : LOW LEVEL ZONAL WIND
46C     PVLOW(NLON)        : LOW LEVEL MERIDIONAL WIND
47C     PVOM(NLON,NLEV)    : ZONAL WIND TENDENCY
48C     PVOL(NLON,NLEV)    : MERIDIONAL WIND TENDENCY
49C     PTE(NLON,NLEV)     : TEMPERATURE TENDENCY
50C
51C     IMPLICIT ARGUMENTS :
52C     --------------------
53C
54C     comcstfi.h
55C     dimphys.h
56C     yoegwd.h
57C
58C     METHOD.
59C     -------
60C
61C     EXTERNALS.
62C     ----------
63C
64C     REFERENCE.
65C     ----------
66C
67C     AUTHOR.
68C     -------
69C     M.MILLER + B.RITTER   E.C.M.W.F.     15/06/86.
70C
71C     F.LOTT + M. MILLER    E.C.M.W.F.     22/11/94
72C-----------------------------------------------------------------------
73      implicit none
74C
75C
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"
84C-----------------------------------------------------------------------
85C
86C*       0.1   ARGUMENTS
87C              ---------
88C
89C
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)
102C
103      integer kgwd,kgwdim
104      real ptsphy
105      INTEGER  KDX(NDLO2),KTEST(NDLO2)
106C-----------------------------------------------------------------------
107C
108C*       0.2   LOCAL ARRAYS
109C              ------------
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
119C      real gkwake
120      real ztmst,pvar,ztauf,zrtmst,zdelp,zb,zc,zbet
121      real zconb,zabsv,zzd1,ratio,zust,zvst,zdis,ztemp
122C
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)
140C
141C------------------------------------------------------------------
142C
143C*         1.    INITIALIZATION
144C                --------------
145C
146 100  CONTINUE
147C
148C     ------------------------------------------------------------------
149C
150C*         1.1   COMPUTATIONAL CONSTANTS
151C                -----------------------
152C
153 110  CONTINUE
154C
155c     ZTMST=TWODT
156c     IF(NSTEP.EQ.NSTART) ZTMST=0.5*TWODT
157      KLEVM1=KLEV-1
158      ZTMST=PTSPHY
159      ZRTMST=1./ZTMST
160C     ------------------------------------------------------------------
161C
162 120  CONTINUE
163C
164C     ------------------------------------------------------------------
165C
166C*         1.3   CHECK WHETHER ROW CONTAINS POINT FOR PRINTING
167C                ---------------------------------------------
168C
169 130  CONTINUE
170C
171C     ------------------------------------------------------------------
172C
173C*         2.     PRECOMPUTE BASIC STATE VARIABLES.
174C*                ---------- ----- ----- ----------
175C*                DEFINE LOW LEVEL WIND, PROJECT WINDS IN PLANE OF
176C*                LOW LEVEL WIND, DETERMINE SECTOR IN WHICH TO TAKE
177C*                THE VARIANCE AND SET INDICATOR FOR CRITICAL LEVELS.
178C
179  200 CONTINUE
180C
181C
182C
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                )
190C
191C
192C
193C***********************************************************
194C
195C
196C*         3.      COMPUTE LOW LEVEL STRESSES USING SUBCRITICAL AND
197C*                 SUPERCRITICAL FORMS.COMPUTES ANISOTROPY COEFFICIENT
198C*                 AS MEASURE OF OROGRAPHIC TWODIMENSIONALITY.
199C
200  300 CONTINUE
201C
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)
208C
209C*         4.      COMPUTE STRESS PROFILE.
210C*                 ------- ------ --------
211C
212  400 CONTINUE
213C
214C
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   )
222C
223C
224C*         5.      COMPUTE TENDENCIES.
225C*                 -------------------
226C
227  500 CONTINUE
228C
229C  EXPLICIT SOLUTION AT ALL LEVELS FOR THE GRAVITY WAVE
230C  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
238C
239      ILEVP1=KLEV+1
240C
241C
242      DO 524 JK=1,klev
243C
244CDIR$ IVDEP
245C
246C      GKWAKE=0.5
247C
248C     NOW SET IN SUGWD.F
249C
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.18*pgamma(ji)-0.04*pgamma(ji)**2
258         zc=0.48*pgamma(ji)+0.3*pgamma(ji)**2
259         zconb=2.*ztmst*GKWAKE*psig(ji)/(4.*pvaror(ji))
260         zabsv=sqrt(PUM1(JI,JK)**2+PVM1(JI,JK)**2)/2.
261         zzd1=zb*cos(zpsi(ji,jk))**2+zc*sin(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)*zconb*zzdep(ji,jk)*zzd1*zabsv
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-ZUST**2-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
283C
284C
285      RETURN
286      END
Note: See TracBrowser for help on using the repository browser.