phylmd/Conflx/flxbase.f90

      SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph, &
           ptu, pqu, plu, ldcum, kcbot, klab)
      use dimens_m
      use dimphy
      use SUPHEC_M
      use yoethf_m
      IMPLICIT none
!----------------------------------------------------------------------
! THIS ROUTINE CALCULATES CLOUD BASE VALUES (T AND Q)
!
! INPUT ARE ENVIRONM. VALUES OF T,Q,P,PHI AT HALF LEVELS.
! IT RETURNS CLOUD BASE VALUES AND FLAGS AS FOLLOWS;
!   klab=1 FOR SUBCLOUD LEVELS
!   klab=2 FOR CONDENSATION LEVEL
!
! LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD BASE
! (NON ENTRAINING PLUME,I.E.CONSTANT MASSFLUX)
!----------------------------------------------------------------------
!       ----------------------------------------------------------------
      REAL ptenh(klon,klev), pqenh(klon,klev)
      REAL pgeoh(klon,klev), paph(klon,klev+1)
!
      REAL ptu(klon,klev), pqu(klon,klev), plu(klon,klev)
      INTEGER  klab(klon,klev), kcbot(klon)
!
      LOGICAL llflag(klon), ldcum(klon)
      INTEGER i, k, icall, is
      REAL zbuo, zqold(klon)
!----------------------------------------------------------------------
! INITIALIZE VALUES AT LIFTING LEVEL
!----------------------------------------------------------------------
      DO i = 1, klon
         klab(i,klev)=1
         kcbot(i)=klev-1
         ldcum(i)=.FALSE.
      ENDDO
!----------------------------------------------------------------------
! DO ASCENT IN SUBCLOUD LAYER,
! CHECK FOR EXISTENCE OF CONDENSATION LEVEL,
! ADJUST T,Q AND L ACCORDINGLY
! CHECK FOR BUOYANCY AND SET FLAGS
!----------------------------------------------------------------------
      DO 290 k = klev-1, 2, -1
!
      is = 0
      DO i = 1, klon
         IF (klab(i,k+1).EQ.1) is = is + 1
         llflag(i) = .FALSE.
         IF (klab(i,k+1).EQ.1) llflag(i) = .TRUE.
      ENDDO
      IF (is.EQ.0) GOTO 290
!
      DO i = 1, klon
      IF(llflag(i)) THEN
         pqu(i,k) = pqu(i,k+1)
         ptu(i,k) = ptu(i,k+1)+(pgeoh(i,k+1)-pgeoh(i,k))/RCPD
         zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))- &
                ptenh(i,k)*(1.+RETV*pqenh(i,k))+0.5
         IF (zbuo.GT.0.) klab(i,k) = 1
         zqold(i) = pqu(i,k)
      ENDIF
      ENDDO
!
      icall=1
      CALL flxadjtq(paph(1,k), ptu(1,k), pqu(1,k), llflag, icall)
!
      DO i = 1, klon
      IF (llflag(i).AND.pqu(i,k).NE.zqold(i)) THEN
         klab(i,k) = 2
         plu(i,k) = plu(i,k) + zqold(i)-pqu(i,k)
         zbuo = ptu(i,k)*(1.+RETV*pqu(i,k))- &
                ptenh(i,k)*(1.+RETV*pqenh(i,k))+0.5
         IF (zbuo.GT.0.) kcbot(i) = k
         IF (zbuo.GT.0.) ldcum(i) = .TRUE.
      ENDIF
      ENDDO
!
  290 CONTINUE
!
      RETURN
      END
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.+RETVpqu(i,k))- &
58			ptenh(i,k)(1.+RETVpqenh(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.+RETVpqu(i,k))- &
72			ptenh(i,k)(1.+RETVpqenh(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