Context Navigation

cv3a_uncompress.f90 @ 5496

Last change on this file since 5496 was 5491, checked in by jyg, 2 weeks ago

New outputs :

+ coef_clos = [conv mass flux given by Alp closure]/[conv mass flux given by Emanuel scheme closure]
+ coef_clos_eff = effective coefficient used in the convective scheme.

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.9 KB

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

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

Download in other formats:

Original Format