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