phylmd/Conflx/flxbase.f90

      SUBROUTINE flxbase(ptenh, pqenh, pgeoh, paph, &
           ptu, pqu, plu, ldcum, kcbot, klab)
      use dimens_m
      use dimphy
      use flxadjtq_m, only: flxadjtq
      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	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.+RETVpqu(i,k))- &
59	ptenh(i,k)(1.+RETVpqenh(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.+RETVpqu(i,k))- &
73	ptenh(i,k)(1.+RETVpqenh(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