1 |
guez |
52 |
SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph, & |
2 |
|
|
ptu, pqu, plu, ldcum, kcbot, klab) |
3 |
|
|
use dimens_m |
4 |
|
|
use dimphy |
5 |
|
|
use SUPHEC_M |
6 |
|
|
use yoethf_m |
7 |
|
|
IMPLICIT none |
8 |
|
|
!---------------------------------------------------------------------- |
9 |
|
|
! THIS ROUTINE CALCULATES CLOUD BASE VALUES (T AND Q) |
10 |
|
|
! |
11 |
|
|
! INPUT ARE ENVIRONM. VALUES OF T,Q,P,PHI AT HALF LEVELS. |
12 |
|
|
! IT RETURNS CLOUD BASE VALUES AND FLAGS AS FOLLOWS; |
13 |
|
|
! klab=1 FOR SUBCLOUD LEVELS |
14 |
|
|
! klab=2 FOR CONDENSATION LEVEL |
15 |
|
|
! |
16 |
|
|
! LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD BASE |
17 |
|
|
! (NON ENTRAINING PLUME,I.E.CONSTANT MASSFLUX) |
18 |
|
|
!---------------------------------------------------------------------- |
19 |
|
|
! ---------------------------------------------------------------- |
20 |
|
|
REAL ptenh(klon,klev), pqenh(klon,klev) |
21 |
|
|
REAL pgeoh(klon,klev), paph(klon,klev+1) |
22 |
|
|
! |
23 |
|
|
REAL ptu(klon,klev), pqu(klon,klev), plu(klon,klev) |
24 |
|
|
INTEGER klab(klon,klev), kcbot(klon) |
25 |
|
|
! |
26 |
|
|
LOGICAL llflag(klon), ldcum(klon) |
27 |
|
|
INTEGER i, k, icall, is |
28 |
|
|
REAL zbuo, zqold(klon) |
29 |
|
|
!---------------------------------------------------------------------- |
30 |
|
|
! INITIALIZE VALUES AT LIFTING LEVEL |
31 |
|
|
!---------------------------------------------------------------------- |
32 |
|
|
DO i = 1, klon |
33 |
|
|
klab(i,klev)=1 |
34 |
|
|
kcbot(i)=klev-1 |
35 |
|
|
ldcum(i)=.FALSE. |
36 |
|
|
ENDDO |
37 |
|
|
!---------------------------------------------------------------------- |
38 |
|
|
! DO ASCENT IN SUBCLOUD LAYER, |
39 |
|
|
! CHECK FOR EXISTENCE OF CONDENSATION LEVEL, |
40 |
|
|
! ADJUST T,Q AND L ACCORDINGLY |
41 |
|
|
! CHECK FOR BUOYANCY AND SET FLAGS |
42 |
|
|
!---------------------------------------------------------------------- |
43 |
|
|
DO 290 k = klev-1, 2, -1 |
44 |
|
|
! |
45 |
|
|
is = 0 |
46 |
|
|
DO i = 1, klon |
47 |
|
|
IF (klab(i,k+1).EQ.1) is = is + 1 |
48 |
|
|
llflag(i) = .FALSE. |
49 |
|
|
IF (klab(i,k+1).EQ.1) llflag(i) = .TRUE. |
50 |
|
|
ENDDO |
51 |
|
|
IF (is.EQ.0) GOTO 290 |
52 |
|
|
! |
53 |
|
|
DO i = 1, klon |
54 |
|
|
IF(llflag(i)) THEN |
55 |
|
|
pqu(i,k) = pqu(i,k+1) |
56 |
|
|
ptu(i,k) = ptu(i,k+1)+(pgeoh(i,k+1)-pgeoh(i,k))/RCPD |
57 |
|
|
zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))- & |
58 |
|
|
ptenh(i,k)*(1.+RETV*pqenh(i,k))+0.5 |
59 |
|
|
IF (zbuo.GT.0.) klab(i,k) = 1 |
60 |
|
|
zqold(i) = pqu(i,k) |
61 |
|
|
ENDIF |
62 |
|
|
ENDDO |
63 |
|
|
! |
64 |
|
|
icall=1 |
65 |
|
|
CALL flxadjtq(paph(1,k), ptu(1,k), pqu(1,k), llflag, icall) |
66 |
|
|
! |
67 |
|
|
DO i = 1, klon |
68 |
|
|
IF (llflag(i).AND.pqu(i,k).NE.zqold(i)) THEN |
69 |
|
|
klab(i,k) = 2 |
70 |
|
|
plu(i,k) = plu(i,k) + zqold(i)-pqu(i,k) |
71 |
|
|
zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))- & |
72 |
|
|
ptenh(i,k)*(1.+RETV*pqenh(i,k))+0.5 |
73 |
|
|
IF (zbuo.GT.0.) kcbot(i) = k |
74 |
|
|
IF (zbuo.GT.0.) ldcum(i) = .TRUE. |
75 |
|
|
ENDIF |
76 |
|
|
ENDDO |
77 |
|
|
! |
78 |
|
|
290 CONTINUE |
79 |
|
|
! |
80 |
|
|
RETURN |
81 |
|
|
END |