/[lmdze]/trunk/phylmd/Conflx/flxbase.f
ViewVC logotype

Diff of /trunk/phylmd/Conflx/flxbase.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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