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

Rev	Line
[2253]	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, &
[2306]	5	sigd, ma, mip, vprecip, vprecipi, upwd, dnwd, dnwd0, &
[2253]	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
[3496]	12	qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP+jyg
	13	wdtrainA, wdtrainS, wdtrainM, & ! RomP
[4613]	14	qtc, sigt, detrain, &
[2481]	15	epmax_diag, & ! epmax_cape
[2253]	16	iflag1, kbas1, ktop1, &
	17	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
[4613]	18	ft1, fq1, fqcomp1, fu1, fv1, ftra1, &
[2306]	19	sigd1, ma1, mip1, vprecip1, vprecipi1, upwd1, dnwd1, dnwd01, &
[2253]	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
[3496]	26	qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP+jyg
	27	wdtrainA1, wdtrainS1, wdtrainM1, & ! RomP
[4613]	28	qtc1, sigt1, detrain1, &
[2481]	29	epmax_diag1) ! epmax_cape
[879]	30
[1992]	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	! **************************************************************
[879]	39
[5346]	40	USE lmdz_cv_ini, ONLY : nl,nlp
[5299]	41	IMPLICIT NONE
[879]	42
	43
[1992]	44	! inputs:
[2253]	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
[2481]	55	REAL, DIMENSION (nloc), INTENT (IN) :: epmax_diag
[4613]	56	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ft, fq, fqcomp, fu, fv
[2253]	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
[2306]	61	REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecipi
[2253]	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
[879]	70
[2253]	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
[3496]	77	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qta !jyg
[2253]	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
[4613]	83	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt, detrain !RomP
[3496]	84	REAL, DIMENSION (nloc, nd), INTENT (IN) :: wdtrainA, wdtrainS, wdtrainM !RomP
[879]	85
[1992]	86	! outputs:
[2253]	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
[2481]	91	REAL, DIMENSION (len), INTENT (OUT) :: epmax_diag1 ! epmax_cape
[2253]	92	REAL, DIMENSION (len), INTENT (OUT) :: ptop21
[4613]	93	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fqcomp1, fu1, fv1
[2253]	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
[2306]	98	REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecipi1
[2253]	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
[3496]	114	REAL, DIMENSION (len, nd), INTENT (OUT) :: qta1 !jyg
[2253]	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
[4613]	120	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1, detrain1 !RomP
[3496]	121	REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainS1, wdtrainM1 !RomP
[1650]	122
	123
[1992]	124	! local variables:
	125	INTEGER i, k, j
[2253]	126	INTEGER jdcum
[1992]	127	! c integer k1,k2
[879]	128
[2253]	129	!jyg<
	130	IF (compress) THEN
	131	!>jyg
[1992]	132	DO i = 1, ncum
[2259]	133	sig1(idcum(i), nd) = sig(i, nd)
[2253]	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)
[2481]	151	epmax_diag1(idcum(i)) = epmax_diag(i)
[1992]	152	END DO
[2253]	153
[2393]	154	DO k = 1, nl
[1992]	155	DO i = 1, ncum
[2253]	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)
[4613]	160	fqcomp1(idcum(i), k) = fqcomp(i, k)
[2253]	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)
[2306]	166	vprecipi1(idcum(i), k) = vprecipi(i, k)
[2253]	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
[3496]	180	qta1(idcum(i), k) = qta(i, k) !jyg
[2253]	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
[3496]	186	wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP
[2253]	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)
[4613]	190	detrain1(idcum(i), k) = detrain(i, k)
[2253]	191
[1992]	192	END DO
	193	END DO
[2393]	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
[2253]	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
[2393]	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
[2253]	247	END DO
[2393]	248	ENDDO
	249	ENDDO
[2253]	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	!
[2259]	266	sig1(:,nd) = sig(:,nd)
[2253]	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	!
[2393]	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)
[4613]	289	fqcomp1(:, 1:nl) = fqcomp(:, 1:nl)
[2393]	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)
[1992]	304
[2393]	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
[3496]	309	qta1(:, 1:nl) = qta(:, 1:nl) !jyg
[2393]	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
[3496]	315	wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP
[2393]	316	wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP
	317	qtc1(:, 1:nl) = qtc(:, 1:nl)
	318	sigt1(:, 1:nl) = sigt(:, 1:nl)
[4613]	319	detrain1(:, 1:nl) = detrain(:, 1:nl)
[2253]	320	!
[2393]	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
[2253]	334	ENDIF !(compress)
	335	!>jyg
[1992]	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