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, fqcomp, fu, fv, ftra, & |
---|
5 | sigd, ma, mip, vprecip, vprecipi, 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 | qta, clw, elij, evap, ep, epmlmMm, eplaMm, & ! RomP+jyg |
---|
13 | wdtrainA, wdtrainS, wdtrainM, & ! RomP |
---|
14 | qtc, sigt, detrain, & |
---|
15 | epmax_diag, & ! epmax_cape |
---|
16 | iflag1, kbas1, ktop1, & |
---|
17 | precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, & |
---|
18 | ft1, fq1, fqcomp1, fu1, fv1, ftra1, & |
---|
19 | sigd1, ma1, mip1, vprecip1, vprecipi1, 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 | qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP+jyg |
---|
27 | wdtrainA1, wdtrainS1, wdtrainM1, & ! RomP |
---|
28 | qtc1, sigt1, detrain1, & |
---|
29 | epmax_diag1) ! epmax_cape |
---|
30 | |
---|
31 | ! ************************************************************** |
---|
32 | ! * |
---|
33 | ! CV3A_UNCOMPRESS * |
---|
34 | ! * |
---|
35 | ! * |
---|
36 | ! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 * |
---|
37 | ! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.36.17 * |
---|
38 | ! ************************************************************** |
---|
39 | |
---|
40 | USE cv3param_mod_h |
---|
41 | IMPLICIT NONE |
---|
42 | |
---|
43 | |
---|
44 | ! inputs: |
---|
45 | INTEGER, INTENT (IN) :: nloc, len, ncum, nd, ntra |
---|
46 | INTEGER, DIMENSION (nloc), INTENT (IN) :: idcum(nloc) |
---|
47 | !jyg< |
---|
48 | LOGICAL, INTENT (IN) :: compress |
---|
49 | !>jyg |
---|
50 | INTEGER, DIMENSION (nloc), INTENT (IN) ::iflag, kbas, ktop |
---|
51 | REAL, DIMENSION (nloc), INTENT (IN) :: precip, cbmf, plcl, plfc |
---|
52 | REAL, DIMENSION (nloc), INTENT (IN) :: wbeff |
---|
53 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: sig, w0 |
---|
54 | REAL, DIMENSION (nloc), INTENT (IN) :: ptop2 |
---|
55 | REAL, DIMENSION (nloc), INTENT (IN) :: epmax_diag |
---|
56 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: ft, fq, fqcomp, fu, fv |
---|
57 | REAL, DIMENSION (nloc, nd, ntra), INTENT (IN) :: ftra |
---|
58 | REAL, DIMENSION (nloc), INTENT (IN) :: sigd |
---|
59 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: ma, mip |
---|
60 | REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecip |
---|
61 | REAL, DIMENSION (nloc, nd+1), INTENT (IN) :: vprecipi |
---|
62 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: upwd, dnwd, dnwd0 |
---|
63 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: qcondc |
---|
64 | REAL, DIMENSION (nloc), INTENT (IN) :: wd, cape, cin |
---|
65 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: tvp |
---|
66 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: ftd, fqd |
---|
67 | REAL, DIMENSION (nloc), INTENT (IN) :: plim1, plim2 |
---|
68 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: asupmax |
---|
69 | REAL, DIMENSION (nloc), INTENT (IN) :: supmax0, asupmaxmin |
---|
70 | |
---|
71 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: da |
---|
72 | REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi !AC! |
---|
73 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: mp !RomP |
---|
74 | REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: phi2 !RomP |
---|
75 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: d1a, dam !RomP |
---|
76 | REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: sigij !RomP |
---|
77 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: qta !jyg |
---|
78 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: clw !RomP |
---|
79 | REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: elij !RomP |
---|
80 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: evap, ep !RomP |
---|
81 | REAL, DIMENSION (nloc, nd, nd), INTENT (IN) :: epmlmMm !RomP+jyg |
---|
82 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: eplamM !RomP+jyg |
---|
83 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt, detrain !RomP |
---|
84 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: wdtrainA, wdtrainS, wdtrainM !RomP |
---|
85 | |
---|
86 | ! outputs: |
---|
87 | INTEGER, DIMENSION (len), INTENT (OUT) :: iflag1, kbas1, ktop1 |
---|
88 | REAL, DIMENSION (len), INTENT (OUT) :: precip1, cbmf1, plcl1, plfc1 |
---|
89 | REAL, DIMENSION (len), INTENT (OUT) :: wbeff1 |
---|
90 | REAL, DIMENSION (len, nd), INTENT (OUT) :: sig1, w01 |
---|
91 | REAL, DIMENSION (len), INTENT (OUT) :: epmax_diag1 ! epmax_cape |
---|
92 | REAL, DIMENSION (len), INTENT (OUT) :: ptop21 |
---|
93 | REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fqcomp1, fu1, fv1 |
---|
94 | REAL, DIMENSION (len, nd, ntra), INTENT (OUT) :: ftra1 |
---|
95 | REAL, DIMENSION (len), INTENT (OUT) :: sigd1 |
---|
96 | REAL, DIMENSION (len, nd), INTENT (OUT) :: ma1, mip1 |
---|
97 | REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecip1 |
---|
98 | REAL, DIMENSION (len, nd+1), INTENT (OUT) :: vprecipi1 |
---|
99 | REAL, DIMENSION (len, nd), INTENT (OUT) :: upwd1, dnwd1, dnwd01 |
---|
100 | REAL, DIMENSION (len, nd), INTENT (OUT) :: qcondc1 |
---|
101 | REAL, DIMENSION (len), INTENT (OUT) :: wd1, cape1, cin1 |
---|
102 | REAL, DIMENSION (len, nd), INTENT (OUT) :: tvp1 |
---|
103 | REAL, DIMENSION (len, nd), INTENT (OUT) :: ftd1, fqd1 |
---|
104 | REAL, DIMENSION (len), INTENT (OUT) :: plim11, plim21 |
---|
105 | REAL, DIMENSION (len, nd), INTENT (OUT) :: asupmax1 |
---|
106 | REAL, DIMENSION (len), INTENT (OUT) :: supmax01, asupmaxmin1 |
---|
107 | |
---|
108 | REAL, DIMENSION (len, nd), INTENT (OUT) :: da1 |
---|
109 | REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi1 !AC! |
---|
110 | REAL, DIMENSION (len, nd), INTENT (OUT) :: mp1 !RomP |
---|
111 | REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: phi21 !RomP |
---|
112 | REAL, DIMENSION (len, nd), INTENT (OUT) :: d1a1, dam1 !RomP !RomP |
---|
113 | REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: sigij1 !RomP |
---|
114 | REAL, DIMENSION (len, nd), INTENT (OUT) :: qta1 !jyg |
---|
115 | REAL, DIMENSION (len, nd), INTENT (OUT) :: clw1 !RomP |
---|
116 | REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: elij1 !RomP |
---|
117 | REAL, DIMENSION (len, nd), INTENT (OUT) :: evap1, ep1 !RomP |
---|
118 | REAL, DIMENSION (len, nd, nd), INTENT (OUT) :: epmlmMm1 !RomP+jyg |
---|
119 | REAL, DIMENSION (len, nd), INTENT (OUT) :: eplamM1 !RomP+jyg |
---|
120 | REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1, detrain1 !RomP |
---|
121 | REAL, DIMENSION (len, nd), INTENT (OUT) :: wdtrainA1, wdtrainS1, wdtrainM1 !RomP |
---|
122 | |
---|
123 | |
---|
124 | ! local variables: |
---|
125 | INTEGER i, k, j |
---|
126 | INTEGER jdcum |
---|
127 | ! c integer k1,k2 |
---|
128 | |
---|
129 | !jyg< |
---|
130 | IF (compress) THEN |
---|
131 | !>jyg |
---|
132 | DO i = 1, ncum |
---|
133 | sig1(idcum(i), nd) = sig(i, nd) |
---|
134 | ptop21(idcum(i)) = ptop2(i) |
---|
135 | sigd1(idcum(i)) = sigd(i) |
---|
136 | precip1(idcum(i)) = precip(i) |
---|
137 | cbmf1(idcum(i)) = cbmf(i) |
---|
138 | plcl1(idcum(i)) = plcl(i) |
---|
139 | plfc1(idcum(i)) = plfc(i) |
---|
140 | wbeff1(idcum(i)) = wbeff(i) |
---|
141 | iflag1(idcum(i)) = iflag(i) |
---|
142 | kbas1(idcum(i)) = kbas(i) |
---|
143 | ktop1(idcum(i)) = ktop(i) |
---|
144 | wd1(idcum(i)) = wd(i) |
---|
145 | cape1(idcum(i)) = cape(i) |
---|
146 | cin1(idcum(i)) = cin(i) |
---|
147 | plim11(idcum(i)) = plim1(i) |
---|
148 | plim21(idcum(i)) = plim2(i) |
---|
149 | supmax01(idcum(i)) = supmax0(i) |
---|
150 | asupmaxmin1(idcum(i)) = asupmaxmin(i) |
---|
151 | epmax_diag1(idcum(i)) = epmax_diag(i) |
---|
152 | END DO |
---|
153 | |
---|
154 | DO k = 1, nl |
---|
155 | DO i = 1, ncum |
---|
156 | sig1(idcum(i), k) = sig(i, k) |
---|
157 | w01(idcum(i), k) = w0(i, k) |
---|
158 | ft1(idcum(i), k) = ft(i, k) |
---|
159 | fq1(idcum(i), k) = fq(i, k) |
---|
160 | fqcomp1(idcum(i), k) = fqcomp(i, k) |
---|
161 | fu1(idcum(i), k) = fu(i, k) |
---|
162 | fv1(idcum(i), k) = fv(i, k) |
---|
163 | ma1(idcum(i), k) = ma(i, k) |
---|
164 | mip1(idcum(i), k) = mip(i, k) |
---|
165 | vprecip1(idcum(i), k) = vprecip(i, k) |
---|
166 | vprecipi1(idcum(i), k) = vprecipi(i, k) |
---|
167 | upwd1(idcum(i), k) = upwd(i, k) |
---|
168 | dnwd1(idcum(i), k) = dnwd(i, k) |
---|
169 | dnwd01(idcum(i), k) = dnwd0(i, k) |
---|
170 | qcondc1(idcum(i), k) = qcondc(i, k) |
---|
171 | tvp1(idcum(i), k) = tvp(i, k) |
---|
172 | ftd1(idcum(i), k) = ftd(i, k) |
---|
173 | fqd1(idcum(i), k) = fqd(i, k) |
---|
174 | asupmax1(idcum(i), k) = asupmax(i, k) |
---|
175 | |
---|
176 | da1(idcum(i), k) = da(i, k) !AC! |
---|
177 | mp1(idcum(i), k) = mp(i, k) !RomP |
---|
178 | d1a1(idcum(i), k) = d1a(i, k) !RomP |
---|
179 | dam1(idcum(i), k) = dam(i, k) !RomP |
---|
180 | qta1(idcum(i), k) = qta(i, k) !jyg |
---|
181 | clw1(idcum(i), k) = clw(i, k) !RomP |
---|
182 | evap1(idcum(i), k) = evap(i, k) !RomP |
---|
183 | ep1(idcum(i), k) = ep(i, k) !RomP |
---|
184 | eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg |
---|
185 | wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP |
---|
186 | wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP |
---|
187 | wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP |
---|
188 | qtc1(idcum(i), k) = qtc(i, k) |
---|
189 | sigt1(idcum(i), k) = sigt(i, k) |
---|
190 | detrain1(idcum(i), k) = detrain(i, k) |
---|
191 | |
---|
192 | END DO |
---|
193 | END DO |
---|
194 | |
---|
195 | ! Fluxes are defined on a staggered grid and extend up to nl+1 |
---|
196 | DO i = 1, ncum |
---|
197 | ma1(idcum(i), nlp) = 0. |
---|
198 | vprecip1(idcum(i), nlp) = 0. |
---|
199 | vprecipi1(idcum(i), nlp) = 0. |
---|
200 | upwd1(idcum(i), nlp) = 0. |
---|
201 | dnwd1(idcum(i), nlp) = 0. |
---|
202 | dnwd01(idcum(i), nlp) = 0. |
---|
203 | END DO |
---|
204 | |
---|
205 | ! AC! do 2100 j=1,ntra |
---|
206 | ! AC!c oct3 do 2110 k=1,nl |
---|
207 | ! AC! do 2110 k=1,nd ! oct3 |
---|
208 | ! AC! do 2120 i=1,ncum |
---|
209 | ! AC! ftra1(idcum(i),k,j)=ftra(i,k,j) |
---|
210 | ! AC! 2120 continue |
---|
211 | ! AC! 2110 continue |
---|
212 | ! AC! 2100 continue |
---|
213 | |
---|
214 | ! AC! |
---|
215 | !jyg< |
---|
216 | ! Essais pour gagner du temps en diminuant l'adressage indirect |
---|
217 | !! DO j = 1, nd |
---|
218 | !! DO k = 1, nd |
---|
219 | !! DO i = 1, ncum |
---|
220 | !! phi1(idcum(i), k, j) = phi(i, k, j) !AC! |
---|
221 | !! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP |
---|
222 | !! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP |
---|
223 | !! elij1(idcum(i), k, j) = elij(i, k, j) !RomP |
---|
224 | !! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg |
---|
225 | !! END DO |
---|
226 | !! END DO |
---|
227 | !! END DO |
---|
228 | |
---|
229 | !! DO i = 1, ncum |
---|
230 | !! jdcum=idcum(i) |
---|
231 | !! phi1 (jdcum, 1:nl+1, 1:nl+1) = phi (i, 1:nl+1, 1:nl+1) !AC! |
---|
232 | !! phi21 (jdcum, 1:nl+1, 1:nl+1) = phi2 (i, 1:nl+1, 1:nl+1) !RomP |
---|
233 | !! sigij1 (jdcum, 1:nl+1, 1:nl+1) = sigij (i, 1:nl+1, 1:nl+1) !RomP |
---|
234 | !! elij1 (jdcum, 1:nl+1, 1:nl+1) = elij (i, 1:nl+1, 1:nl+1) !RomP |
---|
235 | !! epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1) !RomP+jyg |
---|
236 | !! END DO |
---|
237 | ! These tracer associated arrays are defined up to nl, not nl+1 |
---|
238 | DO i = 1, ncum |
---|
239 | jdcum=idcum(i) |
---|
240 | DO k = 1,nl |
---|
241 | DO j = 1,nl |
---|
242 | phi1 (jdcum, j, k) = phi (i, j, k) !AC! |
---|
243 | phi21 (jdcum, j, k) = phi2 (i, j, k) !RomP |
---|
244 | sigij1 (jdcum, j, k) = sigij (i, j, k) !RomP |
---|
245 | elij1 (jdcum, j, k) = elij (i, j, k) !RomP |
---|
246 | epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k) !RomP+jyg |
---|
247 | END DO |
---|
248 | ENDDO |
---|
249 | ENDDO |
---|
250 | !>jyg |
---|
251 | ! AC! |
---|
252 | |
---|
253 | |
---|
254 | ! do 2220 k2=1,nd |
---|
255 | ! do 2210 k1=1,nd |
---|
256 | ! do 2200 i=1,ncum |
---|
257 | ! ment1(idcum(i),k1,k2) = ment(i,k1,k2) |
---|
258 | ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2) |
---|
259 | ! 2200 enddo |
---|
260 | ! 2210 enddo |
---|
261 | ! 2220 enddo |
---|
262 | ! |
---|
263 | !jyg< |
---|
264 | ELSE !(compress) |
---|
265 | ! |
---|
266 | sig1(:,nd) = sig(:,nd) |
---|
267 | ptop21(:) = ptop2(:) |
---|
268 | sigd1(:) = sigd(:) |
---|
269 | precip1(:) = precip(:) |
---|
270 | cbmf1(:) = cbmf(:) |
---|
271 | plcl1(:) = plcl(:) |
---|
272 | plfc1(:) = plfc(:) |
---|
273 | wbeff1(:) = wbeff(:) |
---|
274 | iflag1(:) = iflag(:) |
---|
275 | kbas1(:) = kbas(:) |
---|
276 | ktop1(:) = ktop(:) |
---|
277 | wd1(:) = wd(:) |
---|
278 | cape1(:) = cape(:) |
---|
279 | cin1(:) = cin(:) |
---|
280 | plim11(:) = plim1(:) |
---|
281 | plim21(:) = plim2(:) |
---|
282 | supmax01(:) = supmax0(:) |
---|
283 | asupmaxmin1(:) = asupmaxmin(:) |
---|
284 | ! |
---|
285 | sig1(:, 1:nl) = sig(:, 1:nl) |
---|
286 | w01(:, 1:nl) = w0(:, 1:nl) |
---|
287 | ft1(:, 1:nl) = ft(:, 1:nl) |
---|
288 | fq1(:, 1:nl) = fq(:, 1:nl) |
---|
289 | fqcomp1(:, 1:nl) = fqcomp(:, 1:nl) |
---|
290 | fu1(:, 1:nl) = fu(:, 1:nl) |
---|
291 | fv1(:, 1:nl) = fv(:, 1:nl) |
---|
292 | ma1(:, 1:nl) = ma(:, 1:nl) |
---|
293 | mip1(:, 1:nl) = mip(:, 1:nl) |
---|
294 | vprecip1(:, 1:nl) = vprecip(:, 1:nl) |
---|
295 | vprecipi1(:, 1:nl) = vprecipi(:, 1:nl) |
---|
296 | upwd1(:, 1:nl) = upwd(:, 1:nl) |
---|
297 | dnwd1(:, 1:nl) = dnwd(:, 1:nl) |
---|
298 | dnwd01(:, 1:nl) = dnwd0(:, 1:nl) |
---|
299 | qcondc1(:, 1:nl) = qcondc(:, 1:nl) |
---|
300 | tvp1(:, 1:nl) = tvp(:, 1:nl) |
---|
301 | ftd1(:, 1:nl) = ftd(:, 1:nl) |
---|
302 | fqd1(:, 1:nl) = fqd(:, 1:nl) |
---|
303 | asupmax1(:, 1:nl) = asupmax(:, 1:nl) |
---|
304 | |
---|
305 | da1(:, 1:nl) = da(:, 1:nl) !AC! |
---|
306 | mp1(:, 1:nl) = mp(:, 1:nl) !RomP |
---|
307 | d1a1(:, 1:nl) = d1a(:, 1:nl) !RomP |
---|
308 | dam1(:, 1:nl) = dam(:, 1:nl) !RomP |
---|
309 | qta1(:, 1:nl) = qta(:, 1:nl) !jyg |
---|
310 | clw1(:, 1:nl) = clw(:, 1:nl) !RomP |
---|
311 | evap1(:, 1:nl) = evap(:, 1:nl) !RomP |
---|
312 | ep1(:, 1:nl) = ep(:, 1:nl) !RomP |
---|
313 | eplamM1(:, 1:nl) = eplamM(:, 1:nl) !RomP+jyg |
---|
314 | wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl) !RomP |
---|
315 | wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP |
---|
316 | wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP |
---|
317 | qtc1(:, 1:nl) = qtc(:, 1:nl) |
---|
318 | sigt1(:, 1:nl) = sigt(:, 1:nl) |
---|
319 | detrain1(:, 1:nl) = detrain(:, 1:nl) |
---|
320 | ! |
---|
321 | ma1(:, nlp) = 0. |
---|
322 | vprecip1(:, nlp) = 0. |
---|
323 | vprecipi1(:, nlp) = 0. |
---|
324 | upwd1(:, nlp) = 0. |
---|
325 | dnwd1(:, nlp) = 0. |
---|
326 | dnwd01(:, nlp) = 0. |
---|
327 | |
---|
328 | ! |
---|
329 | phi1 (:, 1:nl, 1:nl) = phi (:, 1:nl, 1:nl) !AC! |
---|
330 | phi21 (:, 1:nl, 1:nl) = phi2 (:, 1:nl, 1:nl) !RomP |
---|
331 | sigij1 (:, 1:nl, 1:nl) = sigij (:, 1:nl, 1:nl) !RomP |
---|
332 | elij1 (:, 1:nl, 1:nl) = elij (:, 1:nl, 1:nl) !RomP |
---|
333 | epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl) !RomP+jyg |
---|
334 | ENDIF !(compress) |
---|
335 | !>jyg |
---|
336 | |
---|
337 | RETURN |
---|
338 | END SUBROUTINE cv3a_uncompress |
---|
339 | |
---|