Context Navigation

cv3a_uncompress.F90 @ 2471

Last change on this file since 2471 was 2408, checked in by Laurent Fairhead, 9 years ago
Merged trunk changes r2298:2396 into testing branch
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

Rev	Line
[2298]	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, &
[2408]	5	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
[2298]	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, &
[2408]	19	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
[2298]	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)
[879]	29
[1992]	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	! **************************************************************
[879]	38
[1992]	39	IMPLICIT NONE
[879]	40
[1992]	41	include "cv3param.h"
[879]	42
[1992]	43	! inputs:
[2298]	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
[2408]	59	REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecipi
[2298]	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
[879]	68
[2298]	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
[879]	82
[1992]	83	! outputs:
[2298]	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
[2408]	94	REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecipi1
[2298]	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
[1650]	117
	118
[1992]	119	! local variables:
	120	INTEGER i, k, j
[2298]	121	INTEGER jdcum
[1992]	122	! c integer k1,k2
[879]	123
[2298]	124	!jyg<
	125	IF (compress) THEN
	126	!>jyg
[1992]	127	DO i = 1, ncum
[2298]	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)
[1992]	146	END DO
[2298]	147
[2408]	148	DO k = 1, nl
[1992]	149	DO i = 1, ncum
[2298]	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)
[2408]	159	vprecipi1(idcum(i), k) = vprecipi(i, k)
[2298]	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
[1992]	182	END DO
	183	END DO
[2408]	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
[2298]	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
[2408]	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
[2298]	237	END DO
[2408]	238	ENDDO
	239	ENDDO
[2298]	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	!
[2408]	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)
[1992]	293
[2408]	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)
[2298]	306	!
[2408]	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
[2298]	320	ENDIF !(compress)
	321	!>jyg
[1992]	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