Context Navigation

cv3a_uncompress.f90 @ 5489

Last change on this file since 5489 was 5346, checked in by fhourdin, 12 months ago

Debut de replaysation de la convection profonde.

Regroupement de cvparam, cv3param et cvthermo (récemment
passés de statut de .h à module, dans un unique module
lmdz_cv_ini.f90

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.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, fqcomp, 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, detrain, &
15	epmax_diag, & ! epmax_cape
16	iflag1, kbas1, ktop1, &
17	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
18	ft1, fq1, fqcomp1, 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, detrain1, &
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	USE lmdz_cv_ini, ONLY : nl,nlp
41	IMPLICIT NONE
42
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, fqcomp, 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, detrain !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, fqcomp1, 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, detrain1 !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	fqcomp1(idcum(i), k) = fqcomp(i, k)
161	fu1(idcum(i), k) = fu(i, k)
162	fv1(idcum(i), k) = fv(i, k)
163	ma1(idcum(i), k) = ma(i, k)
164	mip1(idcum(i), k) = mip(i, k)
165	vprecip1(idcum(i), k) = vprecip(i, k)
166	vprecipi1(idcum(i), k) = vprecipi(i, k)
167	upwd1(idcum(i), k) = upwd(i, k)
168	dnwd1(idcum(i), k) = dnwd(i, k)
169	dnwd01(idcum(i), k) = dnwd0(i, k)
170	qcondc1(idcum(i), k) = qcondc(i, k)
171	tvp1(idcum(i), k) = tvp(i, k)
172	ftd1(idcum(i), k) = ftd(i, k)
173	fqd1(idcum(i), k) = fqd(i, k)
174	asupmax1(idcum(i), k) = asupmax(i, k)
175
176	da1(idcum(i), k) = da(i, k) !AC!
177	mp1(idcum(i), k) = mp(i, k) !RomP
178	d1a1(idcum(i), k) = d1a(i, k) !RomP
179	dam1(idcum(i), k) = dam(i, k) !RomP
180	qta1(idcum(i), k) = qta(i, k) !jyg
181	clw1(idcum(i), k) = clw(i, k) !RomP
182	evap1(idcum(i), k) = evap(i, k) !RomP
183	ep1(idcum(i), k) = ep(i, k) !RomP
184	eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg
185	wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP
186	wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP
187	wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP
188	qtc1(idcum(i), k) = qtc(i, k)
189	sigt1(idcum(i), k) = sigt(i, k)
190	detrain1(idcum(i), k) = detrain(i, k)
191
192	END DO
193	END DO
194
195	! Fluxes are defined on a staggered grid and extend up to nl+1
196	DO i = 1, ncum
197	ma1(idcum(i), nlp) = 0.
198	vprecip1(idcum(i), nlp) = 0.
199	vprecipi1(idcum(i), nlp) = 0.
200	upwd1(idcum(i), nlp) = 0.
201	dnwd1(idcum(i), nlp) = 0.
202	dnwd01(idcum(i), nlp) = 0.
203	END DO
204
205	! AC! do 2100 j=1,ntra
206	! AC!c oct3 do 2110 k=1,nl
207	! AC! do 2110 k=1,nd ! oct3
208	! AC! do 2120 i=1,ncum
209	! AC! ftra1(idcum(i),k,j)=ftra(i,k,j)
210	! AC! 2120 continue
211	! AC! 2110 continue
212	! AC! 2100 continue
213
214	! AC!
215	!jyg<
216	! Essais pour gagner du temps en diminuant l'adressage indirect
217	!! DO j = 1, nd
218	!! DO k = 1, nd
219	!! DO i = 1, ncum
220	!! phi1(idcum(i), k, j) = phi(i, k, j) !AC!
221	!! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
222	!! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
223	!! elij1(idcum(i), k, j) = elij(i, k, j) !RomP
224	!! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
225	!! END DO
226	!! END DO
227	!! END DO
228
229	!! DO i = 1, ncum
230	!! jdcum=idcum(i)
231	!! phi1 (jdcum, 1:nl+1, 1:nl+1) = phi (i, 1:nl+1, 1:nl+1) !AC!
232	!! phi21 (jdcum, 1:nl+1, 1:nl+1) = phi2 (i, 1:nl+1, 1:nl+1) !RomP
233	!! sigij1 (jdcum, 1:nl+1, 1:nl+1) = sigij (i, 1:nl+1, 1:nl+1) !RomP
234	!! elij1 (jdcum, 1:nl+1, 1:nl+1) = elij (i, 1:nl+1, 1:nl+1) !RomP
235	!! epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1) !RomP+jyg
236	!! END DO
237	! These tracer associated arrays are defined up to nl, not nl+1
238	DO i = 1, ncum
239	jdcum=idcum(i)
240	DO k = 1,nl
241	DO j = 1,nl
242	phi1 (jdcum, j, k) = phi (i, j, k) !AC!
243	phi21 (jdcum, j, k) = phi2 (i, j, k) !RomP
244	sigij1 (jdcum, j, k) = sigij (i, j, k) !RomP
245	elij1 (jdcum, j, k) = elij (i, j, k) !RomP
246	epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k) !RomP+jyg
247	END DO
248	ENDDO
249	ENDDO
250	!>jyg
251	! AC!
252
253
254	! do 2220 k2=1,nd
255	! do 2210 k1=1,nd
256	! do 2200 i=1,ncum
257	! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
258	! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
259	! 2200 enddo
260	! 2210 enddo
261	! 2220 enddo
262	!
263	!jyg<
264	ELSE !(compress)
265	!
266	sig1(:,nd) = sig(:,nd)
267	ptop21(:) = ptop2(:)
268	sigd1(:) = sigd(:)
269	precip1(:) = precip(:)
270	cbmf1(:) = cbmf(:)
271	plcl1(:) = plcl(:)
272	plfc1(:) = plfc(:)
273	wbeff1(:) = wbeff(:)
274	iflag1(:) = iflag(:)
275	kbas1(:) = kbas(:)
276	ktop1(:) = ktop(:)
277	wd1(:) = wd(:)
278	cape1(:) = cape(:)
279	cin1(:) = cin(:)
280	plim11(:) = plim1(:)
281	plim21(:) = plim2(:)
282	supmax01(:) = supmax0(:)
283	asupmaxmin1(:) = asupmaxmin(:)
284	!
285	sig1(:, 1:nl) = sig(:, 1:nl)
286	w01(:, 1:nl) = w0(:, 1:nl)
287	ft1(:, 1:nl) = ft(:, 1:nl)
288	fq1(:, 1:nl) = fq(:, 1:nl)
289	fqcomp1(:, 1:nl) = fqcomp(:, 1:nl)
290	fu1(:, 1:nl) = fu(:, 1:nl)
291	fv1(:, 1:nl) = fv(:, 1:nl)
292	ma1(:, 1:nl) = ma(:, 1:nl)
293	mip1(:, 1:nl) = mip(:, 1:nl)
294	vprecip1(:, 1:nl) = vprecip(:, 1:nl)
295	vprecipi1(:, 1:nl) = vprecipi(:, 1:nl)
296	upwd1(:, 1:nl) = upwd(:, 1:nl)
297	dnwd1(:, 1:nl) = dnwd(:, 1:nl)
298	dnwd01(:, 1:nl) = dnwd0(:, 1:nl)
299	qcondc1(:, 1:nl) = qcondc(:, 1:nl)
300	tvp1(:, 1:nl) = tvp(:, 1:nl)
301	ftd1(:, 1:nl) = ftd(:, 1:nl)
302	fqd1(:, 1:nl) = fqd(:, 1:nl)
303	asupmax1(:, 1:nl) = asupmax(:, 1:nl)
304
305	da1(:, 1:nl) = da(:, 1:nl) !AC!
306	mp1(:, 1:nl) = mp(:, 1:nl) !RomP
307	d1a1(:, 1:nl) = d1a(:, 1:nl) !RomP
308	dam1(:, 1:nl) = dam(:, 1:nl) !RomP
309	qta1(:, 1:nl) = qta(:, 1:nl) !jyg
310	clw1(:, 1:nl) = clw(:, 1:nl) !RomP
311	evap1(:, 1:nl) = evap(:, 1:nl) !RomP
312	ep1(:, 1:nl) = ep(:, 1:nl) !RomP
313	eplamM1(:, 1:nl) = eplamM(:, 1:nl) !RomP+jyg
314	wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl) !RomP
315	wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP
316	wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP
317	qtc1(:, 1:nl) = qtc(:, 1:nl)
318	sigt1(:, 1:nl) = sigt(:, 1:nl)
319	detrain1(:, 1:nl) = detrain(:, 1:nl)
320	!
321	ma1(:, nlp) = 0.
322	vprecip1(:, nlp) = 0.
323	vprecipi1(:, nlp) = 0.
324	upwd1(:, nlp) = 0.
325	dnwd1(:, nlp) = 0.
326	dnwd01(:, nlp) = 0.
327
328	!
329	phi1 (:, 1:nl, 1:nl) = phi (:, 1:nl, 1:nl) !AC!
330	phi21 (:, 1:nl, 1:nl) = phi2 (:, 1:nl, 1:nl) !RomP
331	sigij1 (:, 1:nl, 1:nl) = sigij (:, 1:nl, 1:nl) !RomP
332	elij1 (:, 1:nl, 1:nl) = elij (:, 1:nl, 1:nl) !RomP
333	epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl) !RomP+jyg
334	ENDIF !(compress)
335	!>jyg
336
337	RETURN
338	END SUBROUTINE cv3a_uncompress
339

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

Download in other formats:

Original Format