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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 82 - (show annotations)
Wed Mar 5 14:57:53 2014 UTC (10 years, 2 months ago) by guez
File size: 2460 byte(s)
Changed all ".f90" suffixes to ".f".
1 module flxadjtq_m
2
3 IMPLICIT none
4
5 contains
6
7 SUBROUTINE flxadjtq(pp, pt, pq, ldflag, kcall)
8
9 ! Objet : ajustement entre T et Q
10
11 USE dimphy, ONLY: klon
12 USE fcttre, ONLY: foede, foeew
13 USE suphec_m, ONLY: rcpd, retv, rlstt, rlvtt, rtt
14 USE yoethf_m, ONLY: r2es, r5ies, r5les
15
16 REAL, intent(in):: pp(klon)
17 real pt(klon), pq(klon)
18 LOGICAL, intent(in):: ldflag(klon)
19 INTEGER, intent(in):: kcall
20 ! Defines calculation as:
21 ! kcall = 0 env. T AND QS IN*CUINI*
22 ! kcall = 1 condensation in updrafts (e.g. cubase, cuasc)
23 ! kcall = 2 evaporation in downdrafts (e.g. cudlfs, cuddraf)
24
25 ! Local:
26 REAL zcond(klon), zcond1
27 REAL Z5alvcp, z5alscp, zalvdcp, zalsdcp
28 REAL zdelta, zcvm5, zldcp, zqsat, zcor
29 INTEGER is, i
30
31 !---------------------------------------------------------------------
32
33 z5alvcp = r5les*RLVTT/RCPD
34 z5alscp = r5ies*RLSTT/RCPD
35 zalvdcp = rlvtt/RCPD
36 zalsdcp = rlstt/RCPD
37
38 DO i = 1, klon
39 zcond(i) = 0.0
40 ENDDO
41
42 DO i = 1, klon
43 IF (ldflag(i)) THEN
44 zdelta = MAX(0., SIGN(1., RTT-pt(i)))
45 zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
46 zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
47 zqsat = R2ES * FOEEW(pt(i), zdelta) / pp(i)
48 zqsat = MIN(0.5, zqsat)
49 zcor = 1./(1.-RETV*zqsat)
50 zqsat = zqsat*zcor
51 zcond(i) = (pq(i)-zqsat) &
52 / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
53 IF (kcall.EQ.1) zcond(i) = MAX(zcond(i), 0.)
54 IF (kcall.EQ.2) zcond(i) = MIN(zcond(i), 0.)
55 pt(i) = pt(i) + zldcp*zcond(i)
56 pq(i) = pq(i) - zcond(i)
57 ENDIF
58 end DO
59
60 is = 0
61 DO i = 1, klon
62 IF (zcond(i).NE.0.) is = is + 1
63 ENDDO
64 IF (is /= 0) then
65 DO i = 1, klon
66 IF(ldflag(i).AND.zcond(i).NE.0.) THEN
67 zdelta = MAX(0., SIGN(1., RTT-pt(i)))
68 zcvm5 = z5alvcp*(1.-zdelta) + zdelta*z5alscp
69 zldcp = zalvdcp*(1.-zdelta) + zdelta*zalsdcp
70 zqsat = R2ES* FOEEW(pt(i), zdelta) / pp(i)
71 zqsat = MIN(0.5, zqsat)
72 zcor = 1./(1.-RETV*zqsat)
73 zqsat = zqsat*zcor
74 zcond1 = (pq(i)-zqsat) &
75 / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
76 pt(i) = pt(i) + zldcp*zcond1
77 pq(i) = pq(i) - zcond1
78 ENDIF
79 end DO
80 end IF
81
82 END SUBROUTINE flxadjtq
83
84 end module flxadjtq_m

  ViewVC Help
Powered by ViewVC 1.1.21