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

Annotation of /trunk/Sources/phylmd/Conflx/flxadjtq.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 134 - (hide annotations)
Wed Apr 29 15:47:56 2015 UTC (9 years, 1 month ago) by guez
File size: 2419 byte(s)
Sources inside, compilation outside.
1 guez 70 module flxadjtq_m
2 guez 52
3 guez 70 IMPLICIT none
4 guez 52
5 guez 70 contains
6    
7     SUBROUTINE flxadjtq(pp, pt, pq, ldflag, kcall)
8    
9 guez 78 ! Objet : ajustement entre T et Q
10 guez 70
11     USE dimphy, ONLY: klon
12 guez 78 USE fcttre, ONLY: foede, foeew
13 guez 70 USE suphec_m, ONLY: rcpd, retv, rlstt, rlvtt, rtt
14     USE yoethf_m, ONLY: r2es, r5ies, r5les
15    
16 guez 78 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 guez 70
25 guez 78 ! Local:
26 guez 70 REAL zcond(klon), zcond1
27     REAL Z5alvcp, z5alscp, zalvdcp, zalsdcp
28 guez 103 logical zdelta
29     real zcvm5, zldcp, zqsat, zcor
30 guez 70 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 guez 78 DO i = 1, klon
44 guez 70 IF (ldflag(i)) THEN
45 guez 103 zdelta = RTT >= pt(i)
46     zcvm5 = merge(z5alscp, z5alvcp, zdelta)
47     zldcp = merge(zalsdcp, zalvdcp, zdelta)
48 guez 78 zqsat = R2ES * FOEEW(pt(i), zdelta) / pp(i)
49     zqsat = MIN(0.5, zqsat)
50 guez 70 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 guez 78 IF (kcall.EQ.1) zcond(i) = MAX(zcond(i), 0.)
55     IF (kcall.EQ.2) zcond(i) = MIN(zcond(i), 0.)
56 guez 70 pt(i) = pt(i) + zldcp*zcond(i)
57     pq(i) = pq(i) - zcond(i)
58     ENDIF
59     end DO
60    
61     is = 0
62 guez 78 DO i = 1, klon
63 guez 70 IF (zcond(i).NE.0.) is = is + 1
64     ENDDO
65     IF (is /= 0) then
66 guez 78 DO i = 1, klon
67 guez 70 IF(ldflag(i).AND.zcond(i).NE.0.) THEN
68 guez 103 zdelta = RTT >= pt(i)
69     zcvm5 = merge(z5alscp, z5alvcp, zdelta)
70     zldcp = merge(zalsdcp, zalvdcp, zdelta)
71 guez 78 zqsat = R2ES* FOEEW(pt(i), zdelta) / pp(i)
72     zqsat = MIN(0.5, zqsat)
73 guez 70 zcor = 1./(1.-RETV*zqsat)
74     zqsat = zqsat*zcor
75     zcond1 = (pq(i)-zqsat) &
76 guez 78 / (1. + FOEDE(pt(i), zdelta, zcvm5, zqsat, zcor))
77 guez 70 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