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

Annotation of /trunk/phylmd/concvl.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 72 - (hide 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 guez 47 module concvl_m
2 guez 3
3 guez 47 IMPLICIT NONE
4 guez 3
5 guez 47 contains
6 guez 13
7 guez 72 SUBROUTINE concvl(dtime, paprs, play, t, q, u, v, tra, sig1, w01, &
8 guez 69 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 guez 13
12 guez 47 ! From phylmd/concvl.F, version 1.3 2005/04/15 12:36:17
13 guez 62 ! Author: Z. X. Li (LMD/CNRS)
14 guez 69 ! Date: 1993/08/18
15 guez 62 ! Objet : schéma de convection d'Emanuel (1991), interface
16 guez 69 ! (driver commun aux versions 3 et 4)
17 guez 13
18 guez 69 use clesphys2, only: iflag_con
19 guez 52 use cv_driver_m, only: cv_driver
20 guez 69 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 guez 13
26 guez 62 INTEGER, PARAMETER:: ntrac = nqmx - 2
27 guez 13
28 guez 69 REAL, INTENT (IN):: dtime ! pas d'integration (s)
29     REAL, INTENT (IN):: paprs(klon, klev+1)
30 guez 72 REAL, INTENT (IN):: play(klon, klev)
31 guez 52 REAL, intent(in):: t(klon, klev)
32 guez 69 real q(klon, klev) ! input vapeur d'eau (en kg/kg)
33     real u(klon, klev), v(klon, klev)
34 guez 47 REAL, INTENT (IN):: tra(klon, klev, ntrac)
35 guez 69 INTEGER, intent(in):: ntra ! number of tracers
36 guez 72 REAL, intent(inout):: sig1(klon, klev), w01(klon, klev)
37 guez 47 REAL pmflxr(klon, klev+1), pmflxs(klon, klev+1)
38 guez 13
39 guez 47 REAL d_t(klon, klev), d_q(klon, klev), d_u(klon, klev), d_v(klon, &
40     klev)
41 guez 62 ! d_q-----output-R-increment de la vapeur d'eau
42 guez 47 REAL d_tra(klon, klev, ntrac)
43     REAL rain(klon), snow(klon)
44 guez 62 ! rain----output-R-la pluie (mm/s)
45     ! snow----output-R-la neige (mm/s)
46 guez 13
47 guez 47 INTEGER kbas(klon), ktop(klon)
48     REAL em_ph(klon, klev+1), em_p(klon, klev)
49 guez 62
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 guez 47 REAL ma(klon, klev), cape(klon), tvp(klon, klev)
60 guez 62 ! 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 guez 47 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 guez 13
71 guez 47 REAL zx_t, zdelta, zx_qs, zcor
72 guez 13
73 guez 47 INTEGER i, k, itra
74     REAL qs(klon, klev)
75 guez 62 REAL, save:: cbmf(klon)
76     INTEGER:: ifrst = 0
77 guez 13
78 guez 47 !-----------------------------------------------------------------
79 guez 13
80 guez 62 snow = 0
81 guez 13
82 guez 47 IF (ifrst==0) THEN
83     ifrst = 1
84     DO i = 1, klon
85     cbmf(i) = 0.
86     END DO
87     END IF
88 guez 13
89 guez 47 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 guez 13
96 guez 47 DO k = 1, klev
97     DO i = 1, klon
98 guez 72 em_p(i, k) = play(i, k)/100.0
99 guez 47 END DO
100     END DO
101 guez 3
102    
103 guez 47 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 guez 3
129 guez 69 CALL cv_driver(klon, klev, klev+1, ntra, t, q, qs, u, v, tra, em_p, &
130 guez 72 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 guez 69 da, phi, mp)
133 guez 3
134 guez 47 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