1 |
guez |
78 |
module flxbase_m |
2 |
|
|
|
3 |
|
|
IMPLICIT none |
4 |
|
|
|
5 |
|
|
contains |
6 |
|
|
|
7 |
|
|
SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph, ptu, pqu, plu, ldcum, kcbot, & |
8 |
|
|
klab) |
9 |
|
|
|
10 |
|
|
! This routine calculates cloud base values (T and Q). |
11 |
|
|
! Input are environmental 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 |
|
|
USE dimphy, ONLY: klev, klon |
20 |
|
|
USE flxadjtq_m, ONLY: flxadjtq |
21 |
|
|
USE suphec_m, ONLY: rcpd, retv |
22 |
|
|
|
23 |
|
|
REAL ptenh(klon, klev), pqenh(klon, klev) |
24 |
|
|
REAL, intent(in):: pgeoh(klon, klev), paph(klon, klev+1) |
25 |
|
|
REAL ptu(klon, klev), pqu(klon, klev), plu(klon, klev) |
26 |
|
|
LOGICAL ldcum(klon) |
27 |
|
|
INTEGER kcbot(klon), klab(klon, klev) |
28 |
|
|
|
29 |
|
|
! Local: |
30 |
|
|
LOGICAL llflag(klon) |
31 |
|
|
INTEGER i, k, icall, is |
32 |
|
|
REAL zbuo, zqold(klon) |
33 |
|
|
|
34 |
|
|
!---------------------------------------------------------------------- |
35 |
|
|
|
36 |
|
|
! INITIALIZE VALUES AT LIFTING LEVEL |
37 |
|
|
DO i = 1, klon |
38 |
|
|
klab(i, klev) = 1 |
39 |
|
|
kcbot(i) = klev-1 |
40 |
|
|
ldcum(i) = .FALSE. |
41 |
|
|
ENDDO |
42 |
|
|
|
43 |
|
|
! DO ASCENT IN SUBCLOUD LAYER, |
44 |
|
|
! CHECK FOR EXISTENCE OF CONDENSATION LEVEL, |
45 |
|
|
! ADJUST T, Q AND L ACCORDINGLY |
46 |
|
|
! CHECK FOR BUOYANCY AND SET FLAGS |
47 |
|
|
|
48 |
|
|
DO k = klev-1, 2, -1 |
49 |
|
|
is = 0 |
50 |
|
|
DO i = 1, klon |
51 |
|
|
IF (klab(i, k+1).EQ.1) is = is + 1 |
52 |
|
|
llflag(i) = .FALSE. |
53 |
|
|
IF (klab(i, k+1).EQ.1) llflag(i) = .TRUE. |
54 |
|
|
ENDDO |
55 |
|
|
|
56 |
|
|
IF (is.EQ.0) cycle |
57 |
|
|
|
58 |
|
|
DO i = 1, klon |
59 |
|
|
IF(llflag(i)) THEN |
60 |
|
|
pqu(i, k) = pqu(i, k+1) |
61 |
|
|
ptu(i, k) = ptu(i, k+1)+(pgeoh(i, k+1)-pgeoh(i, k))/RCPD |
62 |
|
|
zbuo = ptu(i, k)*(1.+RETV*pqu(i, k))- & |
63 |
|
|
ptenh(i, k)*(1.+RETV*pqenh(i, k))+0.5 |
64 |
|
|
IF (zbuo.GT.0.) klab(i, k) = 1 |
65 |
|
|
zqold(i) = pqu(i, k) |
66 |
|
|
ENDIF |
67 |
|
|
ENDDO |
68 |
|
|
|
69 |
|
|
icall = 1 |
70 |
|
|
CALL flxadjtq(paph(:, k), ptu(1, k), pqu(1, k), llflag, icall) |
71 |
|
|
|
72 |
|
|
DO i = 1, klon |
73 |
|
|
IF (llflag(i).AND.pqu(i, k).NE.zqold(i)) THEN |
74 |
|
|
klab(i, k) = 2 |
75 |
|
|
plu(i, k) = plu(i, k) + zqold(i)-pqu(i, k) |
76 |
|
|
zbuo = ptu(i, k)*(1.+RETV*pqu(i, k))- & |
77 |
|
|
ptenh(i, k)*(1.+RETV*pqenh(i, k))+0.5 |
78 |
|
|
IF (zbuo.GT.0.) kcbot(i) = k |
79 |
|
|
IF (zbuo.GT.0.) ldcum(i) = .TRUE. |
80 |
|
|
ENDIF |
81 |
|
|
ENDDO |
82 |
|
|
end DO |
83 |
|
|
|
84 |
|
|
END SUBROUTINE flxbase |
85 |
|
|
|
86 |
|
|
end module flxbase_m |