Context Navigation

cv3a_uncompress.F90 @ 4388

Last change on this file since 4388 was 3496, checked in by jyg, 6 years ago

Implementation of the ejection of liquid precipitation from the adiabatic ascents.
New flags:
+cvflag_prec_eject: logical

n -> old code, y -> new code

+ejectliq: real; possible values 0. & 1.

-> no liquid precipitation is ejected
-> all liquid precipitation is ejected

+ejectice: real; any value between 0. and 1.

fraction of solid precipitation ejected at each level

Note that the adiabatic ascent mass flux decrease due to precipitation ejection is not taken into account.

Attempts to do it led to water conservation violation.

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.2 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, &
	4	ft, fq, 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
[2253]	14	qtc, sigt, &
[2481]	15	epmax_diag, & ! epmax_cape
[2253]	16	iflag1, kbas1, ktop1, &
	17	precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
	18	ft1, fq1, 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
[2481]	28	qtc1, sigt1, &
	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
[1992]	40	IMPLICIT NONE
[879]	41
[1992]	42	include "cv3param.h"
[879]	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
[2253]	56	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ft, fq, fu, fv
	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
	83	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt !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
	93	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fu1, fv1
	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
	120	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1 !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)
	160	fu1(idcum(i), k) = fu(i, k)
	161	fv1(idcum(i), k) = fv(i, k)
	162	ma1(idcum(i), k) = ma(i, k)
	163	mip1(idcum(i), k) = mip(i, k)
	164	vprecip1(idcum(i), k) = vprecip(i, k)
[2306]	165	vprecipi1(idcum(i), k) = vprecipi(i, k)
[2253]	166	upwd1(idcum(i), k) = upwd(i, k)
	167	dnwd1(idcum(i), k) = dnwd(i, k)
	168	dnwd01(idcum(i), k) = dnwd0(i, k)
	169	qcondc1(idcum(i), k) = qcondc(i, k)
	170	tvp1(idcum(i), k) = tvp(i, k)
	171	ftd1(idcum(i), k) = ftd(i, k)
	172	fqd1(idcum(i), k) = fqd(i, k)
	173	asupmax1(idcum(i), k) = asupmax(i, k)
	174
	175	da1(idcum(i), k) = da(i, k) !AC!
	176	mp1(idcum(i), k) = mp(i, k) !RomP
	177	d1a1(idcum(i), k) = d1a(i, k) !RomP
	178	dam1(idcum(i), k) = dam(i, k) !RomP
[3496]	179	qta1(idcum(i), k) = qta(i, k) !jyg
[2253]	180	clw1(idcum(i), k) = clw(i, k) !RomP
	181	evap1(idcum(i), k) = evap(i, k) !RomP
	182	ep1(idcum(i), k) = ep(i, k) !RomP
	183	eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg
	184	wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP
[3496]	185	wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP
[2253]	186	wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP
	187	qtc1(idcum(i), k) = qtc(i, k)
	188	sigt1(idcum(i), k) = sigt(i, k)
	189
[1992]	190	END DO
	191	END DO
[2393]	192
	193	! Fluxes are defined on a staggered grid and extend up to nl+1
	194	DO i = 1, ncum
	195	ma1(idcum(i), nlp) = 0.
	196	vprecip1(idcum(i), nlp) = 0.
	197	vprecipi1(idcum(i), nlp) = 0.
	198	upwd1(idcum(i), nlp) = 0.
	199	dnwd1(idcum(i), nlp) = 0.
	200	dnwd01(idcum(i), nlp) = 0.
	201	END DO
[2253]	202
	203	! AC! do 2100 j=1,ntra
	204	! AC!c oct3 do 2110 k=1,nl
	205	! AC! do 2110 k=1,nd ! oct3
	206	! AC! do 2120 i=1,ncum
	207	! AC! ftra1(idcum(i),k,j)=ftra(i,k,j)
	208	! AC! 2120 continue
	209	! AC! 2110 continue
	210	! AC! 2100 continue
	211
	212	! AC!
	213	!jyg<
	214	! Essais pour gagner du temps en diminuant l'adressage indirect
	215	!! DO j = 1, nd
	216	!! DO k = 1, nd
	217	!! DO i = 1, ncum
	218	!! phi1(idcum(i), k, j) = phi(i, k, j) !AC!
	219	!! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
	220	!! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
	221	!! elij1(idcum(i), k, j) = elij(i, k, j) !RomP
	222	!! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
	223	!! END DO
	224	!! END DO
	225	!! END DO
[2393]	226
	227	!! DO i = 1, ncum
	228	!! jdcum=idcum(i)
	229	!! phi1 (jdcum, 1:nl+1, 1:nl+1) = phi (i, 1:nl+1, 1:nl+1) !AC!
	230	!! phi21 (jdcum, 1:nl+1, 1:nl+1) = phi2 (i, 1:nl+1, 1:nl+1) !RomP
	231	!! sigij1 (jdcum, 1:nl+1, 1:nl+1) = sigij (i, 1:nl+1, 1:nl+1) !RomP
	232	!! elij1 (jdcum, 1:nl+1, 1:nl+1) = elij (i, 1:nl+1, 1:nl+1) !RomP
	233	!! epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1) !RomP+jyg
	234	!! END DO
	235	! These tracer associated arrays are defined up to nl, not nl+1
	236	DO i = 1, ncum
	237	jdcum=idcum(i)
	238	DO k = 1,nl
	239	DO j = 1,nl
	240	phi1 (jdcum, j, k) = phi (i, j, k) !AC!
	241	phi21 (jdcum, j, k) = phi2 (i, j, k) !RomP
	242	sigij1 (jdcum, j, k) = sigij (i, j, k) !RomP
	243	elij1 (jdcum, j, k) = elij (i, j, k) !RomP
	244	epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k) !RomP+jyg
[2253]	245	END DO
[2393]	246	ENDDO
	247	ENDDO
[2253]	248	!>jyg
	249	! AC!
	250
	251
	252	! do 2220 k2=1,nd
	253	! do 2210 k1=1,nd
	254	! do 2200 i=1,ncum
	255	! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
	256	! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
	257	! 2200 enddo
	258	! 2210 enddo
	259	! 2220 enddo
	260	!
	261	!jyg<
	262	ELSE !(compress)
	263	!
[2259]	264	sig1(:,nd) = sig(:,nd)
[2253]	265	ptop21(:) = ptop2(:)
	266	sigd1(:) = sigd(:)
	267	precip1(:) = precip(:)
	268	cbmf1(:) = cbmf(:)
	269	plcl1(:) = plcl(:)
	270	plfc1(:) = plfc(:)
	271	wbeff1(:) = wbeff(:)
	272	iflag1(:) = iflag(:)
	273	kbas1(:) = kbas(:)
	274	ktop1(:) = ktop(:)
	275	wd1(:) = wd(:)
	276	cape1(:) = cape(:)
	277	cin1(:) = cin(:)
	278	plim11(:) = plim1(:)
	279	plim21(:) = plim2(:)
	280	supmax01(:) = supmax0(:)
	281	asupmaxmin1(:) = asupmaxmin(:)
	282	!
[2393]	283	sig1(:, 1:nl) = sig(:, 1:nl)
	284	w01(:, 1:nl) = w0(:, 1:nl)
	285	ft1(:, 1:nl) = ft(:, 1:nl)
	286	fq1(:, 1:nl) = fq(:, 1:nl)
	287	fu1(:, 1:nl) = fu(:, 1:nl)
	288	fv1(:, 1:nl) = fv(:, 1:nl)
	289	ma1(:, 1:nl) = ma(:, 1:nl)
	290	mip1(:, 1:nl) = mip(:, 1:nl)
	291	vprecip1(:, 1:nl) = vprecip(:, 1:nl)
	292	vprecipi1(:, 1:nl) = vprecipi(:, 1:nl)
	293	upwd1(:, 1:nl) = upwd(:, 1:nl)
	294	dnwd1(:, 1:nl) = dnwd(:, 1:nl)
	295	dnwd01(:, 1:nl) = dnwd0(:, 1:nl)
	296	qcondc1(:, 1:nl) = qcondc(:, 1:nl)
	297	tvp1(:, 1:nl) = tvp(:, 1:nl)
	298	ftd1(:, 1:nl) = ftd(:, 1:nl)
	299	fqd1(:, 1:nl) = fqd(:, 1:nl)
	300	asupmax1(:, 1:nl) = asupmax(:, 1:nl)
[1992]	301
[2393]	302	da1(:, 1:nl) = da(:, 1:nl) !AC!
	303	mp1(:, 1:nl) = mp(:, 1:nl) !RomP
	304	d1a1(:, 1:nl) = d1a(:, 1:nl) !RomP
	305	dam1(:, 1:nl) = dam(:, 1:nl) !RomP
[3496]	306	qta1(:, 1:nl) = qta(:, 1:nl) !jyg
[2393]	307	clw1(:, 1:nl) = clw(:, 1:nl) !RomP
	308	evap1(:, 1:nl) = evap(:, 1:nl) !RomP
	309	ep1(:, 1:nl) = ep(:, 1:nl) !RomP
	310	eplamM1(:, 1:nl) = eplamM(:, 1:nl) !RomP+jyg
	311	wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl) !RomP
[3496]	312	wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP
[2393]	313	wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP
	314	qtc1(:, 1:nl) = qtc(:, 1:nl)
	315	sigt1(:, 1:nl) = sigt(:, 1:nl)
[2253]	316	!
[2393]	317	ma1(:, nlp) = 0.
	318	vprecip1(:, nlp) = 0.
	319	vprecipi1(:, nlp) = 0.
	320	upwd1(:, nlp) = 0.
	321	dnwd1(:, nlp) = 0.
	322	dnwd01(:, nlp) = 0.
	323
	324	!
	325	phi1 (:, 1:nl, 1:nl) = phi (:, 1:nl, 1:nl) !AC!
	326	phi21 (:, 1:nl, 1:nl) = phi2 (:, 1:nl, 1:nl) !RomP
	327	sigij1 (:, 1:nl, 1:nl) = sigij (:, 1:nl, 1:nl) !RomP
	328	elij1 (:, 1:nl, 1:nl) = elij (:, 1:nl, 1:nl) !RomP
	329	epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl) !RomP+jyg
[2253]	330	ENDIF !(compress)
	331	!>jyg
[1992]	332
	333	RETURN
	334	END SUBROUTINE cv3a_uncompress
	335

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

Download in other formats:

Original Format