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