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

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

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

revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC
# Line 1  Line 1 
1        SUBROUTINE flxadjtq(pp, pt, pq, ldflag, kcall)  module flxadjtq_m
2        use dimens_m  
3        use dimphy    IMPLICIT none
4        use SUPHEC_M  
5        use yoethf_m  contains
6        use fcttre  
7        IMPLICIT none    SUBROUTINE flxadjtq(pp, pt, pq, ldflag, kcall)
8  !======================================================================  
9  ! Objet: ajustement entre T et Q      ! Objet: ajustement entre T et Q
10  !======================================================================  
11  ! NOTE: INPUT PARAMETER kcall DEFINES CALCULATION AS      USE dimphy, ONLY: klon
12  !        kcall=0    ENV. T AND QS IN*CUINI*      USE suphec_m, ONLY: rcpd, retv, rlstt, rlvtt, rtt
13  !        kcall=1  CONDENSATION IN UPDRAFTS  (E.G. CUBASE, CUASC)      USE yoethf_m, ONLY: r2es, r5ies, r5les
14  !        kcall=2  EVAPORATION IN DOWNDRAFTS (E.G. CUDLFS,CUDDRAF)      USE fcttre, ONLY: foede, foeew
15  !  
16  !      REAL pt(klon), pq(klon), pp(klon)
17        REAL pt(klon), pq(klon), pp(klon)      LOGICAL ldflag(klon)
18        LOGICAL ldflag(klon)      INTEGER kcall
19        INTEGER kcall      ! NOTE: INPUT PARAMETER kcall DEFINES CALCULATION AS
20  !      !        kcall=0    ENV. T AND QS IN*CUINI*
21        REAL zcond(klon), zcond1      !        kcall=1  CONDENSATION IN UPDRAFTS  (E.G. CUBASE, CUASC)
22        REAL Z5alvcp, z5alscp, zalvdcp, zalsdcp      !        kcall=2  EVAPORATION IN DOWNDRAFTS (E.G. CUDLFS,CUDDRAF)
23        REAL zdelta, zcvm5, zldcp, zqsat, zcor  
24        INTEGER is, i      REAL zcond(klon), zcond1
25  !      REAL Z5alvcp, z5alscp, zalvdcp, zalsdcp
26        z5alvcp = r5les*RLVTT/RCPD      REAL zdelta, zcvm5, zldcp, zqsat, zcor
27        z5alscp = r5ies*RLSTT/RCPD      INTEGER is, i
28        zalvdcp = rlvtt/RCPD  
29        zalsdcp = rlstt/RCPD      !---------------------------------------------------------------------
30  !  
31        z5alvcp = r5les*RLVTT/RCPD
32        DO i = 1, klon      z5alscp = r5ies*RLSTT/RCPD
33           zcond(i) = 0.0      zalvdcp = rlvtt/RCPD
34        ENDDO      zalsdcp = rlstt/RCPD
35    
36        DO 210 i =1, klon      DO i = 1, klon
37        IF (ldflag(i)) THEN         zcond(i) = 0.0
38           zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))      ENDDO
39           zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp  
40           zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp      DO  i =1, klon
41           zqsat = R2ES*FOEEW(pt(i),zdelta) / pp(i)         IF (ldflag(i)) THEN
42           zqsat = MIN(0.5,zqsat)            zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))
43           zcor = 1./(1.-RETV*zqsat)            zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
44           zqsat = zqsat*zcor            zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
45           zcond(i) = (pq(i)-zqsat) &            zqsat = R2ES*FOEEW(pt(i),zdelta) / pp(i)
46             / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))            zqsat = MIN(0.5,zqsat)
47           IF (kcall.EQ.1) zcond(i) = MAX(zcond(i),0.)            zcor = 1./(1.-RETV*zqsat)
48           IF (kcall.EQ.2) zcond(i) = MIN(zcond(i),0.)            zqsat = zqsat*zcor
49           pt(i) = pt(i) + zldcp*zcond(i)            zcond(i) = (pq(i)-zqsat) &
50           pq(i) = pq(i) - zcond(i)                 / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
51        ENDIF            IF (kcall.EQ.1) zcond(i) = MAX(zcond(i),0.)
52    210 CONTINUE            IF (kcall.EQ.2) zcond(i) = MIN(zcond(i),0.)
53  !            pt(i) = pt(i) + zldcp*zcond(i)
54        is = 0            pq(i) = pq(i) - zcond(i)
55        DO i =1, klon         ENDIF
56           IF (zcond(i).NE.0.) is = is + 1      end DO
57        ENDDO  
58        IF (is.EQ.0) GOTO 230      is = 0
59  !      DO i =1, klon
60        DO 220 i = 1, klon         IF (zcond(i).NE.0.) is = is + 1
61        IF(ldflag(i).AND.zcond(i).NE.0.) THEN      ENDDO
62           zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))      IF (is /= 0) then
63           zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp         DO  i = 1, klon
64           zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp            IF(ldflag(i).AND.zcond(i).NE.0.) THEN
65           zqsat = R2ES* FOEEW(pt(i),zdelta) / pp(i)               zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))
66           zqsat = MIN(0.5,zqsat)               zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
67           zcor = 1./(1.-RETV*zqsat)               zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
68           zqsat = zqsat*zcor               zqsat = R2ES* FOEEW(pt(i),zdelta) / pp(i)
69           zcond1 = (pq(i)-zqsat) &               zqsat = MIN(0.5,zqsat)
70             / (1. + FOEDE(pt(i),zdelta,zcvm5,zqsat,zcor))               zcor = 1./(1.-RETV*zqsat)
71           pt(i) = pt(i) + zldcp*zcond1               zqsat = zqsat*zcor
72           pq(i) = pq(i) - zcond1               zcond1 = (pq(i)-zqsat) &
73        ENDIF                    / (1. + FOEDE(pt(i),zdelta,zcvm5,zqsat,zcor))
74    220 CONTINUE               pt(i) = pt(i) + zldcp*zcond1
75  !               pq(i) = pq(i) - zcond1
76    230 CONTINUE            ENDIF
77        RETURN         end DO
78        END      end IF
79    
80      END SUBROUTINE flxadjtq
81    
82    end module flxadjtq_m
Legend:
Removed from v.52  
changed lines
  Added in v.70
  ViewVC Help
Powered by ViewVC 1.1.21