Context Navigation

cv3a_uncompress.F90 @ 4945

Last change on this file since 4945 was 4613, checked in by fhourdin, 16 months ago
Integration/replay_isation travail Louis (ratqs)
Property svn:keywords set to `Id`
File size: 20.6 KB

Rev	Line
[3927]	1	SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, &
	2	iflag, kbas, ktop, &
	3	precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, &
[4613]	4	ft, fq, fqcomp, fu, fv, ftra, &
[3927]	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
[4613]	14	qtc, sigt, detrain, &
[3927]	15	epmax_diag, & ! epmax_cape
	16	iflag1, kbas1, ktop1, &
	17	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
[4613]	18	ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
[3927]	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
[4613]	28	qtc1, sigt1, detrain1, &
[3927]	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
[4143]	56	USE infotrac_phy, ONLY : ntraciso=>ntiso
[3927]	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
[4613]	74	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ft, fq, fqcomp, fu, fv
[3927]	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
[4613]	101	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt, detrain !RomP
[3927]	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
[4613]	122	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fqcomp1, fu1, fv1
[3927]	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
[4613]	149	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1, detrain1 !RomP
[3927]	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)
[4613]	246	fqcomp1(idcum(i), k) = fqcomp(i, k)
[3927]	247	fu1(idcum(i), k) = fu(i, k)
	248	fv1(idcum(i), k) = fv(i, k)
	249	ma1(idcum(i), k) = ma(i, k)
	250	mip1(idcum(i), k) = mip(i, k)
	251	vprecip1(idcum(i), k) = vprecip(i, k)
	252	vprecipi1(idcum(i), k) = vprecipi(i, k)
	253	upwd1(idcum(i), k) = upwd(i, k)
	254	dnwd1(idcum(i), k) = dnwd(i, k)
	255	dnwd01(idcum(i), k) = dnwd0(i, k)
	256	qcondc1(idcum(i), k) = qcondc(i, k)
	257	tvp1(idcum(i), k) = tvp(i, k)
	258	ftd1(idcum(i), k) = ftd(i, k)
	259	fqd1(idcum(i), k) = fqd(i, k)
	260	asupmax1(idcum(i), k) = asupmax(i, k)
	261
	262	da1(idcum(i), k) = da(i, k) !AC!
	263	mp1(idcum(i), k) = mp(i, k) !RomP
	264	d1a1(idcum(i), k) = d1a(i, k) !RomP
	265	dam1(idcum(i), k) = dam(i, k) !RomP
	266	qta1(idcum(i), k) = qta(i, k) !jyg
	267	clw1(idcum(i), k) = clw(i, k) !RomP
	268	evap1(idcum(i), k) = evap(i, k) !RomP
	269	ep1(idcum(i), k) = ep(i, k) !RomP
	270	eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg
	271	wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP
	272	wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP
	273	wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP
	274	qtc1(idcum(i), k) = qtc(i, k)
	275	sigt1(idcum(i), k) = sigt(i, k)
[4613]	276	detrain1(idcum(i), k) = detrain(i, k)
[3927]	277
	278	#ifdef ISO
	279	do ixt = 1, ntraciso
	280	fxt1(ixt,idcum(i),k)=fxt(ixt,i,k)
	281	fxtd1(ixt,idcum(i),k)=fxtd(ixt,i,k)
	282	xtvprecip1(ixt,idcum(i),k)=xtvprecip(ixt,i,k)
	283	xtvprecipi1(ixt,idcum(i),k)=xtvprecipi(ixt,i,k)
	284	xtevap1(ixt,idcum(i),k)=xtevap(ixt,i,k)
	285	xtwdtraina1(ixt,idcum(i),k)=xtwdtraina(ixt,i,k)
	286	xtclw1(ixt,idcum(i),k)=xtclw(ixt,i,k)
	287	enddo
	288	#endif
	289	END DO
	290	END DO
	291
	292	#ifdef ISO
	293	#ifdef DIAGISO
	294	do k=1,nl
	295	do i=1,ncum
	296	water1(idcum(i),k)=water(i,k)
	297	qp1(idcum(i),k)=qp(i,k)
	298	fq_detrainement1(idcum(i),k)=fq_detrainement(i,k)
	299	f_detrainement1(idcum(i),k)=f_detrainement(i,k)
	300	q_detrainement1(idcum(i),k)=q_detrainement(i,k)
	301	fq_ddft1(idcum(i),k)=fq_ddft(i,k)
	302	fq_fluxmasse1(idcum(i),k)=fq_fluxmasse(i,k)
	303	fq_evapprecip1(idcum(i),k)=fq_evapprecip(i,k)
	304	do ixt = 1, ntraciso
	305	xtwater1(ixt,idcum(i),k)=xtwater(ixt,i,k)
	306	xtp1(ixt,idcum(i),k)=xtp(ixt,i,k)
	307	fxt_detrainement1(ixt,idcum(i),k)=fxt_detrainement(ixt,i,k)
	308	xt_detrainement1(ixt,idcum(i),k)=xt_detrainement(ixt,i,k)
	309	fxt_ddft1(ixt,idcum(i),k)=fxt_ddft(ixt,i,k)
	310	fxt_fluxmasse1(ixt,idcum(i),k)=fxt_fluxmasse(ixt,i,k)
	311	fxt_evapprecip1(ixt,idcum(i),k)=fxt_evapprecip(ixt,i,k)
	312	enddo
	313	enddo
	314	enddo
	315	#endif
	316	#endif
	317
	318
	319	! Fluxes are defined on a staggered grid and extend up to nl+1
	320	DO i = 1, ncum
	321	ma1(idcum(i), nlp) = 0.
	322	vprecip1(idcum(i), nlp) = 0.
	323	vprecipi1(idcum(i), nlp) = 0.
	324	upwd1(idcum(i), nlp) = 0.
	325	dnwd1(idcum(i), nlp) = 0.
	326	dnwd01(idcum(i), nlp) = 0.
	327	#ifdef ISO
	328	do ixt=1,ntraciso
	329	xtvprecip1(ixt,idcum(i), nlp) = 0.
	330	xtvprecipi1(ixt,idcum(i), nlp) = 0.
	331	enddo
	332	#endif
	333	END DO
	334
	335	! AC! do 2100 j=1,ntra
	336	! AC!c oct3 do 2110 k=1,nl
	337	! AC! do 2110 k=1,nd ! oct3
	338	! AC! do 2120 i=1,ncum
	339	! AC! ftra1(idcum(i),k,j)=ftra(i,k,j)
	340	! AC! 2120 continue
	341	! AC! 2110 continue
	342	! AC! 2100 continue
	343
	344	! AC!
	345	!jyg<
	346	! Essais pour gagner du temps en diminuant l'adressage indirect
	347	!! DO j = 1, nd
	348	!! DO k = 1, nd
	349	!! DO i = 1, ncum
	350	!! phi1(idcum(i), k, j) = phi(i, k, j) !AC!
	351	!! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
	352	!! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
	353	!! elij1(idcum(i), k, j) = elij(i, k, j) !RomP
	354	!! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
	355	!! END DO
	356	!! END DO
	357	!! END DO
	358
	359	!! DO i = 1, ncum
	360	!! jdcum=idcum(i)
	361	!! phi1 (jdcum, 1:nl+1, 1:nl+1) = phi (i, 1:nl+1, 1:nl+1) !AC!
	362	!! phi21 (jdcum, 1:nl+1, 1:nl+1) = phi2 (i, 1:nl+1, 1:nl+1) !RomP
	363	!! sigij1 (jdcum, 1:nl+1, 1:nl+1) = sigij (i, 1:nl+1, 1:nl+1) !RomP
	364	!! elij1 (jdcum, 1:nl+1, 1:nl+1) = elij (i, 1:nl+1, 1:nl+1) !RomP
	365	!! epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1) !RomP+jyg
	366	!! END DO
	367	! These tracer associated arrays are defined up to nl, not nl+1
	368	DO i = 1, ncum
	369	jdcum=idcum(i)
	370	DO k = 1,nl
	371	DO j = 1,nl
	372	phi1 (jdcum, j, k) = phi (i, j, k) !AC!
	373	phi21 (jdcum, j, k) = phi2 (i, j, k) !RomP
	374	sigij1 (jdcum, j, k) = sigij (i, j, k) !RomP
	375	elij1 (jdcum, j, k) = elij (i, j, k) !RomP
	376	epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k) !RomP+jyg
	377	END DO
	378	ENDDO
	379	ENDDO
	380	!>jyg
	381	! AC!
	382
	383
	384	! do 2220 k2=1,nd
	385	! do 2210 k1=1,nd
	386	! do 2200 i=1,ncum
	387	! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
	388	! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
	389	! 2200 enddo
	390	! 2210 enddo
	391	! 2220 enddo
	392	!
	393	!jyg<
	394	ELSE !(compress)
	395	!
	396	sig1(:,nd) = sig(:,nd)
	397	ptop21(:) = ptop2(:)
	398	sigd1(:) = sigd(:)
	399	precip1(:) = precip(:)
	400	cbmf1(:) = cbmf(:)
	401	plcl1(:) = plcl(:)
	402	plfc1(:) = plfc(:)
	403	wbeff1(:) = wbeff(:)
	404	iflag1(:) = iflag(:)
	405	kbas1(:) = kbas(:)
	406	ktop1(:) = ktop(:)
	407	wd1(:) = wd(:)
	408	cape1(:) = cape(:)
	409	cin1(:) = cin(:)
	410	plim11(:) = plim1(:)
	411	plim21(:) = plim2(:)
	412	supmax01(:) = supmax0(:)
	413	asupmaxmin1(:) = asupmaxmin(:)
	414	#ifdef ISO
	415	xtprecip1(:,:)=xtprecip(:,:)
	416	#endif
	417	!
	418	sig1(:, 1:nl) = sig(:, 1:nl)
	419	w01(:, 1:nl) = w0(:, 1:nl)
	420	ft1(:, 1:nl) = ft(:, 1:nl)
	421	fq1(:, 1:nl) = fq(:, 1:nl)
[4613]	422	fqcomp1(:, 1:nl) = fqcomp(:, 1:nl)
[3927]	423	fu1(:, 1:nl) = fu(:, 1:nl)
	424	fv1(:, 1:nl) = fv(:, 1:nl)
	425	ma1(:, 1:nl) = ma(:, 1:nl)
	426	mip1(:, 1:nl) = mip(:, 1:nl)
	427	vprecip1(:, 1:nl) = vprecip(:, 1:nl)
	428	vprecipi1(:, 1:nl) = vprecipi(:, 1:nl)
	429	upwd1(:, 1:nl) = upwd(:, 1:nl)
	430	dnwd1(:, 1:nl) = dnwd(:, 1:nl)
	431	dnwd01(:, 1:nl) = dnwd0(:, 1:nl)
	432	qcondc1(:, 1:nl) = qcondc(:, 1:nl)
	433	tvp1(:, 1:nl) = tvp(:, 1:nl)
	434	ftd1(:, 1:nl) = ftd(:, 1:nl)
	435	fqd1(:, 1:nl) = fqd(:, 1:nl)
	436	asupmax1(:, 1:nl) = asupmax(:, 1:nl)
	437
	438	da1(:, 1:nl) = da(:, 1:nl) !AC!
	439	mp1(:, 1:nl) = mp(:, 1:nl) !RomP
	440	d1a1(:, 1:nl) = d1a(:, 1:nl) !RomP
	441	dam1(:, 1:nl) = dam(:, 1:nl) !RomP
	442	qta1(:, 1:nl) = qta(:, 1:nl) !jyg
	443	clw1(:, 1:nl) = clw(:, 1:nl) !RomP
	444	evap1(:, 1:nl) = evap(:, 1:nl) !RomP
	445	ep1(:, 1:nl) = ep(:, 1:nl) !RomP
	446	eplamM1(:, 1:nl) = eplamM(:, 1:nl) !RomP+jyg
	447	wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl) !RomP
	448	wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP
	449	wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP
	450	qtc1(:, 1:nl) = qtc(:, 1:nl)
	451	sigt1(:, 1:nl) = sigt(:, 1:nl)
[4613]	452	detrain1(:, 1:nl) = detrain(:, 1:nl)
[3927]	453	!
	454	ma1(:, nlp) = 0.
	455	vprecip1(:, nlp) = 0.
	456	vprecipi1(:, nlp) = 0.
	457	upwd1(:, nlp) = 0.
	458	dnwd1(:, nlp) = 0.
	459	dnwd01(:, nlp) = 0.
	460
	461	!
	462	phi1 (:, 1:nl, 1:nl) = phi (:, 1:nl, 1:nl) !AC!
	463	phi21 (:, 1:nl, 1:nl) = phi2 (:, 1:nl, 1:nl) !RomP
	464	sigij1 (:, 1:nl, 1:nl) = sigij (:, 1:nl, 1:nl) !RomP
	465	elij1 (:, 1:nl, 1:nl) = elij (:, 1:nl, 1:nl) !RomP
	466	epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl) !RomP+jyg
	467
	468	#ifdef ISO
	469	do ixt = 1, ntraciso
	470	fxt1(:,:,1:nl)=fxt(:,:,1:nl)
	471	fxtd1(:,:,1:nl)=fxtd(:,:,1:nl)
	472	xtvprecip1(:,:,1:nlp)=xtvprecip(:,:,1:nlp)
	473	xtvprecipi1(:,:,1:nlp)=xtvprecipi(:,:,1:nlp)
	474	xtevap1(:,:,1:nl)=xtevap(:,:,1:nl)
	475	xtwdtrainA1(:,:,1:nl)=xtwdtrainA(:,:,1:nl)
	476	xtclw1(:,:,1:nl)=xtclw(:,:,1:nl)
	477	enddo
	478	#endif
	479
	480
	481	#ifdef ISO
	482	#ifdef DIAGISO
	483	water1(:,1:nl)=water(:,1:nl)
	484	qp1(:,1:nl)=qp(:,1:nl)
	485	fq_detrainement1(:,1:nl)=fq_detrainement(:,1:nl)
	486	f_detrainement1(:,1:nl)=f_detrainement(:,1:nl)
	487	q_detrainement1(:,1:nl)=q_detrainement(:,1:nl)
	488	fq_ddft1(:,1:nl)=fq_ddft(:,1:nl)
	489	fq_fluxmasse1(:,1:nl)=fq_fluxmasse(:,1:nl)
	490	fq_evapprecip1(:,1:nl)=fq_evapprecip(:,1:nl)
	491	do ixt = 1, ntraciso
	492	xtwater1(:,:,1:nl)=xtwater(:,:,1:nl)
	493	xtp1(:,:,1:nl)=xtp(:,:,1:nl)
	494	fxt_detrainement1(:,:,1:nl)=fxt_detrainement(:,:,1:nl)
	495	xt_detrainement1(:,:,1:nl)=xt_detrainement(:,:,1:nl)
	496	fxt_ddft1(:,:,1:nl)=fxt_ddft(:,:,1:nl)
	497	fxt_fluxmasse1(:,:,1:nl)=fxt_fluxmasse(:,:,1:nl)
	498	fxt_evapprecip1(:,:,1:nl)=fxt_evapprecip(:,:,1:nl)
	499	enddo
	500	#endif
	501	#endif
	502
	503
	504	ENDIF !(compress)
	505	!>jyg
	506
	507	RETURN
	508	END SUBROUTINE cv3a_uncompress
	509

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

Download in other formats:

Original Format