/[lmdze]/trunk/libf/phylmd/concvl.f90
ViewVC logotype

Contents of /trunk/libf/phylmd/concvl.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 13 - (show annotations)
Fri Jul 25 19:59:34 2008 UTC (15 years, 9 months ago) by guez
File size: 5046 byte(s) 
-- Minor change of behaviour:

"etat0" does not compute "rugsrel" nor "radpas". Deleted arguments
"radpas" and "rugsrel" of "phyredem". Deleted argument "rugsrel" of
"phyetat0". "startphy.nc" does not contain the variable "RUGSREL". In
"physiq", "rugoro" is set to 0 if not "ok_orodr". The whole program
"etat0_lim" does not use "clesphys2".

-- Minor modification of input/output:

Created subroutine "read_clesphys2". Variables of "clesphys2" are read
in "read_clesphys2" instead of "conf_gcm". "printflag" does not print
variables of "clesphys2".

-- Should not change any result at run time:

References to module "numer_rec" instead of individual modules of
"Numer_rec_Lionel".

Deleted argument "clesphy0" of "calfis", "physiq", "conf_gcm",
"leapfrog", "phyetat0". Deleted variable "clesphy0" in
"gcm". "phyetat0" does not modify variables of "clesphys2".

The program unit "gcm" does not modify "itau_phy".

Added some "intent" attributes.

"regr11_lint" does not call "polint".
1 SUBROUTINE concvl(iflag_con,dtime,paprs,pplay,t,q,u,v,tra,ntra,work1, &
2 work2,d_t,d_q,d_u,d_v,d_tra,rain,snow,kbas,ktop,upwd,dnwd,dnwdbis,ma, &
3 cape,tvp,iflag,pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &
4 pmflxr,pmflxs,da,phi,mp)
5
6 ! From phylmd/concvl.F,v 1.3 2005/04/15 12:36:17
7 ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19930818
8 ! Objet: schema de convection de Emanuel (1991) interface
9
10 USE dimens_m
11 USE dimphy
12 USE yomcst
13 USE yoethf
14 USE fcttre
15
16 IMPLICIT NONE
17
18 ! Arguments:
19 ! dtime--input-R-pas d'integration (s)
20 ! s-------input-R-la valeur "s" pour chaque couche
21 ! sigs----input-R-la valeur "sigma" de chaque couche
22 ! sig-----input-R-la valeur de "sigma" pour chaque niveau
23 ! psolpa--input-R-la pression au sol (en Pa)
24 ! pskapa--input-R-exponentiel kappa de psolpa
25 ! h-------input-R-enthalpie potentielle (Cp*T/P**kappa)
26 ! q-------input-R-vapeur d'eau (en kg/kg)
27
28 ! work*: input et output: deux variables de travail,
29 ! on peut les mettre a 0 au debut
30 ! ALE-----input-R-energie disponible pour soulevement
31
32 ! d_h-----output-R-increment de l'enthalpie potentielle (h)
33 ! d_q-----output-R-increment de la vapeur d'eau
34 ! rain----output-R-la pluie (mm/s)
35 ! snow----output-R-la neige (mm/s)
36 ! upwd----output-R-saturated updraft mass flux (kg/m**2/s)
37 ! dnwd----output-R-saturated downdraft mass flux (kg/m**2/s)
38 ! dnwd0---output-R-unsaturated downdraft mass flux (kg/m**2/s)
39 ! Cape----output-R-CAPE (J/kg)
40 ! Tvp-----output-R-Temperature virtuelle d'une parcelle soulevee
41 ! adiabatiquement a partir du niveau 1 (K)
42 ! deltapb-output-R-distance entre LCL et base de la colonne (<0 ; Pa)
43 ! Ice_flag-input-L-TRUE->prise en compte de la thermodynamique de la glace
44
45 INTEGER ntrac
46 PARAMETER (ntrac=nqmx-2)
47
48 INTEGER, INTENT (IN) :: iflag_con
49
50 REAL, INTENT (IN) :: dtime
51 REAL, INTENT (IN) :: paprs(klon,klev+1)
52 REAL, INTENT (IN) :: pplay(klon,klev)
53 REAL t(klon,klev), q(klon,klev), u(klon,klev), v(klon,klev)
54 REAL tra(klon,klev,ntrac)
55 INTEGER ntra
56 REAL work1(klon,klev), work2(klon,klev)
57 REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
58
59 REAL d_t(klon,klev), d_q(klon,klev), d_u(klon,klev), d_v(klon,klev)
60 REAL d_tra(klon,klev,ntrac)
61 REAL rain(klon), snow(klon)
62
63 INTEGER kbas(klon), ktop(klon)
64 REAL em_ph(klon,klev+1), em_p(klon,klev)
65 REAL upwd(klon,klev), dnwd(klon,klev), dnwdbis(klon,klev)
66 REAL ma(klon,klev), cape(klon), tvp(klon,klev)
67 REAL da(klon,klev), phi(klon,klev,klev), mp(klon,klev)
68 INTEGER iflag(klon)
69 REAL pbase(klon), bbase(klon)
70 REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
71 REAL dplcldt(klon), dplcldr(klon)
72 REAL qcondc(klon,klev)
73 REAL wd(klon)
74
75 REAL zx_t, zdelta, zx_qs, zcor
76
77 INTEGER i, k, itra
78 REAL qs(klon,klev)
79 REAL cbmf(klon)
80 SAVE cbmf
81 INTEGER ifrst
82 SAVE ifrst
83 DATA ifrst/0/
84
85 !-----------------------------------------------------------------
86
87 snow(:) = 0
88
89 IF (ifrst==0) THEN
90 ifrst = 1
91 DO i = 1, klon
92 cbmf(i) = 0.
93 END DO
94 END IF
95
96 DO k = 1, klev + 1
97 DO i = 1, klon
98 em_ph(i,k) = paprs(i,k)/100.0
99 pmflxs(i,k) = 0.
100 END DO
101 END DO
102
103 DO k = 1, klev
104 DO i = 1, klon
105 em_p(i,k) = pplay(i,k)/100.0
106 END DO
107 END DO
108
109
110 IF (iflag_con==4) THEN
111 DO k = 1, klev
112 DO i = 1, klon
113 zx_t = t(i,k)
114 zdelta = max(0.,sign(1.,rtt-zx_t))
115 zx_qs = min(0.5,r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0)
116 zcor = 1./(1.-retv*zx_qs)
117 qs(i,k) = zx_qs*zcor
118 END DO
119 END DO
120 ELSE
121 ! iflag_con=3 (modif de puristes qui fait la diffce pour la
122 ! convergence numerique)
123 DO k = 1, klev
124 DO i = 1, klon
125 zx_t = t(i,k)
126 zdelta = max(0.,sign(1.,rtt-zx_t))
127 zx_qs = r2es*foeew(zx_t,zdelta)/em_p(i,k)/100.0
128 zx_qs = min(0.5,zx_qs)
129 zcor = 1./(1.-retv*zx_qs)
130 zx_qs = zx_qs*zcor
131 qs(i,k) = zx_qs
132 END DO
133 END DO
134 END IF
135
136 ! Main driver for convection:
137 ! iflag_con = 3 -> equivalent to convect3
138 ! iflag_con = 4 -> equivalent to convect1/2
139
140 CALL cv_driver(klon,klev,klev+1,ntra,iflag_con,t,q,qs,u,v,tra,em_p, &
141 em_ph,iflag,d_t,d_q,d_u,d_v,d_tra,rain,pmflxr,cbmf,work1,work2,kbas, &
142 ktop,dtime,ma,upwd,dnwd,dnwdbis,qcondc,wd,cape,da,phi,mp)
143
144 DO i = 1, klon
145 rain(i) = rain(i)/86400.
146 END DO
147
148 DO k = 1, klev
149 DO i = 1, klon
150 d_t(i,k) = dtime*d_t(i,k)
151 d_q(i,k) = dtime*d_q(i,k)
152 d_u(i,k) = dtime*d_u(i,k)
153 d_v(i,k) = dtime*d_v(i,k)
154 END DO
155 END DO
156 DO itra = 1, ntra
157 DO k = 1, klev
158 DO i = 1, klon
159 d_tra(i,k,itra) = dtime*d_tra(i,k,itra)
160 END DO
161 END DO
162 END DO
163 ! les traceurs ne sont pas mis dans cette version de convect4:
164 IF (iflag_con==4) THEN
165 DO itra = 1, ntra
166 DO k = 1, klev
167 DO i = 1, klon
168 d_tra(i,k,itra) = 0.
169 END DO
170 END DO
171 END DO
172 END IF
173
174 END SUBROUTINE concvl
  ViewVC Help
Powered by ViewVC 1.1.21