Context Navigation

cv3a_uncompress.F90 @ 2405

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

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

Download in other formats:

Original Format