Context Navigation

cv3a_uncompress.F90 @ 4160

Last change on this file since 4160 was 4143, checked in by dcugnet, 3 years ago
Some variables are renamed or replaced by direct equivalents: iso_indnum -> tracers(:)%iso_iName niso_possibles -> niso iqiso -> iqIsoPha ; index_trac -> itZonIso ok_iso_verif -> isoCheck ntraceurs_zone -> nzone ; ntraciso -> ntiso qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times. Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18). The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).
Property svn:keywords set to `Id`
File size: 20.4 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	#ifdef ISO
31	& ,xtprecip,fxt,fxtd, xtvprecip,xtvprecipi, xtclw,xtevap,xtwdtraina &
32	& ,xtprecip1,fxt1,fxtd1, xtvprecip1, xtvprecipi1, xtclw1,xtevap1,xtwdtraina1 &
33	#ifdef DIAGISO
34	& , water,xtwater,qp,xtp &
35	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
36	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse, fxt_evapprecip &
37	& , f_detrainement,q_detrainement,xt_detrainement &
38	& , water1,xtwater1,qp1,xtp1 &
39	& , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1 &
40	& , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1, fxt_evapprecip1 &
41	& , f_detrainement1,q_detrainement1,xt_detrainement1 &
42	#endif
43	#endif
44	& )
45
46	! **************************************************************
47	! *
48	! CV3A_UNCOMPRESS *
49	! *
50	! *
51	! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 *
52	! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.36.17 *
53	! **************************************************************
54
55	#ifdef ISO
56	USE infotrac_phy, ONLY : ntraciso=>ntiso
57	#endif
58	IMPLICIT NONE
59
60	include "cv3param.h"
61
62	! inputs:
63	INTEGER, INTENT (IN) :: nloc, len, ncum, nd, ntra
64	INTEGER, DIMENSION (nloc), INTENT (IN) :: idcum(nloc)
65	!jyg<
66	LOGICAL, INTENT (IN) :: compress
67	!>jyg
68	INTEGER, DIMENSION (nloc), INTENT (IN) ::iflag, kbas, ktop
69	REAL, DIMENSION (nloc), INTENT (IN) :: precip, cbmf, plcl, plfc
70	REAL, DIMENSION (nloc), INTENT (IN) :: wbeff
71	REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig, w0
72	REAL, DIMENSION (nloc), INTENT (IN) :: ptop2
73	REAL, DIMENSION (nloc), INTENT (IN) :: epmax_diag
74	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ft, fq, fu, fv
75	REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: ftra
76	REAL, DIMENSION (nloc), INTENT (IN) :: sigd
77	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ma, mip
78	REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecip
79	REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecipi
80	REAL, DIMENSION (nloc, nd), INTENT (IN) :: upwd, dnwd, dnwd0
81	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qcondc
82	REAL, DIMENSION (nloc), INTENT (IN) :: wd, cape, cin
83	REAL, DIMENSION (nloc, nd), INTENT (IN) :: tvp
84	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ftd, fqd
85	REAL, DIMENSION (nloc), INTENT (IN) :: plim1, plim2
86	REAL, DIMENSION (nloc, nd), INTENT (IN) :: asupmax
87	REAL, DIMENSION (nloc), INTENT (IN) :: supmax0, asupmaxmin
88
89	REAL, DIMENSION (nloc, nd), INTENT (IN) :: da
90	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi !AC!
91	REAL, DIMENSION (nloc, nd), INTENT (IN) :: mp !RomP
92	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi2 !RomP
93	REAL, DIMENSION (nloc, nd), INTENT (IN) :: d1a, dam !RomP
94	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: sigij !RomP
95	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qta !jyg
96	REAL, DIMENSION (nloc, nd), INTENT (IN) :: clw !RomP
97	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: elij !RomP
98	REAL, DIMENSION (nloc, nd), INTENT (IN) :: evap, ep !RomP
99	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: epmlmMm !RomP+jyg
100	REAL, DIMENSION (nloc, nd), INTENT (IN) :: eplamM !RomP+jyg
101	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt !RomP
102	REAL, DIMENSION (nloc, nd), INTENT (IN) :: wdtrainA, wdtrainS, wdtrainM !RomP
103
104	#ifdef ISO
105	real, DIMENSION (ntraciso,nloc), INTENT (IN) :: xtprecip
106	real, DIMENSION (ntraciso,nloc,nd), INTENT (IN) :: fxt
107	real, DIMENSION(ntraciso,nloc,nd), INTENT (IN) :: fxtd
108	real, DIMENSION(ntraciso,nloc,nd+1), INTENT (IN) :: xtvprecip
109	real, DIMENSION(ntraciso,nloc,nd+1), INTENT (IN) :: xtvprecipi
110	real xtevap(ntraciso,nloc,nd)
111	real xtwdtraina(ntraciso,nloc,nd)
112	real xtclw(ntraciso,nloc,nd)
113	#endif
114
115	! outputs:
116	INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1, kbas1, ktop1
117	REAL, DIMENSION (len), INTENT (OUT) :: precip1, cbmf1, plcl1, plfc1
118	REAL, DIMENSION (len), INTENT (OUT) :: wbeff1
119	REAL, DIMENSION (len, nd), INTENT (OUT) :: sig1, w01
120	REAL, DIMENSION (len), INTENT (OUT) :: epmax_diag1 ! epmax_cape
121	REAL, DIMENSION (len), INTENT (OUT) :: ptop21
122	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fu1, fv1
123	REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1
124	REAL, DIMENSION (len), INTENT (OUT) :: sigd1
125	REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1, mip1
126	REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecip1
127	REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecipi1
128	REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1, dnwd1, dnwd01
129	REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1
130	REAL, DIMENSION (len), INTENT (OUT) :: wd1, cape1, cin1
131	REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1
132	REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1, fqd1
133	REAL, DIMENSION (len), INTENT (OUT) :: plim11, plim21
134	REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1
135	REAL, DIMENSION (len), INTENT (OUT) :: supmax01, asupmaxmin1
136
137	REAL, DIMENSION (len, nd), INTENT (OUT) :: da1
138	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 !AC!
139	REAL, DIMENSION (len, nd), INTENT (OUT) :: mp1 !RomP
140	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 !RomP
141	REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1, dam1 !RomP !RomP
142	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1 !RomP
143	REAL, DIMENSION (len, nd), INTENT (OUT) :: qta1 !jyg
144	REAL, DIMENSION (len, nd), INTENT (OUT) :: clw1 !RomP
145	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: elij1 !RomP
146	REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1, ep1 !RomP
147	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 !RomP+jyg
148	REAL, DIMENSION (len, nd), INTENT (OUT) :: eplamM1 !RomP+jyg
149	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1 !RomP
150	REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainS1, wdtrainM1 !RomP
151
152	#ifdef ISO
153	REAL, DIMENSION (ntraciso,len), INTENT (OUT) :: xtprecip1
154	real, DIMENSION (ntraciso,len,nd), INTENT (OUT) :: fxt1
155	real, DIMENSION (ntraciso,len,nd), INTENT (OUT) :: fxtd1
156	real, DIMENSION (ntraciso,len,nd+1), INTENT (OUT) :: xtvprecip1
157	real, DIMENSION (ntraciso,len,nd+1), INTENT (OUT) :: xtvprecipi1
158	REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT) :: xtevap1
159	REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT) :: xtwdtrainA1
160	REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT) :: xtclw1
161	#endif
162
163	! local variables:
164	INTEGER i, k, j
165	INTEGER jdcum
166	! c integer k1,k2
167
168	#ifdef ISO
169	integer ixt
170	#endif
171
172	#ifdef DIAGISO
173	real water(nloc,nd)
174	real xtwater(ntraciso,nloc,nd)
175	real qp(nloc,nd),xtp(ntraciso,nloc,nd)
176	real fq_detrainement(nloc,nd)
177	real f_detrainement(nloc,nd)
178	real q_detrainement(nloc,nd)
179	real xt_detrainement(ntraciso,nloc,nd)
180	real fq_ddft(nloc,nd)
181	real fq_fluxmasse(nloc,nd)
182	real Amp_diag(nloc,nd)
183	real tg_save(nloc,nd) ! temperature de cond pour les isos
184	real fq_evapprecip(nloc,nd)
185	real fxt_detrainement(ntraciso,nloc,nd)
186	real fxt_ddft(ntraciso,nloc,nd)
187	real fxt_fluxmasse(ntraciso,nloc,nd)
188	real fxt_evapprecip(ntraciso,nloc,nd)
189	real m(nloc,nd)
190
191	real water1(len,nd)
192	real xtwater1(ntraciso,len,nd)
193	real qp1(len,nd),xtp1(ntraciso,len,nd)
194	real fq_detrainement1(len,nd)
195	real f_detrainement1(len,nd)
196	real q_detrainement1(len,nd)
197	real xt_detrainement1(ntraciso,len,nd)
198	real fq_ddft1(len,nd)
199	real fq_fluxmasse1(len,nd)
200	real fq_evapprecip1(len,nd)
201	real fxt_detrainement1(ntraciso,len,nd)
202	real fxt_ddft1(ntraciso,len,nd)
203	real fxt_fluxmasse1(ntraciso,len,nd)
204	real fxt_evapprecip1(ntraciso,len,nd)
205	#endif
206
207	!jyg<
208	IF (compress) THEN
209	!>jyg
210	#ifdef ISOVERIF
211	write(,) 'cv3a_uncompress 151: entrée dans cv3a_uncompress'
212	#endif
213	DO i = 1, ncum
214	sig1(idcum(i), nd) = sig(i, nd)
215	ptop21(idcum(i)) = ptop2(i)
216	sigd1(idcum(i)) = sigd(i)
217	precip1(idcum(i)) = precip(i)
218	cbmf1(idcum(i)) = cbmf(i)
219	plcl1(idcum(i)) = plcl(i)
220	plfc1(idcum(i)) = plfc(i)
221	wbeff1(idcum(i)) = wbeff(i)
222	iflag1(idcum(i)) = iflag(i)
223	kbas1(idcum(i)) = kbas(i)
224	ktop1(idcum(i)) = ktop(i)
225	wd1(idcum(i)) = wd(i)
226	cape1(idcum(i)) = cape(i)
227	cin1(idcum(i)) = cin(i)
228	plim11(idcum(i)) = plim1(i)
229	plim21(idcum(i)) = plim2(i)
230	supmax01(idcum(i)) = supmax0(i)
231	asupmaxmin1(idcum(i)) = asupmaxmin(i)
232	epmax_diag1(idcum(i)) = epmax_diag(i)
233	#ifdef ISO
234	do ixt = 1, ntraciso
235	xtprecip1(ixt,idcum(i))=xtprecip(ixt,i)
236	enddo
237	#endif
238	END DO
239
240	DO k = 1, nl
241	DO i = 1, ncum
242	sig1(idcum(i), k) = sig(i, k)
243	w01(idcum(i), k) = w0(i, k)
244	ft1(idcum(i), k) = ft(i, k)
245	fq1(idcum(i), k) = fq(i, k)
246	fu1(idcum(i), k) = fu(i, k)
247	fv1(idcum(i), k) = fv(i, k)
248	ma1(idcum(i), k) = ma(i, k)
249	mip1(idcum(i), k) = mip(i, k)
250	vprecip1(idcum(i), k) = vprecip(i, k)
251	vprecipi1(idcum(i), k) = vprecipi(i, k)
252	upwd1(idcum(i), k) = upwd(i, k)
253	dnwd1(idcum(i), k) = dnwd(i, k)
254	dnwd01(idcum(i), k) = dnwd0(i, k)
255	qcondc1(idcum(i), k) = qcondc(i, k)
256	tvp1(idcum(i), k) = tvp(i, k)
257	ftd1(idcum(i), k) = ftd(i, k)
258	fqd1(idcum(i), k) = fqd(i, k)
259	asupmax1(idcum(i), k) = asupmax(i, k)
260
261	da1(idcum(i), k) = da(i, k) !AC!
262	mp1(idcum(i), k) = mp(i, k) !RomP
263	d1a1(idcum(i), k) = d1a(i, k) !RomP
264	dam1(idcum(i), k) = dam(i, k) !RomP
265	qta1(idcum(i), k) = qta(i, k) !jyg
266	clw1(idcum(i), k) = clw(i, k) !RomP
267	evap1(idcum(i), k) = evap(i, k) !RomP
268	ep1(idcum(i), k) = ep(i, k) !RomP
269	eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg
270	wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP
271	wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP
272	wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP
273	qtc1(idcum(i), k) = qtc(i, k)
274	sigt1(idcum(i), k) = sigt(i, k)
275
276	#ifdef ISO
277	do ixt = 1, ntraciso
278	fxt1(ixt,idcum(i),k)=fxt(ixt,i,k)
279	fxtd1(ixt,idcum(i),k)=fxtd(ixt,i,k)
280	xtvprecip1(ixt,idcum(i),k)=xtvprecip(ixt,i,k)
281	xtvprecipi1(ixt,idcum(i),k)=xtvprecipi(ixt,i,k)
282	xtevap1(ixt,idcum(i),k)=xtevap(ixt,i,k)
283	xtwdtraina1(ixt,idcum(i),k)=xtwdtraina(ixt,i,k)
284	xtclw1(ixt,idcum(i),k)=xtclw(ixt,i,k)
285	enddo
286	#endif
287	END DO
288	END DO
289
290	#ifdef ISO
291	#ifdef DIAGISO
292	do k=1,nl
293	do i=1,ncum
294	water1(idcum(i),k)=water(i,k)
295	qp1(idcum(i),k)=qp(i,k)
296	fq_detrainement1(idcum(i),k)=fq_detrainement(i,k)
297	f_detrainement1(idcum(i),k)=f_detrainement(i,k)
298	q_detrainement1(idcum(i),k)=q_detrainement(i,k)
299	fq_ddft1(idcum(i),k)=fq_ddft(i,k)
300	fq_fluxmasse1(idcum(i),k)=fq_fluxmasse(i,k)
301	fq_evapprecip1(idcum(i),k)=fq_evapprecip(i,k)
302	do ixt = 1, ntraciso
303	xtwater1(ixt,idcum(i),k)=xtwater(ixt,i,k)
304	xtp1(ixt,idcum(i),k)=xtp(ixt,i,k)
305	fxt_detrainement1(ixt,idcum(i),k)=fxt_detrainement(ixt,i,k)
306	xt_detrainement1(ixt,idcum(i),k)=xt_detrainement(ixt,i,k)
307	fxt_ddft1(ixt,idcum(i),k)=fxt_ddft(ixt,i,k)
308	fxt_fluxmasse1(ixt,idcum(i),k)=fxt_fluxmasse(ixt,i,k)
309	fxt_evapprecip1(ixt,idcum(i),k)=fxt_evapprecip(ixt,i,k)
310	enddo
311	enddo
312	enddo
313	#endif
314	#endif
315
316
317	! Fluxes are defined on a staggered grid and extend up to nl+1
318	DO i = 1, ncum
319	ma1(idcum(i), nlp) = 0.
320	vprecip1(idcum(i), nlp) = 0.
321	vprecipi1(idcum(i), nlp) = 0.
322	upwd1(idcum(i), nlp) = 0.
323	dnwd1(idcum(i), nlp) = 0.
324	dnwd01(idcum(i), nlp) = 0.
325	#ifdef ISO
326	do ixt=1,ntraciso
327	xtvprecip1(ixt,idcum(i), nlp) = 0.
328	xtvprecipi1(ixt,idcum(i), nlp) = 0.
329	enddo
330	#endif
331	END DO
332
333	! AC! do 2100 j=1,ntra
334	! AC!c oct3 do 2110 k=1,nl
335	! AC! do 2110 k=1,nd ! oct3
336	! AC! do 2120 i=1,ncum
337	! AC! ftra1(idcum(i),k,j)=ftra(i,k,j)
338	! AC! 2120 continue
339	! AC! 2110 continue
340	! AC! 2100 continue
341
342	! AC!
343	!jyg<
344	! Essais pour gagner du temps en diminuant l'adressage indirect
345	!! DO j = 1, nd
346	!! DO k = 1, nd
347	!! DO i = 1, ncum
348	!! phi1(idcum(i), k, j) = phi(i, k, j) !AC!
349	!! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
350	!! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
351	!! elij1(idcum(i), k, j) = elij(i, k, j) !RomP
352	!! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
353	!! END DO
354	!! END DO
355	!! END DO
356
357	!! DO i = 1, ncum
358	!! jdcum=idcum(i)
359	!! phi1 (jdcum, 1:nl+1, 1:nl+1) = phi (i, 1:nl+1, 1:nl+1) !AC!
360	!! phi21 (jdcum, 1:nl+1, 1:nl+1) = phi2 (i, 1:nl+1, 1:nl+1) !RomP
361	!! sigij1 (jdcum, 1:nl+1, 1:nl+1) = sigij (i, 1:nl+1, 1:nl+1) !RomP
362	!! elij1 (jdcum, 1:nl+1, 1:nl+1) = elij (i, 1:nl+1, 1:nl+1) !RomP
363	!! epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1) !RomP+jyg
364	!! END DO
365	! These tracer associated arrays are defined up to nl, not nl+1
366	DO i = 1, ncum
367	jdcum=idcum(i)
368	DO k = 1,nl
369	DO j = 1,nl
370	phi1 (jdcum, j, k) = phi (i, j, k) !AC!
371	phi21 (jdcum, j, k) = phi2 (i, j, k) !RomP
372	sigij1 (jdcum, j, k) = sigij (i, j, k) !RomP
373	elij1 (jdcum, j, k) = elij (i, j, k) !RomP
374	epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k) !RomP+jyg
375	END DO
376	ENDDO
377	ENDDO
378	!>jyg
379	! AC!
380
381
382	! do 2220 k2=1,nd
383	! do 2210 k1=1,nd
384	! do 2200 i=1,ncum
385	! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
386	! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
387	! 2200 enddo
388	! 2210 enddo
389	! 2220 enddo
390	!
391	!jyg<
392	ELSE !(compress)
393	!
394	sig1(:,nd) = sig(:,nd)
395	ptop21(:) = ptop2(:)
396	sigd1(:) = sigd(:)
397	precip1(:) = precip(:)
398	cbmf1(:) = cbmf(:)
399	plcl1(:) = plcl(:)
400	plfc1(:) = plfc(:)
401	wbeff1(:) = wbeff(:)
402	iflag1(:) = iflag(:)
403	kbas1(:) = kbas(:)
404	ktop1(:) = ktop(:)
405	wd1(:) = wd(:)
406	cape1(:) = cape(:)
407	cin1(:) = cin(:)
408	plim11(:) = plim1(:)
409	plim21(:) = plim2(:)
410	supmax01(:) = supmax0(:)
411	asupmaxmin1(:) = asupmaxmin(:)
412	#ifdef ISO
413	xtprecip1(:,:)=xtprecip(:,:)
414	#endif
415	!
416	sig1(:, 1:nl) = sig(:, 1:nl)
417	w01(:, 1:nl) = w0(:, 1:nl)
418	ft1(:, 1:nl) = ft(:, 1:nl)
419	fq1(:, 1:nl) = fq(:, 1:nl)
420	fu1(:, 1:nl) = fu(:, 1:nl)
421	fv1(:, 1:nl) = fv(:, 1:nl)
422	ma1(:, 1:nl) = ma(:, 1:nl)
423	mip1(:, 1:nl) = mip(:, 1:nl)
424	vprecip1(:, 1:nl) = vprecip(:, 1:nl)
425	vprecipi1(:, 1:nl) = vprecipi(:, 1:nl)
426	upwd1(:, 1:nl) = upwd(:, 1:nl)
427	dnwd1(:, 1:nl) = dnwd(:, 1:nl)
428	dnwd01(:, 1:nl) = dnwd0(:, 1:nl)
429	qcondc1(:, 1:nl) = qcondc(:, 1:nl)
430	tvp1(:, 1:nl) = tvp(:, 1:nl)
431	ftd1(:, 1:nl) = ftd(:, 1:nl)
432	fqd1(:, 1:nl) = fqd(:, 1:nl)
433	asupmax1(:, 1:nl) = asupmax(:, 1:nl)
434
435	da1(:, 1:nl) = da(:, 1:nl) !AC!
436	mp1(:, 1:nl) = mp(:, 1:nl) !RomP
437	d1a1(:, 1:nl) = d1a(:, 1:nl) !RomP
438	dam1(:, 1:nl) = dam(:, 1:nl) !RomP
439	qta1(:, 1:nl) = qta(:, 1:nl) !jyg
440	clw1(:, 1:nl) = clw(:, 1:nl) !RomP
441	evap1(:, 1:nl) = evap(:, 1:nl) !RomP
442	ep1(:, 1:nl) = ep(:, 1:nl) !RomP
443	eplamM1(:, 1:nl) = eplamM(:, 1:nl) !RomP+jyg
444	wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl) !RomP
445	wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP
446	wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP
447	qtc1(:, 1:nl) = qtc(:, 1:nl)
448	sigt1(:, 1:nl) = sigt(:, 1:nl)
449	!
450	ma1(:, nlp) = 0.
451	vprecip1(:, nlp) = 0.
452	vprecipi1(:, nlp) = 0.
453	upwd1(:, nlp) = 0.
454	dnwd1(:, nlp) = 0.
455	dnwd01(:, nlp) = 0.
456
457	!
458	phi1 (:, 1:nl, 1:nl) = phi (:, 1:nl, 1:nl) !AC!
459	phi21 (:, 1:nl, 1:nl) = phi2 (:, 1:nl, 1:nl) !RomP
460	sigij1 (:, 1:nl, 1:nl) = sigij (:, 1:nl, 1:nl) !RomP
461	elij1 (:, 1:nl, 1:nl) = elij (:, 1:nl, 1:nl) !RomP
462	epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl) !RomP+jyg
463
464	#ifdef ISO
465	do ixt = 1, ntraciso
466	fxt1(:,:,1:nl)=fxt(:,:,1:nl)
467	fxtd1(:,:,1:nl)=fxtd(:,:,1:nl)
468	xtvprecip1(:,:,1:nlp)=xtvprecip(:,:,1:nlp)
469	xtvprecipi1(:,:,1:nlp)=xtvprecipi(:,:,1:nlp)
470	xtevap1(:,:,1:nl)=xtevap(:,:,1:nl)
471	xtwdtrainA1(:,:,1:nl)=xtwdtrainA(:,:,1:nl)
472	xtclw1(:,:,1:nl)=xtclw(:,:,1:nl)
473	enddo
474	#endif
475
476
477	#ifdef ISO
478	#ifdef DIAGISO
479	water1(:,1:nl)=water(:,1:nl)
480	qp1(:,1:nl)=qp(:,1:nl)
481	fq_detrainement1(:,1:nl)=fq_detrainement(:,1:nl)
482	f_detrainement1(:,1:nl)=f_detrainement(:,1:nl)
483	q_detrainement1(:,1:nl)=q_detrainement(:,1:nl)
484	fq_ddft1(:,1:nl)=fq_ddft(:,1:nl)
485	fq_fluxmasse1(:,1:nl)=fq_fluxmasse(:,1:nl)
486	fq_evapprecip1(:,1:nl)=fq_evapprecip(:,1:nl)
487	do ixt = 1, ntraciso
488	xtwater1(:,:,1:nl)=xtwater(:,:,1:nl)
489	xtp1(:,:,1:nl)=xtp(:,:,1:nl)
490	fxt_detrainement1(:,:,1:nl)=fxt_detrainement(:,:,1:nl)
491	xt_detrainement1(:,:,1:nl)=xt_detrainement(:,:,1:nl)
492	fxt_ddft1(:,:,1:nl)=fxt_ddft(:,:,1:nl)
493	fxt_fluxmasse1(:,:,1:nl)=fxt_fluxmasse(:,:,1:nl)
494	fxt_evapprecip1(:,:,1:nl)=fxt_evapprecip(:,:,1:nl)
495	enddo
496	#endif
497	#endif
498
499
500	ENDIF !(compress)
501	!>jyg
502
503	RETURN
504	END SUBROUTINE cv3a_uncompress
505

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

Download in other formats:

Original Format