/[lmdze]/trunk/phylmd/concvl.f
ViewVC logotype

Contents of /trunk/phylmd/concvl.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 72 - (show annotations)
Tue Jul 23 13:00:07 2013 UTC (10 years, 10 months ago) by guez
Original Path: trunk/libf/phylmd/concvl.f90
File size: 4825 byte(s) 
NaN to signalling NaN in gfortran_debug.mk.

Removed unused procedures in getincom and getincom2. In procedure
conf_interface, replaced call to getincom by new namelist. Moved
procedure conf_interface into module interface_surf.

Added variables sig1 and w01 to startphy.nc and restartphy.nc, for
procedure cv_driver. Renamed (ema_)?work1 and (ema_)?work2 to sig1 and
w01 in concvl and physiq.

Deleted unused arguments of clmain, clqh and intersurf_hq, among which
(y)?sollwdown. Following LMDZ, in physiq, read sollw instead of
sollwdown from startphy.nc, write sollw instead of sollwdown to
restartphy.nc.

In procedure sw, initialized zfs[ud][pn]a[di], for runs where ok_ade
and ok_aie are false. (Following LMDZ.)

Added dimension klev to startphy.nc and restartphy.nc, and deleted
dimension horizon_vertical. Made t_ancien and q_ancien two-dimensional
NetCDF variables. Bug fix: in phyetat0, define ratqs, clwcon and
rnebcon for vertical levels >=2.

Bug fix: set mfg, p[de]n_[ud] to 0. when iflag_con >= 3. (Following LMDZ.)
1 module concvl_m
2
3 IMPLICIT NONE
4
5 contains
6
7 SUBROUTINE concvl(dtime, paprs, play, t, q, u, v, tra, sig1, w01, &
8 d_t, d_q, d_u, d_v, d_tra, rain, snow, kbas, ktop, upwd, dnwd, dnwd0, &
9 ma, cape, tvp, iflag, pbase, bbase, dtvpdt1, dtvpdq1, dplcldt, &
10 dplcldr, qcondc, wd, pmflxr, pmflxs, da, phi, mp, ntra)
11
12 ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17
13 ! Author: Z. X. Li (LMD/CNRS)
14 ! Date: 1993/08/18
15 ! Objet : schéma de convection d'Emanuel (1991), interface
16 ! (driver commun aux versions 3 et 4)
17
18 use clesphys2, only: iflag_con
19 use cv_driver_m, only: cv_driver
20 USE dimens_m, ONLY: nqmx
21 USE dimphy, ONLY: klev, klon
22 USE fcttre, ONLY: foeew
23 USE suphec_m, ONLY: retv, rtt
24 USE yoethf_m, ONLY: r2es
25
26 INTEGER, PARAMETER:: ntrac = nqmx - 2
27
28 REAL, INTENT (IN):: dtime ! pas d'integration (s)
29 REAL, INTENT (IN):: paprs(klon, klev+1)
30 REAL, INTENT (IN):: play(klon, klev)
31 REAL, intent(in):: t(klon, klev)
32 real q(klon, klev) ! input vapeur d'eau (en kg/kg)
33 real u(klon, klev), v(klon, klev)
34 REAL, INTENT (IN):: tra(klon, klev, ntrac)
35 INTEGER, intent(in):: ntra ! number of tracers
36 REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
37 REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
38
39 REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, &
40 klev)
41 ! d_q-----output-R-increment de la vapeur d'eau
42 REAL d_tra(klon, klev, ntrac)
43 REAL rain(klon), snow(klon)
44 ! rain----output-R-la pluie (mm/s)
45 ! snow----output-R-la neige (mm/s)
46
47 INTEGER kbas(klon), ktop(klon)
48 REAL em_ph(klon, klev+1), em_p(klon, klev)
49
50 REAL, intent(out):: upwd(klon, klev)
51 ! saturated updraft mass flux (kg/m**2/s)
52
53 real, intent(out):: dnwd(klon, klev)
54 ! saturated downdraft mass flux (kg/m**2/s)
55
56 real, intent(out):: dnwd0(klon, klev)
57 ! unsaturated downdraft mass flux (kg/m**2/s)
58
59 REAL ma(klon, klev), cape(klon), tvp(klon, klev)
60 ! Cape----output-R-CAPE (J/kg)
61 ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
62 ! adiabatiquement a partir du niveau 1 (K)
63 REAL da(klon, klev), phi(klon, klev, klev), mp(klon, klev)
64 INTEGER iflag(klon)
65 REAL pbase(klon), bbase(klon)
66 REAL dtvpdt1(klon, klev), dtvpdq1(klon, klev)
67 REAL dplcldt(klon), dplcldr(klon)
68 REAL qcondc(klon, klev)
69 REAL wd(klon)
70
71 REAL zx_t, zdelta, zx_qs, zcor
72
73 INTEGER i, k, itra
74 REAL qs(klon, klev)
75 REAL, save:: cbmf(klon)
76 INTEGER:: ifrst = 0
77
78 !-----------------------------------------------------------------
79
80 snow = 0
81
82 IF (ifrst==0) THEN
83 ifrst = 1
84 DO i = 1, klon
85 cbmf(i) = 0.
86 END DO
87 END IF
88
89 DO k = 1, klev + 1
90 DO i = 1, klon
91 em_ph(i, k) = paprs(i, k)/100.0
92 pmflxs(i, k) = 0.
93 END DO
94 END DO
95
96 DO k = 1, klev
97 DO i = 1, klon
98 em_p(i, k) = play(i, k)/100.0
99 END DO
100 END DO
101
102
103 IF (iflag_con==4) THEN
104 DO k = 1, klev
105 DO i = 1, klon
106 zx_t = t(i, k)
107 zdelta = max(0., sign(1., rtt-zx_t))
108 zx_qs = min(0.5, r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0)
109 zcor = 1./(1.-retv*zx_qs)
110 qs(i, k) = zx_qs*zcor
111 END DO
112 END DO
113 ELSE
114 ! iflag_con=3 (modif de puristes qui fait la diffce pour la
115 ! convergence numerique)
116 DO k = 1, klev
117 DO i = 1, klon
118 zx_t = t(i, k)
119 zdelta = max(0., sign(1., rtt-zx_t))
120 zx_qs = r2es*foeew(zx_t, zdelta)/em_p(i, k)/100.0
121 zx_qs = min(0.5, zx_qs)
122 zcor = 1./(1.-retv*zx_qs)
123 zx_qs = zx_qs*zcor
124 qs(i, k) = zx_qs
125 END DO
126 END DO
127 END IF
128
129 CALL cv_driver(klon, klev, klev+1, ntra, t, q, qs, u, v, tra, em_p, &
130 em_ph, iflag, d_t, d_q, d_u, d_v, d_tra, rain, pmflxr, cbmf, sig1, &
131 w01, kbas, ktop, dtime, ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
132 da, phi, mp)
133
134 DO i = 1, klon
135 rain(i) = rain(i)/86400.
136 END DO
137
138 DO k = 1, klev
139 DO i = 1, klon
140 d_t(i, k) = dtime*d_t(i, k)
141 d_q(i, k) = dtime*d_q(i, k)
142 d_u(i, k) = dtime*d_u(i, k)
143 d_v(i, k) = dtime*d_v(i, k)
144 END DO
145 END DO
146 DO itra = 1, ntra
147 DO k = 1, klev
148 DO i = 1, klon
149 d_tra(i, k, itra) = dtime*d_tra(i, k, itra)
150 END DO
151 END DO
152 END DO
153 ! les traceurs ne sont pas mis dans cette version de convect4:
154 IF (iflag_con==4) THEN
155 DO itra = 1, ntra
156 DO k = 1, klev
157 DO i = 1, klon
158 d_tra(i, k, itra) = 0.
159 END DO
160 END DO
161 END DO
162 END IF
163
164 END SUBROUTINE concvl
165
166 end module concvl_m
  ViewVC Help
Powered by ViewVC 1.1.21