/[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/phylmd/Conflx/flxadjtq.f revision 82 by guez, Wed Mar 5 14:57:53 2014 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      REAL zdelta, zcvm5, zldcp, zqsat, zcor
29        zalsdcp = rlstt/RCPD      INTEGER is, i
30  !  
31        !---------------------------------------------------------------------
32        DO i = 1, klon  
33           zcond(i) = 0.0      z5alvcp = r5les*RLVTT/RCPD
34        ENDDO      z5alscp = r5ies*RLSTT/RCPD
35        zalvdcp = rlvtt/RCPD
36        DO 210 i =1, klon      zalsdcp = rlstt/RCPD
37        IF (ldflag(i)) THEN  
38           zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))      DO i = 1, klon
39           zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp         zcond(i) = 0.0
40           zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp      ENDDO
41           zqsat = R2ES*FOEEW(pt(i),zdelta) / pp(i)  
42           zqsat = MIN(0.5,zqsat)      DO i = 1, klon
43           zcor = 1./(1.-RETV*zqsat)         IF (ldflag(i)) THEN
44           zqsat = zqsat*zcor            zdelta = MAX(0., SIGN(1., RTT-pt(i)))
45           zcond(i) = (pq(i)-zqsat) &            zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
46             / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))            zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
47           IF (kcall.EQ.1) zcond(i) = MAX(zcond(i),0.)            zqsat = R2ES * FOEEW(pt(i), zdelta) / pp(i)
48           IF (kcall.EQ.2) zcond(i) = MIN(zcond(i),0.)            zqsat = MIN(0.5, zqsat)
49           pt(i) = pt(i) + zldcp*zcond(i)            zcor = 1./(1.-RETV*zqsat)
50           pq(i) = pq(i) - zcond(i)            zqsat = zqsat*zcor
51        ENDIF            zcond(i) = (pq(i)-zqsat) &
52    210 CONTINUE                 / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
53  !            IF (kcall.EQ.1) zcond(i) = MAX(zcond(i), 0.)
54        is = 0            IF (kcall.EQ.2) zcond(i) = MIN(zcond(i), 0.)
55        DO i =1, klon            pt(i) = pt(i) + zldcp*zcond(i)
56           IF (zcond(i).NE.0.) is = is + 1            pq(i) = pq(i) - zcond(i)
57        ENDDO         ENDIF
58        IF (is.EQ.0) GOTO 230      end DO
59  !  
60        DO 220 i = 1, klon      is = 0
61        IF(ldflag(i).AND.zcond(i).NE.0.) THEN      DO i = 1, klon
62           zdelta = MAX(0.,SIGN(1.,RTT-pt(i)))         IF (zcond(i).NE.0.) is = is + 1
63           zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp      ENDDO
64           zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp      IF (is /= 0) then
65           zqsat = R2ES* FOEEW(pt(i),zdelta) / pp(i)         DO i = 1, klon
66           zqsat = MIN(0.5,zqsat)            IF(ldflag(i).AND.zcond(i).NE.0.) THEN
67           zcor = 1./(1.-RETV*zqsat)               zdelta = MAX(0., SIGN(1., RTT-pt(i)))
68           zqsat = zqsat*zcor               zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
69           zcond1 = (pq(i)-zqsat) &               zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
70             / (1. + FOEDE(pt(i),zdelta,zcvm5,zqsat,zcor))               zqsat = R2ES* FOEEW(pt(i), zdelta) / pp(i)
71           pt(i) = pt(i) + zldcp*zcond1               zqsat = MIN(0.5, zqsat)
72           pq(i) = pq(i) - zcond1               zcor = 1./(1.-RETV*zqsat)
73        ENDIF               zqsat = zqsat*zcor
74    220 CONTINUE               zcond1 = (pq(i)-zqsat) &
75  !                    / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
76    230 CONTINUE               pt(i) = pt(i) + zldcp*zcond1
77        RETURN               pq(i) = pq(i) - zcond1
78        END            ENDIF
79           end DO
80        end IF
81    
82      END SUBROUTINE flxadjtq
83    
84    end module flxadjtq_m

Legend:
Removed from v.52  
changed lines
  Added in v.82

  ViewVC Help
Powered by ViewVC 1.1.21