source: LMDZ6/branches/LMDZ_ECRad/libf/phylmd/cv3a_uncompress.F90 @ 5024

Last change on this file since 5024 was 4727, checked in by idelkadi, 13 months ago

Merged trunk changes -r4488:4726 LMDZ_ECRad branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.4 KB
Line 
1SUBROUTINE 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  IMPLICIT NONE
41
42  include "cv3param.h"
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
338END SUBROUTINE cv3a_uncompress
339
Note: See TracBrowser for help on using the repository browser.