Context Navigation

cv3a_uncompress.f90 @ 5821

Last change on this file since 5821 was 5712, checked in by yann meurdesoif, 5 months ago

Convection GPU porting : Compression of active convection point is now optional (default remain to true). For GPU runs, convection is not compressed and is computed on each column. The update is done only for column where convection is active

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: 15.3 KB

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

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

Download in other formats:

Original Format