Context Navigation

cv3a_uncompress.F @ 1957

Last change on this file since 1957 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

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: 7.2 KB

Rev	Line
[879]	1	SUBROUTINE cv3a_uncompress(nloc,len,ncum,nd,ntra,idcum
	2	: ,iflag,kbas,ktop
[1518]	3	: ,precip,cbmf,plcl,plfc,wbeff,sig,w0,ptop2
[879]	4	: ,ft,fq,fu,fv,ftra
[1518]	5	: ,sigd,Ma,mip,Vprecip,upwd,dnwd,dnwd0
[879]	6	: ,qcondc,wd,cape,cin
	7	: ,tvp
	8	: ,ftd,fqd
	9	: ,Plim1,Plim2,asupmax,supmax0
	10	: ,asupmaxmin
[1742]	11	!
[1774]	12	: ,da,phi,mp,phi2,d1a,dam,sigij ! RomP+AC+jyg
	13	: ,clw,elij,evap,ep,epmlmMm,eplaMm ! RomP
	14	: ,wdtrainA,wdtrainM ! RomP
[1742]	15	!
[879]	16	o ,iflag1,kbas1,ktop1
[1774]	17	o ,precip1,cbmf1,plcl1,plfc1,wbeff1,sig1,w01,ptop21
	18	o ,ft1,fq1,fu1,fv1,ftra1
	19	o ,sigd1,Ma1,mip1,Vprecip1,upwd1,dnwd1,dnwd01
	20	o ,qcondc1,wd1,cape1,cin1
	21	o ,tvp1
	22	o ,ftd1,fqd1
	23	o ,Plim11,Plim21,asupmax1,supmax01
	24	o ,asupmaxmin1
[1742]	25	!
[1774]	26	o ,da1,phi1,mp1,phi21,d1a1,dam1,sigij1 ! RomP+AC+jyg
	27	o ,clw1,elij1,evap1,ep1,epmlmMm1,eplaMm1! RomP
	28	o ,wdtrainA1,wdtrainM1) ! RomP
[1742]	29	!
[879]	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	***************************************************************
	38	*
	39	implicit none
	40
	41	#include "cv3param.h"
	42
	43	c inputs:
	44	integer nloc, len, ncum, nd, ntra
	45	integer idcum(nloc)
	46	integer iflag(nloc),kbas(nloc),ktop(nloc)
[1518]	47	real precip(nloc),cbmf(nloc),plcl(nloc),plfc(nloc)
	48	real wbeff(len)
[879]	49	real sig(nloc,nd), w0(nloc,nd),ptop2(nloc)
	50	real ft(nloc,nd), fq(nloc,nd), fu(nloc,nd), fv(nloc,nd)
	51	real ftra(nloc,nd,ntra)
[1518]	52	real sigd(nloc)
[1334]	53	real Ma(nloc,nd),mip(nloc,nd),Vprecip(nloc,nd+1)
[879]	54	real upwd(nloc,nd),dnwd(nloc,nd),dnwd0(nloc,nd)
	55	real qcondc(nloc,nd)
	56	real wd(nloc),cape(nloc),cin(nloc)
	57	real tvp(nloc,nd)
	58	real ftd(nloc,nd), fqd(nloc,nd)
	59	real Plim1(nloc),Plim2(nloc)
	60	real asupmax(nloc,nd),supmax0(nloc)
	61	real asupmaxmin(nloc)
[1742]	62	!
	63	real da(nloc,nd),phi(nloc,nd,nd) !AC!
	64	real mp(nloc,nd) !RomP
	65	real phi2(nloc,nd,nd) !RomP
	66	real d1a(nloc,nd),dam(nloc,nd) !RomP
[1774]	67	real sigij(nloc,nd,nd) !RomP
	68	real clw(nloc,nd),elij(nloc,nd,nd) !RomP
	69	real evap(nloc,nd),ep(nloc,nd) !RomP
	70	real epmlmMm(nloc,nd,nd),eplaMm(nloc,nd) !RomP+jyg
[1742]	71	real wdtrainA(nloc,nd), wdtrainM(nloc,nd) !RomP
	72	!
[879]	73	c outputs:
	74	integer iflag1(len),kbas1(len),ktop1(len)
[1518]	75	real precip1(len),cbmf1(len),plcl1(nloc),plfc1(nloc)
	76	real wbeff1(len)
[879]	77	real sig1(len,nd), w01(len,nd),ptop21(len)
	78	real ft1(len,nd), fq1(len,nd), fu1(len,nd), fv1(len,nd)
	79	real ftra1(len,nd,ntra)
[1518]	80	real sigd1(len)
[1334]	81	real Ma1(len,nd),mip1(len,nd),Vprecip1(len,nd+1)
[879]	82	real upwd1(len,nd),dnwd1(len,nd),dnwd01(len,nd)
	83	real qcondc1(len,nd)
	84	real wd1(len),cape1(len),cin1(len)
	85	real tvp1(len,nd)
	86	real ftd1(len,nd), fqd1(len,nd)
	87	real Plim11(len),Plim21(len)
	88	real asupmax1(len,nd),supmax01(len)
	89	real asupmaxmin1(len)
[1742]	90	!
	91	real da1(nloc,nd),phi1(nloc,nd,nd) !AC!
	92	real mp1(nloc,nd) !RomP
	93	real phi21(nloc,nd,nd) !RomP
	94	real d1a1(nloc,nd),dam1(nloc,nd) !RomP
[1774]	95	real sigij1(len,nd,nd) !RomP
	96	real clw1(len,nd),elij1(len,nd,nd) !RomP
	97	real evap1(len,nd),ep1(len,nd) !RomP
	98	real epmlmMm1(len,nd,nd),eplaMm1(len,nd) !RomP+jyg
[1742]	99	real wdtrainA1(len,nd), wdtrainM1(len,nd) !RomP
	100	!
[879]	101	c
	102	c local variables:
[1774]	103	integer i,k,j
	104	cc integer k1,k2
[879]	105
	106	do 2000 i=1,ncum
	107	ptop21(idcum(i))=ptop2(i)
[1518]	108	sigd1(idcum(i))=sigd(i)
[879]	109	precip1(idcum(i))=precip(i)
[1398]	110	cbmf1(idcum(i))=cbmf(i)
[1518]	111	plcl1(idcum(i))=plcl(i)
	112	plfc1(idcum(i))=plfc(i)
	113	wbeff1(idcum(i))=wbeff(i)
[879]	114	iflag1(idcum(i))=iflag(i)
	115	kbas1(idcum(i))=kbas(i)
	116	ktop1(idcum(i))=ktop(i)
	117	wd1(idcum(i))=wd(i)
	118	cape1(idcum(i))=cape(i)
	119	cin1(idcum(i))=cin(i)
	120	Plim11(idcum(i))=Plim1(i)
	121	Plim21(idcum(i))=Plim2(i)
	122	supmax01(idcum(i))=supmax0(i)
	123	asupmaxmin1(idcum(i))=asupmaxmin(i)
	124	2000 continue
	125
	126	do 2020 k=1,nd
	127	do 2010 i=1,ncum
	128	sig1(idcum(i),k)=sig(i,k)
	129	w01(idcum(i),k)=w0(i,k)
	130	ft1(idcum(i),k)=ft(i,k)
	131	fq1(idcum(i),k)=fq(i,k)
	132	fu1(idcum(i),k)=fu(i,k)
	133	fv1(idcum(i),k)=fv(i,k)
	134	Ma1(idcum(i),k)=Ma(i,k)
	135	mip1(idcum(i),k)=mip(i,k)
	136	Vprecip1(idcum(i),k)=Vprecip(i,k)
	137	upwd1(idcum(i),k)=upwd(i,k)
	138	dnwd1(idcum(i),k)=dnwd(i,k)
	139	dnwd01(idcum(i),k)=dnwd0(i,k)
	140	qcondc1(idcum(i),k)=qcondc(i,k)
	141	tvp1(idcum(i),k)=tvp(i,k)
	142	ftd1(idcum(i),k)=ftd(i,k)
	143	fqd1(idcum(i),k)=fqd(i,k)
	144	asupmax1(idcum(i),k)=asupmax(i,k)
[1742]	145	!
	146	da1(idcum(i),k)=da(i,k) !AC!
	147	mp1(idcum(i),k) = mp(i,k) !RomP
	148	d1a1(idcum(i),k) = d1a(i,k) !RomP
	149	dam1(idcum(i),k) = dam(i,k) !RomP
	150	clw1(idcum(i),k) = clw(i,k) !RomP
	151	evap1(idcum(i),k) = evap(i,k) !RomP
	152	ep1(idcum(i),k) = ep(i,k) !RomP
[1774]	153	eplaMm(idcum(i),k) = eplaMm(i,k) !RomP+jyg
	154	wdtrainA1(idcum(i),k)= wdtrainA(i,k) !RomP
	155	wdtrainM1(idcum(i),k)= wdtrainM(i,k) !RomP
[1742]	156	!
[1650]	157	2010 continue
[879]	158	2020 continue
	159
	160	do 2040 i=1,ncum
	161	sig1(idcum(i),nd)=sig(i,nd)
	162	2040 continue
	163
	164
[1650]	165	!AC! do 2100 j=1,ntra
	166	!AC!c oct3 do 2110 k=1,nl
	167	!AC! do 2110 k=1,nd ! oct3
	168	!AC! do 2120 i=1,ncum
	169	!AC! ftra1(idcum(i),k,j)=ftra(i,k,j)
	170	!AC! 2120 continue
	171	!AC! 2110 continue
	172	!AC! 2100 continue
	173
	174	!AC!
[1774]	175	do j=1,nd
	176	do k=1,nd
[1650]	177	do i=1,ncum
[1774]	178	phi1(idcum(i),k,j) = phi(i,k,j) !AC!
	179	phi21(idcum(i),k,j) = phi2(i,k,j) !RomP
	180	sigij1(idcum(i),k,j) = sigij(i,k,j) !RomP
	181	elij1(idcum(i),k,j) = elij(i,k,j) !RomP
	182	epmlmMm(idcum(i),k,j)= epmlmMm(i,k,j) !RomP+jyg
[1650]	183	end do
	184	end do
	185	end do
	186	!AC!
	187
[879]	188	c
	189	c do 2220 k2=1,nd
	190	c do 2210 k1=1,nd
	191	c do 2200 i=1,ncum
	192	c ment1(idcum(i),k1,k2) = ment(i,k1,k2)
[1742]	193	c sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
[879]	194	c2200 enddo
	195	c2210 enddo
	196	c2220 enddo
	197
	198	RETURN
	199	END
	200

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

Download in other formats:

Original Format