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