Context Navigation

cv3a_uncompress.F90 @ 2253

Last change on this file since 2253 was 2253, checked in by jyg, 10 years ago

1/ Introduction of two variables in the ".def" files: (i) cvl_sig2feed is
the top of the convective feeding layer in sigma coordinates (D=0.97);
(ii) cvl_comp_threshold is the threshold fraction of convective points
below which compression occurs (D=1.).
2/ Corrections of various bugs revealed by the changes in compression:

correct bugs in cv3a_uncompress.F90 for 3 fields used for convective

scavenging.

add a reset to zero of "sig" and "w0" for non-convective points

(cva_driver.F90).

in cv3_routines.F90, correct bounds of a few loops in cv3_undilute2,

correct the reset of the no-convection counter in cv3_yield.

in phys_output_write_mod.F90, correct output of wdtrainA and wdtrainM.

3/ Improve declarations in various subroutines.

Modified files:

conema3.h
cv3param.h
cv3p1_closure.F90
conf_phys_m.F90
cv3a_compress.F90
phys_output_write_mod.F90
cv3_routines.F90
concvl.F90
cva_driver.F90
cv3a_uncompress.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: 11.9 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, &
	5	sigd, ma, mip, vprecip, 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	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, &
	19	sigd1, ma1, mip1, vprecip1, 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	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:
[2253]	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
	59	REAL, DIMENSION (nloc, nd), INTENT (IN) :: upwd, dnwd, dnwd0
	60	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qcondc
	61	REAL, DIMENSION (nloc), INTENT (IN) :: wd, cape, cin
	62	REAL, DIMENSION (nloc, nd), INTENT (IN) :: tvp
	63	REAL, DIMENSION (nloc, nd), INTENT (IN) :: ftd, fqd
	64	REAL, DIMENSION (nloc), INTENT (IN) :: plim1, plim2
	65	REAL, DIMENSION (nloc, nd), INTENT (IN) :: asupmax
	66	REAL, DIMENSION (nloc), INTENT (IN) :: supmax0, asupmaxmin
[879]	67
[2253]	68	REAL, DIMENSION (nloc, nd), INTENT (IN) :: da
	69	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi !AC!
	70	REAL, DIMENSION (nloc, nd), INTENT (IN) :: mp !RomP
	71	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi2 !RomP
	72	REAL, DIMENSION (nloc, nd), INTENT (IN) :: d1a, dam !RomP
	73	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: sigij !RomP
	74	REAL, DIMENSION (nloc, nd), INTENT (IN) :: clw !RomP
	75	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: elij !RomP
	76	REAL, DIMENSION (nloc, nd), INTENT (IN) :: evap, ep !RomP
	77	REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: epmlmMm !RomP+jyg
	78	REAL, DIMENSION (nloc, nd), INTENT (IN) :: eplamM !RomP+jyg
	79	REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt !RomP
	80	REAL, DIMENSION (nloc, nd), INTENT (IN) :: wdtrainA, wdtrainM !RomP
[879]	81
[1992]	82	! outputs:
[2253]	83	INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1, kbas1, ktop1
	84	REAL, DIMENSION (len), INTENT (OUT) :: precip1, cbmf1, plcl1, plfc1
	85	REAL, DIMENSION (len), INTENT (OUT) :: wbeff1
	86	REAL, DIMENSION (len, nd), INTENT (OUT) :: sig1, w01
	87	REAL, DIMENSION (len), INTENT (OUT) :: ptop21
	88	REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fu1, fv1
	89	REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1
	90	REAL, DIMENSION (len), INTENT (OUT) :: sigd1
	91	REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1, mip1
	92	REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecip1
	93	REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1, dnwd1, dnwd01
	94	REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1
	95	REAL, DIMENSION (len), INTENT (OUT) :: wd1, cape1, cin1
	96	REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1
	97	REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1, fqd1
	98	REAL, DIMENSION (len), INTENT (OUT) :: plim11, plim21
	99	REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1
	100	REAL, DIMENSION (len), INTENT (OUT) :: supmax01, asupmaxmin1
	101
	102	REAL, DIMENSION (len, nd), INTENT (OUT) :: da1
	103	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 !AC!
	104	REAL, DIMENSION (len, nd), INTENT (OUT) :: mp1 !RomP
	105	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 !RomP
	106	REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1, dam1 !RomP !RomP
	107	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1 !RomP
	108	REAL, DIMENSION (len, nd), INTENT (OUT) :: clw1 !RomP
	109	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: elij1 !RomP
	110	REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1, ep1 !RomP
	111	REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 !RomP+jyg
	112	REAL, DIMENSION (len, nd), INTENT (OUT) :: eplamM1 !RomP+jyg
	113	REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1 !RomP
	114	REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainM1 !RomP
[1650]	115
	116
[1992]	117	! local variables:
	118	INTEGER i, k, j
[2253]	119	INTEGER jdcum
[1992]	120	! c integer k1,k2
[879]	121
[2253]	122	!jyg<
	123	IF (compress) THEN
	124	!>jyg
[1992]	125	DO i = 1, ncum
[2253]	126	ptop21(idcum(i)) = ptop2(i)
	127	sigd1(idcum(i)) = sigd(i)
	128	precip1(idcum(i)) = precip(i)
	129	cbmf1(idcum(i)) = cbmf(i)
	130	plcl1(idcum(i)) = plcl(i)
	131	plfc1(idcum(i)) = plfc(i)
	132	wbeff1(idcum(i)) = wbeff(i)
	133	iflag1(idcum(i)) = iflag(i)
	134	kbas1(idcum(i)) = kbas(i)
	135	ktop1(idcum(i)) = ktop(i)
	136	wd1(idcum(i)) = wd(i)
	137	cape1(idcum(i)) = cape(i)
	138	cin1(idcum(i)) = cin(i)
	139	plim11(idcum(i)) = plim1(i)
	140	plim21(idcum(i)) = plim2(i)
	141	supmax01(idcum(i)) = supmax0(i)
	142	asupmaxmin1(idcum(i)) = asupmaxmin(i)
[1992]	143	END DO
[2253]	144
[1992]	145	DO k = 1, nd
	146	DO i = 1, ncum
[2253]	147	sig1(idcum(i), k) = sig(i, k)
	148	w01(idcum(i), k) = w0(i, k)
	149	ft1(idcum(i), k) = ft(i, k)
	150	fq1(idcum(i), k) = fq(i, k)
	151	fu1(idcum(i), k) = fu(i, k)
	152	fv1(idcum(i), k) = fv(i, k)
	153	ma1(idcum(i), k) = ma(i, k)
	154	mip1(idcum(i), k) = mip(i, k)
	155	vprecip1(idcum(i), k) = vprecip(i, k)
	156	upwd1(idcum(i), k) = upwd(i, k)
	157	dnwd1(idcum(i), k) = dnwd(i, k)
	158	dnwd01(idcum(i), k) = dnwd0(i, k)
	159	qcondc1(idcum(i), k) = qcondc(i, k)
	160	tvp1(idcum(i), k) = tvp(i, k)
	161	ftd1(idcum(i), k) = ftd(i, k)
	162	fqd1(idcum(i), k) = fqd(i, k)
	163	asupmax1(idcum(i), k) = asupmax(i, k)
	164
	165	da1(idcum(i), k) = da(i, k) !AC!
	166	mp1(idcum(i), k) = mp(i, k) !RomP
	167	d1a1(idcum(i), k) = d1a(i, k) !RomP
	168	dam1(idcum(i), k) = dam(i, k) !RomP
	169	clw1(idcum(i), k) = clw(i, k) !RomP
	170	evap1(idcum(i), k) = evap(i, k) !RomP
	171	ep1(idcum(i), k) = ep(i, k) !RomP
	172	eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg
	173	wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP
	174	wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP
	175	qtc1(idcum(i), k) = qtc(i, k)
	176	sigt1(idcum(i), k) = sigt(i, k)
	177
[1992]	178	END DO
	179	END DO
	180
[2253]	181	DO i = 1, ncum
	182	sig1(idcum(i), nd) = sig(i, nd)
	183	END DO
	184
	185
	186	! AC! do 2100 j=1,ntra
	187	! AC!c oct3 do 2110 k=1,nl
	188	! AC! do 2110 k=1,nd ! oct3
	189	! AC! do 2120 i=1,ncum
	190	! AC! ftra1(idcum(i),k,j)=ftra(i,k,j)
	191	! AC! 2120 continue
	192	! AC! 2110 continue
	193	! AC! 2100 continue
	194
	195	! AC!
	196	!jyg<
	197	! Essais pour gagner du temps en diminuant l'adressage indirect
	198	!! DO j = 1, nd
	199	!! DO k = 1, nd
	200	!! DO i = 1, ncum
	201	!! phi1(idcum(i), k, j) = phi(i, k, j) !AC!
	202	!! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
	203	!! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
	204	!! elij1(idcum(i), k, j) = elij(i, k, j) !RomP
	205	!! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
	206	!! END DO
	207	!! END DO
	208	!! END DO
	209	DO i = 1, ncum
	210	jdcum=idcum(i)
	211	phi1(jdcum,:,:) = phi(i,:,:) !AC!
	212	phi21(jdcum,:,:) = phi2(i,:,:) !RomP
	213	sigij1(jdcum,:,:) = sigij(i,:,:) !RomP
	214	elij1(jdcum,:,:) = elij(i,:,:) !RomP
	215	epmlmMm1(jdcum,:,:) = epmlmMm(i,:,:) !RomP+jyg
	216	END DO
	217	!>jyg
	218	! AC!
	219
	220
	221	! do 2220 k2=1,nd
	222	! do 2210 k1=1,nd
	223	! do 2200 i=1,ncum
	224	! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
	225	! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
	226	! 2200 enddo
	227	! 2210 enddo
	228	! 2220 enddo
	229	!
	230	!jyg<
	231	ELSE !(compress)
	232	!
	233	ptop21(:) = ptop2(:)
	234	sigd1(:) = sigd(:)
	235	precip1(:) = precip(:)
	236	cbmf1(:) = cbmf(:)
	237	plcl1(:) = plcl(:)
	238	plfc1(:) = plfc(:)
	239	wbeff1(:) = wbeff(:)
	240	iflag1(:) = iflag(:)
	241	kbas1(:) = kbas(:)
	242	ktop1(:) = ktop(:)
	243	wd1(:) = wd(:)
	244	cape1(:) = cape(:)
	245	cin1(:) = cin(:)
	246	plim11(:) = plim1(:)
	247	plim21(:) = plim2(:)
	248	supmax01(:) = supmax0(:)
	249	asupmaxmin1(:) = asupmaxmin(:)
	250	!
	251	sig1(:,:) = sig(:,:)
	252	w01(:,:) = w0(:,:)
	253	ft1(:,:) = ft(:,:)
	254	fq1(:,:) = fq(:,:)
	255	fu1(:,:) = fu(:,:)
	256	fv1(:,:) = fv(:,:)
	257	ma1(:,:) = ma(:,:)
	258	mip1(:,:) = mip(:,:)
	259	vprecip1(:,:) = vprecip(:,:)
	260	upwd1(:,:) = upwd(:,:)
	261	dnwd1(:,:) = dnwd(:,:)
	262	dnwd01(:,:) = dnwd0(:,:)
	263	qcondc1(:,:) = qcondc(:,:)
	264	tvp1(:,:) = tvp(:,:)
	265	ftd1(:,:) = ftd(:,:)
	266	fqd1(:,:) = fqd(:,:)
	267	asupmax1(:,:) = asupmax(:,:)
[1992]	268
[2253]	269	da1(:,:) = da(:,:) !AC!
	270	mp1(:,:) = mp(:,:) !RomP
	271	d1a1(:,:) = d1a(:,:) !RomP
	272	dam1(:,:) = dam(:,:) !RomP
	273	clw1(:,:) = clw(:,:) !RomP
	274	evap1(:,:) = evap(:,:) !RomP
	275	ep1(:,:) = ep(:,:) !RomP
	276	eplamM1(:,:) = eplamM(:,:) !RomP+jyg
	277	wdtrainA1(:,:) = wdtrainA(:,:) !RomP
	278	wdtrainM1(:,:) = wdtrainM(:,:) !RomP
	279	qtc1(:,:) = qtc(:,:)
	280	sigt1(:,:) = sigt(:,:)
	281	!
	282	sig1(:,:) = sig(:,:)
	283	!
	284	phi1(:,:,:) = phi(:,:,:) !AC!
	285	phi21(:,:,:) = phi2(:,:,:) !RomP
	286	sigij1(:,:,:) = sigij(:,:,:) !RomP
	287	elij1(:,:,:) = elij(:,:,:) !RomP
	288	epmlmMm1(:,:,:) = epmlmMm(:,:,:) !RomP+jyg
	289	ENDIF !(compress)
	290	!>jyg
[1992]	291
	292	RETURN
	293	END SUBROUTINE cv3a_uncompress
	294

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

Download in other formats:

Original Format