/[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

trunk/libf/phylmd/Conflx/flxadjtq.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC trunk/Sources/phylmd/Conflx/flxadjtq.f revision 134 by guez, Wed Apr 29 15:47:56 2015 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 fcttre, ONLY: foede, foeew
13  !        kcall=1  CONDENSATION IN UPDRAFTS  (E.G. CUBASE, CUASC)      USE suphec_m, ONLY: rcpd, retv, rlstt, rlvtt, rtt
14  !        kcall=2  EVAPORATION IN DOWNDRAFTS (E.G. CUDLFS,CUDDRAF)      USE yoethf_m, ONLY: r2es, r5ies, r5les
15  !  
16  !      REAL, intent(in):: pp(klon)
17        REAL pt(klon), pq(klon), pp(klon)      real pt(klon), pq(klon)
18        LOGICAL ldflag(klon)      LOGICAL, intent(in):: ldflag(klon)
19        INTEGER kcall      INTEGER, intent(in):: kcall
20  !      ! Defines calculation as:
21        REAL zcond(klon), zcond1      ! kcall = 0 env. T AND QS IN*CUINI*
22        REAL Z5alvcp, z5alscp, zalvdcp, zalsdcp      ! kcall = 1 condensation in updrafts (e.g. cubase, cuasc)
23        REAL zdelta, zcvm5, zldcp, zqsat, zcor      ! kcall = 2 evaporation in downdrafts (e.g. cudlfs, cuddraf)
24        INTEGER is, i  
25  !      ! Local:
26        z5alvcp = r5les*RLVTT/RCPD      REAL zcond(klon), zcond1
27        z5alscp = r5ies*RLSTT/RCPD      REAL Z5alvcp, z5alscp, zalvdcp, zalsdcp
28        zalvdcp = rlvtt/RCPD      logical zdelta
29        zalsdcp = rlstt/RCPD      real zcvm5, zldcp, zqsat, zcor
30  !      INTEGER is, i
31    
32        DO i = 1, klon      !---------------------------------------------------------------------
33           zcond(i) = 0.0  
34        ENDDO      z5alvcp = r5les*RLVTT/RCPD
35        z5alscp = r5ies*RLSTT/RCPD
36        DO 210 i =1, klon      zalvdcp = rlvtt/RCPD
37        IF (ldflag(i)) THEN      zalsdcp = rlstt/RCPD
38           zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))  
39           zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp      DO i = 1, klon
40           zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp         zcond(i) = 0.0
41           zqsat = R2ES*FOEEW(pt(i),zdelta) / pp(i)      ENDDO
42           zqsat = MIN(0.5,zqsat)  
43           zcor = 1./(1.-RETV*zqsat)      DO i = 1, klon
44           zqsat = zqsat*zcor         IF (ldflag(i)) THEN
45           zcond(i) = (pq(i)-zqsat) &            zdelta = RTT >= pt(i)
46             / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))            zcvm5 = merge(z5alscp, z5alvcp, zdelta)
47           IF (kcall.EQ.1) zcond(i) = MAX(zcond(i),0.)            zldcp = merge(zalsdcp, zalvdcp, zdelta)
48           IF (kcall.EQ.2) zcond(i) = MIN(zcond(i),0.)            zqsat = R2ES * FOEEW(pt(i), zdelta) / pp(i)
49           pt(i) = pt(i) + zldcp*zcond(i)            zqsat = MIN(0.5, zqsat)
50           pq(i) = pq(i) - zcond(i)            zcor = 1./(1.-RETV*zqsat)
51        ENDIF            zqsat = zqsat*zcor
52    210 CONTINUE            zcond(i) = (pq(i)-zqsat) &
53  !                 / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
54        is = 0            IF (kcall.EQ.1) zcond(i) = MAX(zcond(i), 0.)
55        DO i =1, klon            IF (kcall.EQ.2) zcond(i) = MIN(zcond(i), 0.)
56           IF (zcond(i).NE.0.) is = is + 1            pt(i) = pt(i) + zldcp*zcond(i)
57        ENDDO            pq(i) = pq(i) - zcond(i)
58        IF (is.EQ.0) GOTO 230         ENDIF
59  !      end DO
60        DO 220 i = 1, klon  
61        IF(ldflag(i).AND.zcond(i).NE.0.) THEN      is = 0
62           zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))      DO i = 1, klon
63           zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp         IF (zcond(i).NE.0.) is = is + 1
64           zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp      ENDDO
65           zqsat = R2ES* FOEEW(pt(i),zdelta) / pp(i)      IF (is /= 0) then
66           zqsat = MIN(0.5,zqsat)         DO i = 1, klon
67           zcor = 1./(1.-RETV*zqsat)            IF(ldflag(i).AND.zcond(i).NE.0.) THEN
68           zqsat = zqsat*zcor               zdelta = RTT >= pt(i)
69           zcond1 = (pq(i)-zqsat) &               zcvm5 = merge(z5alscp, z5alvcp, zdelta)
70             / (1. + FOEDE(pt(i),zdelta,zcvm5,zqsat,zcor))               zldcp = merge(zalsdcp, zalvdcp, zdelta)
71           pt(i) = pt(i) + zldcp*zcond1               zqsat = R2ES* FOEEW(pt(i), zdelta) / pp(i)
72           pq(i) = pq(i) - zcond1               zqsat = MIN(0.5, zqsat)
73        ENDIF               zcor = 1./(1.-RETV*zqsat)
74    220 CONTINUE               zqsat = zqsat*zcor
75  !               zcond1 = (pq(i)-zqsat) &
76    230 CONTINUE                    / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
77        RETURN               pt(i) = pt(i) + zldcp*zcond1
78        END               pq(i) = pq(i) - zcond1
79              ENDIF
80           end DO
81        end IF
82    
83      END SUBROUTINE flxadjtq
84    
85    end module flxadjtq_m
Legend:
Removed from v.52  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21