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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 103 - (hide annotations)
Fri Aug 29 13:00:05 2014 UTC (9 years, 9 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 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