My Project
 All Classes Files Functions Variables Macros
cv3a_uncompress.F
Go to the documentation of this file.
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,mp,phi2,d1a,dam,sigij ! RomP+AC+jyg
13  : ,clw,elij,evap,ep,epmlmmm,eplamm ! RomP
14  : ,wdtraina,wdtrainm ! RomP
15 !
16  o ,iflag1,kbas1,ktop1
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
25 !
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
29 !
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)
47  real precip(nloc),cbmf(nloc),plcl(nloc),plfc(nloc)
48  real wbeff(len)
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)
52  real sigd(nloc)
53  real ma(nloc,nd),mip(nloc,nd),vprecip(nloc,nd+1)
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)
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
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
71  real wdtraina(nloc,nd), wdtrainm(nloc,nd) !RomP
72 !
73 c outputs:
74  integer iflag1(len),kbas1(len),ktop1(len)
75  real precip1(len),cbmf1(len),plcl1(nloc),plfc1(nloc)
76  real wbeff1(len)
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)
80  real sigd1(len)
81  real ma1(len,nd),mip1(len,nd),vprecip1(len,nd+1)
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)
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
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
99  real wdtraina1(len,nd), wdtrainm1(len,nd) !RomP
100 !
101 c
102 c local variables:
103  integer i,k,j
104 cc integer k1,k2
105 
106  do 2000 i=1,ncum
107  ptop21(idcum(i))=ptop2(i)
108  sigd1(idcum(i))=sigd(i)
109  precip1(idcum(i))=precip(i)
110  cbmf1(idcum(i))=cbmf(i)
111  plcl1(idcum(i))=plcl(i)
112  plfc1(idcum(i))=plfc(i)
113  wbeff1(idcum(i))=wbeff(i)
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)
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
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
156 !
157  2010 continue
158  2020 continue
159 
160  do 2040 i=1,ncum
161  sig1(idcum(i),nd)=sig(i,nd)
162 2040 continue
163 
164 
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!
175  do j=1,nd
176  do k=1,nd
177  do i=1,ncum
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
183  end do
184  end do
185  end do
186 !AC!
187 
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)
193 c sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
194 c2200 enddo
195 c2210 enddo
196 c2220 enddo
197 
198  RETURN
199  END
200