source: trunk/LMDZ.VENUS/libf/phyvenus/gwstress.F @ 3094

Last change on this file since 3094 was 2047, checked in by slebonnois, 6 years ago

SL: VENUS, ajout des modifs apportees par Thomas Navarro pour la parametrisation des ondes de gravite orographiques

File size: 3.5 KB
Line 
1      SUBROUTINE gwstress
2     *         (  nlon  , nlev
3     *         , kkcrit, ksect, kkhlim, ktest, kkcrith, kcrit, kkenvh
4     *         , kknu
5     *         , prho  , pstab , pvph  , pstd, psig
6     *         , pmea , ppic , pval  , ptfr  , ptau 
7     *         , pgeom1 , pgamma , pd1  , pd2   , pdmod , pnu
8     *         , zeff )
9c
10c**** *gwstress*
11c
12c     purpose.
13c     --------
14c  Compute the surface stress due to Gravity Waves, according
15c  to the Phillips (1979) theory of 3-D flow above
16c  anisotropic elliptic ridges.
17
18C  The stress is reduced two account for cut-off flow over
19C  hill.  The flow only see that part of the ridge located
20c  above the blocked layer (see zeff).
21c
22c**   interface.
23c     ----------
24c     call *gwstress*  from *gwdrag*
25c
26c        explicit arguments :
27c        --------------------
28c     ==== inputs ===
29c     ==== outputs ===
30c
31c        implicit arguments :   none
32c        --------------------
33c
34c     method.
35c     -------
36c
37c
38c     externals.
39c     ----------
40c
41c
42c     reference.
43c     ----------
44c
45c   LOTT and MILLER (1997)  &  LOTT (1999)
46c
47c     author.
48c     -------
49c
50c     modifications.
51c     --------------
52c     f. lott put the new gwd on ifs      22/11/93
53c
54c-----------------------------------------------------------------------
55      use dimphy
56      implicit none
57
58#include "YOMCST.h"
59#include "YOEGWD.h"
60
61c-----------------------------------------------------------------------
62c
63c*       0.1   arguments
64c              ---------
65c
66      integer nlon,nlev
67      integer kkcrit(nlon),kkcrith(nlon),kcrit(nlon),ksect(nlon),
68     *        kkhlim(nlon),ktest(nlon),kkenvh(nlon),kknu(nlon)
69c
70      real prho(nlon,nlev+1),pstab(nlon,nlev+1),ptau(nlon,nlev+1),
71     *     pvph(nlon,nlev+1),ptfr(nlon),
72     *     pgeom1(nlon,nlev),pstd(nlon)
73c
74      real pd1(nlon),pd2(nlon),pnu(nlon),psig(nlon),pgamma(nlon)
75      real pmea(nlon),ppic(nlon),pval(nlon)
76      real pdmod(nlon)
77      real zeff(nlon) ! effective height seen by the flow when there is blocking
78c
79c-----------------------------------------------------------------------
80c
81c*       0.2   local arrays
82c              ------------
83
84      integer jl
85c
86c-----------------------------------------------------------------------
87c
88c*       0.3   functions
89c              ---------
90c     ------------------------------------------------------------------
91c
92c*         1.    initialization
93c                --------------
94c
95c      PRINT *,' in gwstress'
96 100  continue
97c
98c*         3.1     gravity wave stress.
99c
100  300 continue
101c
102c
103      zeff = 0.
104      do 301 jl=kidia,kfdia
105      if(ktest(jl).eq.1) then
106     
107c  effective mountain height above the blocked flow
108 
109         zeff(jl)=ppic(jl)-pval(jl)
110         if(kkenvh(jl).lt.klev)then
111         zeff(jl)=amin1(GFRCRIT*pvph(jl,klev+1)/sqrt(pstab(jl,klev+1))
112     c              ,zeff(jl))
113         endif
114
115     
116        ptau(jl,klev+1)=gkdrag*prho(jl,klev+1)
117     *     *psig(jl)*pdmod(jl)/4./pstd(jl)
118     *     *pvph(jl,klev+1)*sqrt(pstab(jl,klev+1))
119     *     *zeff(jl)**2
120
121
122c  too small value of stress or  low level flow include critical level
123c  or low level flow:  gravity wave stress nul.
124               
125c       lo=(ptau(jl,klev+1).lt.gtsec).or.(kcrit(jl).ge.kknu(jl))
126c    *      .or.(pvph(jl,klev+1).lt.gvcrit)
127c       if(lo) ptau(jl,klev+1)=0.0
128     
129c      print *,jl,ptau(jl,klev+1)
130
131      else
132     
133          ptau(jl,klev+1)=0.0
134         
135      endif
136
137  301 continue
138
139c      write(21)(ptau(jl,klev+1),jl=kidia,kfdia)
140 
141      return
142      end
143
144
Note: See TracBrowser for help on using the repository browser.