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

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

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

revision 77 by guez, Fri Nov 15 18:45:49 2013 UTC 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 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
Legend:
Removed from v.77  
changed lines
  Added in v.78
  ViewVC Help
Powered by ViewVC 1.1.21