Context Navigation

cv3a_uncompress.F90 @ 3981

Last change on this file since 3981 was 3496, checked in by jyg, 5 years ago

Implementation of the ejection of liquid precipitation from the adiabatic ascents.
New flags:
+cvflag_prec_eject: logical

n -> old code, y -> new code

+ejectliq: real; possible values 0. & 1.

-> no liquid precipitation is ejected
-> all liquid precipitation is ejected

+ejectice: real; any value between 0. and 1.

fraction of solid precipitation ejected at each level

Note that the adiabatic ascent mass flux decrease due to precipitation ejection is not taken into account.

Attempts to do it led to water conservation violation.

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory
Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 14.2 KB

Line
1	SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
2	iflag, kbas, ktop, &
3	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
4	ft, fq, fu, fv, ftra, &
5	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
6	qcondc, wd, cape, cin, &
7	tvp, &
8	ftd, fqd, &
9	plim1, plim2, asupmax, supmax0, &
10	asupmaxmin, &
11	da, phi, mp, phi2, d1a, dam, sigij, & ! RomP+AC+jyg
12	qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP+jyg
13	wdtrainA, wdtrainS, wdtrainM, & ! RomP
14	qtc, sigt, &
15	epmax_diag, & ! epmax_cape
16	iflag1, kbas1, ktop1, &
17	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
18	ft1, fq1, fu1, fv1, ftra1, &
19	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
20	qcondc1, wd1, cape1, cin1, &
21	tvp1, &
22	ftd1, fqd1, &
23	plim11, plim21, asupmax1, supmax01, &
24	asupmaxmin1, &
25	da1, phi1, mp1, phi21, d1a1, dam1, sigij1, & ! RomP+AC+jyg
26	qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP+jyg
27	wdtrainA1, wdtrainS1, wdtrainM1, & ! RomP
28	qtc1, sigt1, &
29	epmax_diag1) ! epmax_cape
30
31	! **************************************************************
32	! *
33	! CV3A_UNCOMPRESS *
34	! *
35	! *
36	! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 *
37	! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.36.17 *
38	! **************************************************************
39
40	IMPLICIT NONE
41
42	include "cv3param.h"
43
44	! inputs:
45	INTEGER, INTENT (IN) :: nloc, len, ncum, nd, ntra
46	INTEGER, DIMENSION (nloc), INTENT (IN) :: idcum(nloc)
47	!jyg<
48	LOGICAL, INTENT (IN) :: compress
49	!>jyg
50	INTEGER, DIMENSION (nloc), INTENT (IN) ::iflag, kbas, ktop
51	REAL, DIMENSION (nloc), INTENT (IN) :: precip, cbmf, plcl, plfc
52	REAL, DIMENSION (nloc), INTENT (IN) :: wbeff
53	REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig, w0
54	REAL, DIMENSION (nloc), INTENT (IN) :: ptop2
55	REAL, DIMENSION (nloc), INTENT (IN) :: epmax_diag
56	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ft, fq, fu, fv
57	REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: ftra
58	REAL, DIMENSION (nloc), INTENT (IN) :: sigd
59	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ma, mip
60	REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecip
61	REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecipi
62	REAL, DIMENSION (nloc, nd), INTENT (IN) :: upwd, dnwd, dnwd0
63	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qcondc
64	REAL, DIMENSION (nloc), INTENT (IN) :: wd, cape, cin
65	REAL, DIMENSION (nloc, nd), INTENT (IN) :: tvp
66	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ftd, fqd
67	REAL, DIMENSION (nloc), INTENT (IN) :: plim1, plim2
68	REAL, DIMENSION (nloc, nd), INTENT (IN) :: asupmax
69	REAL, DIMENSION (nloc), INTENT (IN) :: supmax0, asupmaxmin
70
71	REAL, DIMENSION (nloc, nd), INTENT (IN) :: da
72	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi !AC!
73	REAL, DIMENSION (nloc, nd), INTENT (IN) :: mp !RomP
74	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi2 !RomP
75	REAL, DIMENSION (nloc, nd), INTENT (IN) :: d1a, dam !RomP
76	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: sigij !RomP
77	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qta !jyg
78	REAL, DIMENSION (nloc, nd), INTENT (IN) :: clw !RomP
79	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: elij !RomP
80	REAL, DIMENSION (nloc, nd), INTENT (IN) :: evap, ep !RomP
81	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: epmlmMm !RomP+jyg
82	REAL, DIMENSION (nloc, nd), INTENT (IN) :: eplamM !RomP+jyg
83	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt !RomP
84	REAL, DIMENSION (nloc, nd), INTENT (IN) :: wdtrainA, wdtrainS, wdtrainM !RomP
85
86	! outputs:
87	INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1, kbas1, ktop1
88	REAL, DIMENSION (len), INTENT (OUT) :: precip1, cbmf1, plcl1, plfc1
89	REAL, DIMENSION (len), INTENT (OUT) :: wbeff1
90	REAL, DIMENSION (len, nd), INTENT (OUT) :: sig1, w01
91	REAL, DIMENSION (len), INTENT (OUT) :: epmax_diag1 ! epmax_cape
92	REAL, DIMENSION (len), INTENT (OUT) :: ptop21
93	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fu1, fv1
94	REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1
95	REAL, DIMENSION (len), INTENT (OUT) :: sigd1
96	REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1, mip1
97	REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecip1
98	REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecipi1
99	REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1, dnwd1, dnwd01
100	REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1
101	REAL, DIMENSION (len), INTENT (OUT) :: wd1, cape1, cin1
102	REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1
103	REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1, fqd1
104	REAL, DIMENSION (len), INTENT (OUT) :: plim11, plim21
105	REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1
106	REAL, DIMENSION (len), INTENT (OUT) :: supmax01, asupmaxmin1
107
108	REAL, DIMENSION (len, nd), INTENT (OUT) :: da1
109	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 !AC!
110	REAL, DIMENSION (len, nd), INTENT (OUT) :: mp1 !RomP
111	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 !RomP
112	REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1, dam1 !RomP !RomP
113	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1 !RomP
114	REAL, DIMENSION (len, nd), INTENT (OUT) :: qta1 !jyg
115	REAL, DIMENSION (len, nd), INTENT (OUT) :: clw1 !RomP
116	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: elij1 !RomP
117	REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1, ep1 !RomP
118	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 !RomP+jyg
119	REAL, DIMENSION (len, nd), INTENT (OUT) :: eplamM1 !RomP+jyg
120	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1 !RomP
121	REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainS1, wdtrainM1 !RomP
122
123
124	! local variables:
125	INTEGER i, k, j
126	INTEGER jdcum
127	! c integer k1,k2
128
129	!jyg<
130	IF (compress) THEN
131	!>jyg
132	DO i = 1, ncum
133	sig1(idcum(i), nd) = sig(i, nd)
134	ptop21(idcum(i)) = ptop2(i)
135	sigd1(idcum(i)) = sigd(i)
136	precip1(idcum(i)) = precip(i)
137	cbmf1(idcum(i)) = cbmf(i)
138	plcl1(idcum(i)) = plcl(i)
139	plfc1(idcum(i)) = plfc(i)
140	wbeff1(idcum(i)) = wbeff(i)
141	iflag1(idcum(i)) = iflag(i)
142	kbas1(idcum(i)) = kbas(i)
143	ktop1(idcum(i)) = ktop(i)
144	wd1(idcum(i)) = wd(i)
145	cape1(idcum(i)) = cape(i)
146	cin1(idcum(i)) = cin(i)
147	plim11(idcum(i)) = plim1(i)
148	plim21(idcum(i)) = plim2(i)
149	supmax01(idcum(i)) = supmax0(i)
150	asupmaxmin1(idcum(i)) = asupmaxmin(i)
151	epmax_diag1(idcum(i)) = epmax_diag(i)
152	END DO
153
154	DO k = 1, nl
155	DO i = 1, ncum
156	sig1(idcum(i), k) = sig(i, k)
157	w01(idcum(i), k) = w0(i, k)
158	ft1(idcum(i), k) = ft(i, k)
159	fq1(idcum(i), k) = fq(i, k)
160	fu1(idcum(i), k) = fu(i, k)
161	fv1(idcum(i), k) = fv(i, k)
162	ma1(idcum(i), k) = ma(i, k)
163	mip1(idcum(i), k) = mip(i, k)
164	vprecip1(idcum(i), k) = vprecip(i, k)
165	vprecipi1(idcum(i), k) = vprecipi(i, k)
166	upwd1(idcum(i), k) = upwd(i, k)
167	dnwd1(idcum(i), k) = dnwd(i, k)
168	dnwd01(idcum(i), k) = dnwd0(i, k)
169	qcondc1(idcum(i), k) = qcondc(i, k)
170	tvp1(idcum(i), k) = tvp(i, k)
171	ftd1(idcum(i), k) = ftd(i, k)
172	fqd1(idcum(i), k) = fqd(i, k)
173	asupmax1(idcum(i), k) = asupmax(i, k)
174
175	da1(idcum(i), k) = da(i, k) !AC!
176	mp1(idcum(i), k) = mp(i, k) !RomP
177	d1a1(idcum(i), k) = d1a(i, k) !RomP
178	dam1(idcum(i), k) = dam(i, k) !RomP
179	qta1(idcum(i), k) = qta(i, k) !jyg
180	clw1(idcum(i), k) = clw(i, k) !RomP
181	evap1(idcum(i), k) = evap(i, k) !RomP
182	ep1(idcum(i), k) = ep(i, k) !RomP
183	eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg
184	wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP
185	wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP
186	wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP
187	qtc1(idcum(i), k) = qtc(i, k)
188	sigt1(idcum(i), k) = sigt(i, k)
189
190	END DO
191	END DO
192
193	! Fluxes are defined on a staggered grid and extend up to nl+1
194	DO i = 1, ncum
195	ma1(idcum(i), nlp) = 0.
196	vprecip1(idcum(i), nlp) = 0.
197	vprecipi1(idcum(i), nlp) = 0.
198	upwd1(idcum(i), nlp) = 0.
199	dnwd1(idcum(i), nlp) = 0.
200	dnwd01(idcum(i), nlp) = 0.
201	END DO
202
203	! AC! do 2100 j=1,ntra
204	! AC!c oct3 do 2110 k=1,nl
205	! AC! do 2110 k=1,nd ! oct3
206	! AC! do 2120 i=1,ncum
207	! AC! ftra1(idcum(i),k,j)=ftra(i,k,j)
208	! AC! 2120 continue
209	! AC! 2110 continue
210	! AC! 2100 continue
211
212	! AC!
213	!jyg<
214	! Essais pour gagner du temps en diminuant l'adressage indirect
215	!! DO j = 1, nd
216	!! DO k = 1, nd
217	!! DO i = 1, ncum
218	!! phi1(idcum(i), k, j) = phi(i, k, j) !AC!
219	!! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
220	!! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
221	!! elij1(idcum(i), k, j) = elij(i, k, j) !RomP
222	!! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
223	!! END DO
224	!! END DO
225	!! END DO
226
227	!! DO i = 1, ncum
228	!! jdcum=idcum(i)
229	!! phi1 (jdcum, 1:nl+1, 1:nl+1) = phi (i, 1:nl+1, 1:nl+1) !AC!
230	!! phi21 (jdcum, 1:nl+1, 1:nl+1) = phi2 (i, 1:nl+1, 1:nl+1) !RomP
231	!! sigij1 (jdcum, 1:nl+1, 1:nl+1) = sigij (i, 1:nl+1, 1:nl+1) !RomP
232	!! elij1 (jdcum, 1:nl+1, 1:nl+1) = elij (i, 1:nl+1, 1:nl+1) !RomP
233	!! epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1) !RomP+jyg
234	!! END DO
235	! These tracer associated arrays are defined up to nl, not nl+1
236	DO i = 1, ncum
237	jdcum=idcum(i)
238	DO k = 1,nl
239	DO j = 1,nl
240	phi1 (jdcum, j, k) = phi (i, j, k) !AC!
241	phi21 (jdcum, j, k) = phi2 (i, j, k) !RomP
242	sigij1 (jdcum, j, k) = sigij (i, j, k) !RomP
243	elij1 (jdcum, j, k) = elij (i, j, k) !RomP
244	epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k) !RomP+jyg
245	END DO
246	ENDDO
247	ENDDO
248	!>jyg
249	! AC!
250
251
252	! do 2220 k2=1,nd
253	! do 2210 k1=1,nd
254	! do 2200 i=1,ncum
255	! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
256	! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
257	! 2200 enddo
258	! 2210 enddo
259	! 2220 enddo
260	!
261	!jyg<
262	ELSE !(compress)
263	!
264	sig1(:,nd) = sig(:,nd)
265	ptop21(:) = ptop2(:)
266	sigd1(:) = sigd(:)
267	precip1(:) = precip(:)
268	cbmf1(:) = cbmf(:)
269	plcl1(:) = plcl(:)
270	plfc1(:) = plfc(:)
271	wbeff1(:) = wbeff(:)
272	iflag1(:) = iflag(:)
273	kbas1(:) = kbas(:)
274	ktop1(:) = ktop(:)
275	wd1(:) = wd(:)
276	cape1(:) = cape(:)
277	cin1(:) = cin(:)
278	plim11(:) = plim1(:)
279	plim21(:) = plim2(:)
280	supmax01(:) = supmax0(:)
281	asupmaxmin1(:) = asupmaxmin(:)
282	!
283	sig1(:, 1:nl) = sig(:, 1:nl)
284	w01(:, 1:nl) = w0(:, 1:nl)
285	ft1(:, 1:nl) = ft(:, 1:nl)
286	fq1(:, 1:nl) = fq(:, 1:nl)
287	fu1(:, 1:nl) = fu(:, 1:nl)
288	fv1(:, 1:nl) = fv(:, 1:nl)
289	ma1(:, 1:nl) = ma(:, 1:nl)
290	mip1(:, 1:nl) = mip(:, 1:nl)
291	vprecip1(:, 1:nl) = vprecip(:, 1:nl)
292	vprecipi1(:, 1:nl) = vprecipi(:, 1:nl)
293	upwd1(:, 1:nl) = upwd(:, 1:nl)
294	dnwd1(:, 1:nl) = dnwd(:, 1:nl)
295	dnwd01(:, 1:nl) = dnwd0(:, 1:nl)
296	qcondc1(:, 1:nl) = qcondc(:, 1:nl)
297	tvp1(:, 1:nl) = tvp(:, 1:nl)
298	ftd1(:, 1:nl) = ftd(:, 1:nl)
299	fqd1(:, 1:nl) = fqd(:, 1:nl)
300	asupmax1(:, 1:nl) = asupmax(:, 1:nl)
301
302	da1(:, 1:nl) = da(:, 1:nl) !AC!
303	mp1(:, 1:nl) = mp(:, 1:nl) !RomP
304	d1a1(:, 1:nl) = d1a(:, 1:nl) !RomP
305	dam1(:, 1:nl) = dam(:, 1:nl) !RomP
306	qta1(:, 1:nl) = qta(:, 1:nl) !jyg
307	clw1(:, 1:nl) = clw(:, 1:nl) !RomP
308	evap1(:, 1:nl) = evap(:, 1:nl) !RomP
309	ep1(:, 1:nl) = ep(:, 1:nl) !RomP
310	eplamM1(:, 1:nl) = eplamM(:, 1:nl) !RomP+jyg
311	wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl) !RomP
312	wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP
313	wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP
314	qtc1(:, 1:nl) = qtc(:, 1:nl)
315	sigt1(:, 1:nl) = sigt(:, 1:nl)
316	!
317	ma1(:, nlp) = 0.
318	vprecip1(:, nlp) = 0.
319	vprecipi1(:, nlp) = 0.
320	upwd1(:, nlp) = 0.
321	dnwd1(:, nlp) = 0.
322	dnwd01(:, nlp) = 0.
323
324	!
325	phi1 (:, 1:nl, 1:nl) = phi (:, 1:nl, 1:nl) !AC!
326	phi21 (:, 1:nl, 1:nl) = phi2 (:, 1:nl, 1:nl) !RomP
327	sigij1 (:, 1:nl, 1:nl) = sigij (:, 1:nl, 1:nl) !RomP
328	elij1 (:, 1:nl, 1:nl) = elij (:, 1:nl, 1:nl) !RomP
329	epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl) !RomP+jyg
330	ENDIF !(compress)
331	!>jyg
332
333	RETURN
334	END SUBROUTINE cv3a_uncompress
335

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format