| 1 |
guez |
52 |
SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph, & |
| 2 |
|
|
ptu, pqu, plu, ldcum, kcbot, klab) |
| 3 |
|
|
use dimens_m |
| 4 |
|
|
use dimphy |
| 5 |
guez |
70 |
use flxadjtq_m, only: flxadjtq |
| 6 |
guez |
52 |
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 |
Parent Directory
| 
Revision Log