46 |
!* 0.2 LOCAL ARRAYS |
!* 0.2 LOCAL ARRAYS |
47 |
! ------------ |
! ------------ |
48 |
LOGICAL lifthigh |
LOGICAL lifthigh |
49 |
INTEGER klevm1, jl, ilevh, jk |
INTEGER jl, jk |
50 |
REAL zcons1, ztmst, zrtmst, zpi, zhgeo |
REAL zcons1, ztmst, zpi, zhgeo |
51 |
REAL zdelp, zslow, zsqua, zscav, zbet |
REAL zdelp, zslow, zsqua, zscav, zbet |
52 |
INTEGER iknub(klon), iknul(klon) |
INTEGER iknub(klon), iknul(klon) |
53 |
LOGICAL ll1(klon,klev+1) |
LOGICAL ll1(klon,klev+1) |
64 |
|
|
65 |
IF (nlon/=klon .OR. nlev/=klev) STOP |
IF (nlon/=klon .OR. nlev/=klev) STOP |
66 |
zcons1 = 1./rd |
zcons1 = 1./rd |
|
klevm1 = klev - 1 |
|
67 |
ztmst = ptsphy |
ztmst = ptsphy |
|
zrtmst = 1./ztmst |
|
68 |
zpi = acos(-1.) |
zpi = acos(-1.) |
69 |
|
|
70 |
DO 1001 jl = 1, klon |
DO 1001 jl = 1, klon |
73 |
pvlow(jl) = 0.0 |
pvlow(jl) = 0.0 |
74 |
iknub(jl) = klev |
iknub(jl) = klev |
75 |
iknul(jl) = klev |
iknul(jl) = klev |
|
ilevh = klev/3 |
|
76 |
ll1(jl,klev+1) = .FALSE. |
ll1(jl,klev+1) = .FALSE. |
77 |
DO 1000 jk = 1, klev |
DO 1000 jk = 1, klev |
78 |
pvom(jl,jk) = 0.0 |
pvom(jl,jk) = 0.0 |
153 |
END IF |
END IF |
154 |
2110 CONTINUE |
2110 CONTINUE |
155 |
|
|
|
|
|
|
200 CONTINUE |
|
|
|
|
|
!*********************************************************** |
|
|
|
|
156 |
!* 3. COMPUTE MOUNTAIN LIFT |
!* 3. COMPUTE MOUNTAIN LIFT |
157 |
|
|
|
300 CONTINUE |
|
|
|
|
158 |
DO 301 jl = 1, klon |
DO 301 jl = 1, klon |
159 |
IF (ktest(jl)==1) THEN |
IF (ktest(jl)==1) THEN |
160 |
ztau(jl,klev+1) = -gklift*zrho(jl,klev+1)*2.*romega*2*pvaror(jl)*sin & |
ztau(jl,klev+1) = -gklift*zrho(jl,klev+1)*2.*romega*2*pvaror(jl)*sin & |
172 |
!* -------------------- |
!* -------------------- |
173 |
|
|
174 |
|
|
175 |
400 CONTINUE |
DO jk = 1, klev |
176 |
|
DO jl = 1, klon |
|
DO 401 jk = 1, klev |
|
|
DO 401 jl = 1, klon |
|
177 |
IF (ktest(jl)==1) THEN |
IF (ktest(jl)==1) THEN |
178 |
ztau(jl,jk) = ztau(jl,klev+1)*paphm1(jl,jk)/paphm1(jl,klev+1) |
ztau(jl,jk) = ztau(jl,klev+1)*paphm1(jl,jk)/paphm1(jl,klev+1) |
179 |
ztav(jl,jk) = ztav(jl,klev+1)*paphm1(jl,jk)/paphm1(jl,klev+1) |
ztav(jl,jk) = ztav(jl,klev+1)*paphm1(jl,jk)/paphm1(jl,klev+1) |
181 |
ztau(jl,jk) = 0.0 |
ztau(jl,jk) = 0.0 |
182 |
ztav(jl,jk) = 0.0 |
ztav(jl,jk) = 0.0 |
183 |
END IF |
END IF |
184 |
401 CONTINUE |
end DO |
185 |
|
end DO |
186 |
|
|
187 |
|
|
188 |
!* 5. COMPUTE TENDENCIES. |
!* 5. COMPUTE TENDENCIES. |
189 |
!* ------------------- |
!* ------------------- |
190 |
IF (lifthigh) THEN |
IF (lifthigh) THEN |
191 |
|
|
|
500 CONTINUE |
|
192 |
! PRINT *,' DANS OROLIFT: 500' |
! PRINT *,' DANS OROLIFT: 500' |
193 |
|
|
194 |
! EXPLICIT SOLUTION AT ALL LEVELS |
! EXPLICIT SOLUTION AT ALL LEVELS |
205 |
|
|
206 |
! PROJECT PERPENDICULARLY TO U NOT TO DESTROY ENERGY |
! PROJECT PERPENDICULARLY TO U NOT TO DESTROY ENERGY |
207 |
|
|
208 |
DO 530 jk = 1, klev |
DO jk = 1, klev |
209 |
DO 530 jl = 1, klon |
DO jl = 1, klon |
210 |
IF (ktest(jl)==1) THEN |
IF (ktest(jl)==1) THEN |
211 |
|
|
212 |
zslow = sqrt(pulow(jl)**2+pvlow(jl)**2) |
zslow = sqrt(pulow(jl)**2+pvlow(jl)**2) |
226 |
END IF |
END IF |
227 |
|
|
228 |
END IF |
END IF |
229 |
530 CONTINUE |
end DO |
230 |
|
end DO |
231 |
|
|
232 |
! 6. LOW LEVEL LIFT, SEMI IMPLICIT: |
! 6. LOW LEVEL LIFT, SEMI IMPLICIT: |
233 |
! ---------------------------------- |
! ---------------------------------- |