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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 103 - (show annotations)
Fri Aug 29 13:00:05 2014 UTC (9 years, 8 months ago) by guez
File size: 2419 byte(s)
Renamed module cvparam to cv_param. Deleted procedure
cv_param. Changed variables of module cv_param into parameters.

In procedures cv_driver, cv_uncompress and cv3_uncompress, removed
some arguments giving dimensions and used module variables klon and
klev instead.

In procedures gradiv2, laplacien_gam and laplacien, changed
declarations of local variables because klevel is not always klev.

Removed code for nudging surface pressure.

Removed arguments pim and pjm of tau2alpha. Added assignment of false
to variable first.

Replaced real argument del of procedures foeew and FOEDE by logical
argument.

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

  ViewVC Help
Powered by ViewVC 1.1.21