1 |
SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph, & |
module flxbase_m |
2 |
ptu, pqu, plu, ldcum, kcbot, klab) |
|
3 |
use dimens_m |
IMPLICIT none |
4 |
use dimphy |
|
5 |
use flxadjtq_m, only: flxadjtq |
contains |
6 |
use SUPHEC_M |
|
7 |
use yoethf_m |
SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph, ptu, pqu, plu, ldcum, kcbot, & |
8 |
IMPLICIT none |
klab) |
9 |
!---------------------------------------------------------------------- |
|
10 |
! THIS ROUTINE CALCULATES CLOUD BASE VALUES (T AND Q) |
! This routine calculates cloud base values (T and Q). |
11 |
! |
! Input are environmental values of T, q, p, Phi at half levels. |
12 |
! INPUT ARE ENVIRONM. VALUES OF T,Q,P,PHI AT HALF LEVELS. |
! It returns cloud base values and flags as follows: |
13 |
! IT RETURNS CLOUD BASE VALUES AND FLAGS AS FOLLOWS; |
! klab = 1 for subcloud levels |
14 |
! klab=1 FOR SUBCLOUD LEVELS |
! klab = 2 for condensation level |
15 |
! klab=2 FOR CONDENSATION LEVEL |
|
16 |
! |
! Lift surface air dry-adiabatically to cloud base |
17 |
! LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD BASE |
! (non entraining plume, i. e. constant massflux) |
18 |
! (NON ENTRAINING PLUME,I.E.CONSTANT MASSFLUX) |
|
19 |
!---------------------------------------------------------------------- |
USE dimphy, ONLY: klev, klon |
20 |
! ---------------------------------------------------------------- |
USE flxadjtq_m, ONLY: flxadjtq |
21 |
REAL ptenh(klon,klev), pqenh(klon,klev) |
USE suphec_m, ONLY: rcpd, retv |
22 |
REAL pgeoh(klon,klev), paph(klon,klev+1) |
|
23 |
! |
REAL ptenh(klon, klev), pqenh(klon, klev) |
24 |
REAL ptu(klon,klev), pqu(klon,klev), plu(klon,klev) |
REAL, intent(in):: pgeoh(klon, klev), paph(klon, klev+1) |
25 |
INTEGER klab(klon,klev), kcbot(klon) |
REAL ptu(klon, klev), pqu(klon, klev), plu(klon, klev) |
26 |
! |
LOGICAL ldcum(klon) |
27 |
LOGICAL llflag(klon), ldcum(klon) |
INTEGER kcbot(klon), klab(klon, klev) |
28 |
INTEGER i, k, icall, is |
|
29 |
REAL zbuo, zqold(klon) |
! Local: |
30 |
!---------------------------------------------------------------------- |
LOGICAL llflag(klon) |
31 |
! INITIALIZE VALUES AT LIFTING LEVEL |
INTEGER i, k, icall, is |
32 |
!---------------------------------------------------------------------- |
REAL zbuo, zqold(klon) |
33 |
DO i = 1, klon |
|
34 |
klab(i,klev)=1 |
!---------------------------------------------------------------------- |
35 |
kcbot(i)=klev-1 |
|
36 |
ldcum(i)=.FALSE. |
! INITIALIZE VALUES AT LIFTING LEVEL |
37 |
ENDDO |
DO i = 1, klon |
38 |
!---------------------------------------------------------------------- |
klab(i, klev) = 1 |
39 |
! DO ASCENT IN SUBCLOUD LAYER, |
kcbot(i) = klev-1 |
40 |
! CHECK FOR EXISTENCE OF CONDENSATION LEVEL, |
ldcum(i) = .FALSE. |
41 |
! ADJUST T,Q AND L ACCORDINGLY |
ENDDO |
42 |
! CHECK FOR BUOYANCY AND SET FLAGS |
|
43 |
!---------------------------------------------------------------------- |
! DO ASCENT IN SUBCLOUD LAYER, |
44 |
DO 290 k = klev-1, 2, -1 |
! CHECK FOR EXISTENCE OF CONDENSATION LEVEL, |
45 |
! |
! ADJUST T, Q AND L ACCORDINGLY |
46 |
is = 0 |
! CHECK FOR BUOYANCY AND SET FLAGS |
47 |
DO i = 1, klon |
|
48 |
IF (klab(i,k+1).EQ.1) is = is + 1 |
DO k = klev-1, 2, -1 |
49 |
llflag(i) = .FALSE. |
is = 0 |
50 |
IF (klab(i,k+1).EQ.1) llflag(i) = .TRUE. |
DO i = 1, klon |
51 |
ENDDO |
IF (klab(i, k+1).EQ.1) is = is + 1 |
52 |
IF (is.EQ.0) GOTO 290 |
llflag(i) = .FALSE. |
53 |
! |
IF (klab(i, k+1).EQ.1) llflag(i) = .TRUE. |
54 |
DO i = 1, klon |
ENDDO |
55 |
IF(llflag(i)) THEN |
|
56 |
pqu(i,k) = pqu(i,k+1) |
IF (is.EQ.0) cycle |
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))- & |
DO i = 1, klon |
59 |
ptenh(i,k)*(1.+RETV*pqenh(i,k))+0.5 |
IF(llflag(i)) THEN |
60 |
IF (zbuo.GT.0.) klab(i,k) = 1 |
pqu(i, k) = pqu(i, k+1) |
61 |
zqold(i) = pqu(i,k) |
ptu(i, k) = ptu(i, k+1)+(pgeoh(i, k+1)-pgeoh(i, k))/RCPD |
62 |
ENDIF |
zbuo = ptu(i, k)*(1.+RETV*pqu(i, k))- & |
63 |
ENDDO |
ptenh(i, k)*(1.+RETV*pqenh(i, k))+0.5 |
64 |
! |
IF (zbuo.GT.0.) klab(i, k) = 1 |
65 |
icall=1 |
zqold(i) = pqu(i, k) |
66 |
CALL flxadjtq(paph(1,k), ptu(1,k), pqu(1,k), llflag, icall) |
ENDIF |
67 |
! |
ENDDO |
68 |
DO i = 1, klon |
|
69 |
IF (llflag(i).AND.pqu(i,k).NE.zqold(i)) THEN |
icall = 1 |
70 |
klab(i,k) = 2 |
CALL flxadjtq(paph(:, k), ptu(1, k), pqu(1, k), llflag, icall) |
71 |
plu(i,k) = plu(i,k) + zqold(i)-pqu(i,k) |
|
72 |
zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))- & |
DO i = 1, klon |
73 |
ptenh(i,k)*(1.+RETV*pqenh(i,k))+0.5 |
IF (llflag(i).AND.pqu(i, k).NE.zqold(i)) THEN |
74 |
IF (zbuo.GT.0.) kcbot(i) = k |
klab(i, k) = 2 |
75 |
IF (zbuo.GT.0.) ldcum(i) = .TRUE. |
plu(i, k) = plu(i, k) + zqold(i)-pqu(i, k) |
76 |
ENDIF |
zbuo = ptu(i, k)*(1.+RETV*pqu(i, k))- & |
77 |
ENDDO |
ptenh(i, k)*(1.+RETV*pqenh(i, k))+0.5 |
78 |
! |
IF (zbuo.GT.0.) kcbot(i) = k |
79 |
290 CONTINUE |
IF (zbuo.GT.0.) ldcum(i) = .TRUE. |
80 |
! |
ENDIF |
81 |
RETURN |
ENDDO |
82 |
END |
end DO |
83 |
|
|
84 |
|
END SUBROUTINE flxbase |
85 |
|
|
86 |
|
end module flxbase_m |