Context Navigation

cv3a_uncompress.F @ 1763

Last change on this file since 1763 was 1745, checked in by idelkadi, 12 years ago
Correction de bug (introduit depuis la version 1742) !
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 7.0 KB

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

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

Download in other formats:

Original Format