Context Navigation

cv3a_uncompress.F90 @ 5086

Last change on this file since 5086 was 3605, checked in by lguez, 5 years ago
Merge revisions 3427:3600 of trunk into branch `Ocean_skin`
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