/[lmdze]/trunk/phylmd/Orography/gwprofil.f
ViewVC logotype

Annotation of /trunk/phylmd/Orography/gwprofil.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 23 - (hide annotations)
Mon Dec 14 15:25:16 2009 UTC (14 years, 6 months ago) by guez
Original Path: trunk/libf/phylmd/Orography/gwprofil.f90
File size: 6742 byte(s) 
Split "orografi.f": one file for each procedure. Put the created files
in new directory "Orography".

Removed argument "vcov" of procedure "sortvarc". Removed arguments
"itau" and "time" of procedure "caldyn0". Removed arguments "itau",
"time" and "vcov" of procedure "sortvarc0".

Removed argument "time" of procedure "dynredem1". Removed NetCDF
variable "temps" in files "start.nc" and "restart.nc", because its
value is always 0.

Removed argument "nq" of procedures "iniadvtrac" and "leapfrog". The
number of "tracers read in "traceur.def" must now be equal to "nqmx",
or "nqmx" must equal 4 if there is no file "traceur.def". Replaced
variable "nq" by constant "nqmx" in "leapfrog".

NetCDF variable for ozone field in "coefoz.nc" must now be called
"tro3" instead of "r".

Fixed bug in "zenang".
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     USE yomcst
53     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
  ViewVC Help
Powered by ViewVC 1.1.21