source: LMDZ6/trunk/libf/phylmdiso/cv3a_uncompress.F90 @ 4491

Last change on this file since 4491 was 4143, checked in by dcugnet, 3 years ago
  • Some variables are renamed or replaced by direct equivalents:
    • iso_indnum -> tracers(:)%iso_iName
    • niso_possibles -> niso
    • iqiso -> iqIsoPha ; index_trac -> itZonIso
    • ok_iso_verif -> isoCheck
    • ntraceurs_zone -> nzone ; ntraciso -> ntiso
    • qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio
  • Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times.
  • Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18).
  • The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).
  • Property svn:keywords set to Id
File size: 20.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, 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,          &
15                           epmax_diag, & ! epmax_cape
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                           qta1, clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &  ! RomP+jyg
27                           wdtrainA1, wdtrainS1, wdtrainM1, &                   ! RomP
28                           qtc1, sigt1, &
29                           epmax_diag1  & ! epmax_cape
30#ifdef ISO
31     &          ,xtprecip,fxt,fxtd, xtvprecip,xtvprecipi, xtclw,xtevap,xtwdtraina      &
32     &         ,xtprecip1,fxt1,fxtd1, xtvprecip1, xtvprecipi1, xtclw1,xtevap1,xtwdtraina1 &
33#ifdef DIAGISO
34     &         , water,xtwater,qp,xtp &
35     &         , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
36     &         , fxt_detrainement,fxt_ddft,fxt_fluxmasse, fxt_evapprecip &
37     &         , f_detrainement,q_detrainement,xt_detrainement &
38     &         , water1,xtwater1,qp1,xtp1 &
39     &         , fq_detrainement1,fq_ddft1,fq_fluxmasse1,fq_evapprecip1  &
40     &         , fxt_detrainement1,fxt_ddft1,fxt_fluxmasse1, fxt_evapprecip1 &
41     &         , f_detrainement1,q_detrainement1,xt_detrainement1 &
42#endif       
43#endif
44     &          )
45
46  ! **************************************************************
47  ! *
48  ! CV3A_UNCOMPRESS                                             *
49  ! *
50  ! *
51  ! written by   : Sandrine Bony-Lena , 17/05/2003, 11.22.15    *
52  ! modified by  : Jean-Yves Grandpeix, 23/06/2003, 10.36.17    *
53  ! **************************************************************
54
55#ifdef ISO
56  USE infotrac_phy, ONLY : ntraciso=>ntiso
57#endif
58  IMPLICIT NONE
59
60  include "cv3param.h"
61
62  ! inputs:
63  INTEGER, INTENT (IN)                               :: nloc, len, ncum, nd, ntra
64  INTEGER, DIMENSION (nloc), INTENT (IN)             :: idcum(nloc)
65!jyg<
66  LOGICAL, INTENT (IN)                               :: compress
67!>jyg
68  INTEGER, DIMENSION (nloc), INTENT (IN)             ::iflag, kbas, ktop
69  REAL, DIMENSION (nloc), INTENT (IN)                :: precip, cbmf, plcl, plfc
70  REAL, DIMENSION (nloc), INTENT (IN)                :: wbeff
71  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig, w0
72  REAL, DIMENSION (nloc), INTENT (IN)                :: ptop2
73  REAL, DIMENSION (nloc), INTENT (IN)                :: epmax_diag
74  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ft, fq, fu, fv
75  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: ftra
76  REAL, DIMENSION (nloc), INTENT (IN)                :: sigd
77  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ma, mip
78  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: vprecip
79  REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: vprecipi
80  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: upwd, dnwd, dnwd0
81  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qcondc
82  REAL, DIMENSION (nloc), INTENT (IN)                :: wd, cape, cin
83  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: tvp
84  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ftd, fqd
85  REAL, DIMENSION (nloc), INTENT (IN)                :: plim1, plim2
86  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: asupmax
87  REAL, DIMENSION (nloc), INTENT (IN)                :: supmax0, asupmaxmin
88
89  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: da
90  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: phi                    !AC!
91  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: mp                     !RomP
92  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: phi2                   !RomP
93  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: d1a, dam               !RomP
94  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: sigij                  !RomP
95  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qta                    !jyg
96  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: clw                    !RomP
97  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: elij                   !RomP
98  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: evap, ep               !RomP
99  REAL, DIMENSION (nloc, nd, nd), INTENT (IN)        :: epmlmMm                !RomP+jyg
100  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: eplamM                 !RomP+jyg
101  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: qtc, sigt              !RomP
102  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: wdtrainA, wdtrainS, wdtrainM     !RomP
103
104#ifdef ISO
105      real, DIMENSION (ntraciso,nloc), INTENT (IN)      :: xtprecip
106      real, DIMENSION (ntraciso,nloc,nd), INTENT (IN)   :: fxt
107      real, DIMENSION(ntraciso,nloc,nd), INTENT (IN)   ::   fxtd
108      real, DIMENSION(ntraciso,nloc,nd+1), INTENT (IN)   ::   xtvprecip
109      real, DIMENSION(ntraciso,nloc,nd+1), INTENT (IN)   ::   xtvprecipi
110      real xtevap(ntraciso,nloc,nd)
111      real xtwdtraina(ntraciso,nloc,nd)
112      real xtclw(ntraciso,nloc,nd)
113#endif
114
115  ! outputs:
116  INTEGER, DIMENSION (len), INTENT (OUT)             :: iflag1, kbas1, ktop1
117  REAL, DIMENSION (len), INTENT (OUT)                :: precip1, cbmf1, plcl1, plfc1
118  REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
119  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sig1, w01
120  REAL, DIMENSION (len), INTENT (OUT)                :: epmax_diag1 ! epmax_cape
121  REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
122  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1, fq1, fu1, fv1
123  REAL, DIMENSION (len, nd, ntra), INTENT (OUT)      :: ftra1
124  REAL, DIMENSION (len), INTENT (OUT)                :: sigd1
125  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ma1, mip1
126  REAL, DIMENSION (len, nd+1), INTENT (OUT)          :: vprecip1
127  REAL, DIMENSION (len, nd+1), INTENT (OUT)          :: vprecipi1
128  REAL, DIMENSION (len, nd), INTENT (OUT)            :: upwd1, dnwd1, dnwd01
129  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qcondc1
130  REAL, DIMENSION (len), INTENT (OUT)                :: wd1, cape1, cin1
131  REAL, DIMENSION (len, nd), INTENT (OUT)            :: tvp1
132  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ftd1, fqd1
133  REAL, DIMENSION (len), INTENT (OUT)                :: plim11, plim21
134  REAL, DIMENSION (len, nd), INTENT (OUT)            :: asupmax1
135  REAL, DIMENSION (len), INTENT (OUT)                :: supmax01, asupmaxmin1
136                                                   
137  REAL, DIMENSION (len, nd), INTENT (OUT)            :: da1
138  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi1                   !AC!
139  REAL, DIMENSION (len, nd), INTENT (OUT)            :: mp1                    !RomP
140  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: phi21                  !RomP
141  REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1, dam1 !RomP       !RomP
142  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: sigij1                 !RomP
143  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qta1                   !jyg
144  REAL, DIMENSION (len, nd), INTENT (OUT)            :: clw1                   !RomP
145  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: elij1                  !RomP
146  REAL, DIMENSION (len, nd), INTENT (OUT)            :: evap1, ep1             !RomP
147  REAL, DIMENSION (len, nd, nd), INTENT (OUT)        :: epmlmMm1               !RomP+jyg
148  REAL, DIMENSION (len, nd), INTENT (OUT)            :: eplamM1                !RomP+jyg
149  REAL, DIMENSION (len, nd), INTENT (OUT)            :: qtc1, sigt1            !RomP
150  REAL, DIMENSION (len, nd), INTENT (OUT)            :: wdtrainA1, wdtrainS1, wdtrainM1   !RomP
151
152#ifdef ISO
153  REAL, DIMENSION (ntraciso,len), INTENT (OUT)                :: xtprecip1
154  real, DIMENSION (ntraciso,len,nd), INTENT (OUT)             :: fxt1
155  real, DIMENSION (ntraciso,len,nd), INTENT (OUT)             :: fxtd1
156  real, DIMENSION (ntraciso,len,nd+1), INTENT (OUT)           :: xtvprecip1
157  real, DIMENSION (ntraciso,len,nd+1), INTENT (OUT)           :: xtvprecipi1
158  REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT)            :: xtevap1
159  REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT)            :: xtwdtrainA1
160  REAL, DIMENSION (ntraciso,len, nd), INTENT (OUT)            :: xtclw1
161#endif
162
163  ! local variables:
164  INTEGER i, k, j
165  INTEGER jdcum
166  ! c    integer k1,k2
167
168#ifdef ISO
169      integer ixt
170#endif
171
172#ifdef DIAGISO
173      real water(nloc,nd)
174      real xtwater(ntraciso,nloc,nd)
175      real qp(nloc,nd),xtp(ntraciso,nloc,nd)
176      real fq_detrainement(nloc,nd)
177      real f_detrainement(nloc,nd)
178      real q_detrainement(nloc,nd)
179      real xt_detrainement(ntraciso,nloc,nd)
180      real fq_ddft(nloc,nd)
181      real fq_fluxmasse(nloc,nd)
182      real Amp_diag(nloc,nd)
183      real tg_save(nloc,nd) ! temperature de cond pour les isos
184      real fq_evapprecip(nloc,nd)
185      real fxt_detrainement(ntraciso,nloc,nd)
186      real fxt_ddft(ntraciso,nloc,nd)
187      real fxt_fluxmasse(ntraciso,nloc,nd)
188      real fxt_evapprecip(ntraciso,nloc,nd)
189      real m(nloc,nd)
190
191      real water1(len,nd)
192      real xtwater1(ntraciso,len,nd)
193      real qp1(len,nd),xtp1(ntraciso,len,nd)
194      real fq_detrainement1(len,nd)
195      real f_detrainement1(len,nd)
196      real q_detrainement1(len,nd)
197      real xt_detrainement1(ntraciso,len,nd)
198      real fq_ddft1(len,nd)
199      real fq_fluxmasse1(len,nd)
200      real fq_evapprecip1(len,nd)
201      real fxt_detrainement1(ntraciso,len,nd)
202      real fxt_ddft1(ntraciso,len,nd)
203      real fxt_fluxmasse1(ntraciso,len,nd)
204      real fxt_evapprecip1(ntraciso,len,nd)
205#endif
206
207!jyg<
208  IF (compress) THEN
209!>jyg
210#ifdef ISOVERIF
211        write(*,*) 'cv3a_uncompress 151: entrée dans cv3a_uncompress'
212#endif
213    DO i = 1, ncum
214      sig1(idcum(i), nd) = sig(i, nd)
215      ptop21(idcum(i)) = ptop2(i)
216      sigd1(idcum(i)) = sigd(i)
217      precip1(idcum(i)) = precip(i)
218      cbmf1(idcum(i)) = cbmf(i)
219      plcl1(idcum(i)) = plcl(i)
220      plfc1(idcum(i)) = plfc(i)
221      wbeff1(idcum(i)) = wbeff(i)
222      iflag1(idcum(i)) = iflag(i)
223      kbas1(idcum(i)) = kbas(i)
224      ktop1(idcum(i)) = ktop(i)
225      wd1(idcum(i)) = wd(i)
226      cape1(idcum(i)) = cape(i)
227      cin1(idcum(i)) = cin(i)
228      plim11(idcum(i)) = plim1(i)
229      plim21(idcum(i)) = plim2(i)
230      supmax01(idcum(i)) = supmax0(i)
231      asupmaxmin1(idcum(i)) = asupmaxmin(i)
232      epmax_diag1(idcum(i)) = epmax_diag(i)
233#ifdef ISO
234         do ixt = 1, ntraciso
235          xtprecip1(ixt,idcum(i))=xtprecip(ixt,i)
236         enddo
237#endif
238    END DO
239   
240    DO k = 1, nl
241      DO i = 1, ncum
242        sig1(idcum(i), k) = sig(i, k)
243        w01(idcum(i), k) = w0(i, k)
244        ft1(idcum(i), k) = ft(i, k)
245        fq1(idcum(i), k) = fq(i, k)
246        fu1(idcum(i), k) = fu(i, k)
247        fv1(idcum(i), k) = fv(i, k)
248        ma1(idcum(i), k) = ma(i, k)
249        mip1(idcum(i), k) = mip(i, k)
250        vprecip1(idcum(i), k) = vprecip(i, k)
251        vprecipi1(idcum(i), k) = vprecipi(i, k)
252        upwd1(idcum(i), k) = upwd(i, k)
253        dnwd1(idcum(i), k) = dnwd(i, k)
254        dnwd01(idcum(i), k) = dnwd0(i, k)
255        qcondc1(idcum(i), k) = qcondc(i, k)
256        tvp1(idcum(i), k) = tvp(i, k)
257        ftd1(idcum(i), k) = ftd(i, k)
258        fqd1(idcum(i), k) = fqd(i, k)
259        asupmax1(idcum(i), k) = asupmax(i, k)
260   
261        da1(idcum(i), k) = da(i, k) !AC!
262        mp1(idcum(i), k) = mp(i, k) !RomP
263        d1a1(idcum(i), k) = d1a(i, k) !RomP
264        dam1(idcum(i), k) = dam(i, k) !RomP
265        qta1(idcum(i), k) = qta(i, k) !jyg
266        clw1(idcum(i), k) = clw(i, k) !RomP
267        evap1(idcum(i), k) = evap(i, k) !RomP
268        ep1(idcum(i), k) = ep(i, k) !RomP
269        eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg
270        wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP
271        wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP
272        wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP
273        qtc1(idcum(i), k) = qtc(i, k)
274        sigt1(idcum(i), k) = sigt(i, k)
275   
276#ifdef ISO
277            do ixt = 1, ntraciso
278             fxt1(ixt,idcum(i),k)=fxt(ixt,i,k)
279             fxtd1(ixt,idcum(i),k)=fxtd(ixt,i,k)
280             xtvprecip1(ixt,idcum(i),k)=xtvprecip(ixt,i,k)
281             xtvprecipi1(ixt,idcum(i),k)=xtvprecipi(ixt,i,k)
282             xtevap1(ixt,idcum(i),k)=xtevap(ixt,i,k)
283             xtwdtraina1(ixt,idcum(i),k)=xtwdtraina(ixt,i,k)
284             xtclw1(ixt,idcum(i),k)=xtclw(ixt,i,k)
285            enddo
286#endif
287      END DO
288    END DO
289
290#ifdef ISO
291#ifdef DIAGISO
292        do k=1,nl
293          do i=1,ncum   
294            water1(idcum(i),k)=water(i,k)
295            qp1(idcum(i),k)=qp(i,k)
296            fq_detrainement1(idcum(i),k)=fq_detrainement(i,k)
297            f_detrainement1(idcum(i),k)=f_detrainement(i,k)
298            q_detrainement1(idcum(i),k)=q_detrainement(i,k)
299            fq_ddft1(idcum(i),k)=fq_ddft(i,k)
300            fq_fluxmasse1(idcum(i),k)=fq_fluxmasse(i,k)
301            fq_evapprecip1(idcum(i),k)=fq_evapprecip(i,k)
302            do ixt = 1, ntraciso
303             xtwater1(ixt,idcum(i),k)=xtwater(ixt,i,k)
304             xtp1(ixt,idcum(i),k)=xtp(ixt,i,k)
305             fxt_detrainement1(ixt,idcum(i),k)=fxt_detrainement(ixt,i,k)
306             xt_detrainement1(ixt,idcum(i),k)=xt_detrainement(ixt,i,k)
307             fxt_ddft1(ixt,idcum(i),k)=fxt_ddft(ixt,i,k)
308             fxt_fluxmasse1(ixt,idcum(i),k)=fxt_fluxmasse(ixt,i,k)
309             fxt_evapprecip1(ixt,idcum(i),k)=fxt_evapprecip(ixt,i,k)
310            enddo
311           enddo
312         enddo
313#endif
314#endif
315
316
317! Fluxes are defined on a staggered grid and extend up to nl+1
318    DO i = 1, ncum
319      ma1(idcum(i), nlp) = 0.
320      vprecip1(idcum(i), nlp) = 0.
321      vprecipi1(idcum(i), nlp) = 0.
322      upwd1(idcum(i), nlp) = 0.
323      dnwd1(idcum(i), nlp) = 0.
324      dnwd01(idcum(i), nlp) = 0.
325#ifdef ISO
326      do ixt=1,ntraciso
327        xtvprecip1(ixt,idcum(i), nlp) = 0.
328        xtvprecipi1(ixt,idcum(i), nlp) = 0.
329      enddo
330#endif
331    END DO
332   
333    ! AC!        do 2100 j=1,ntra
334    ! AC!c oct3         do 2110 k=1,nl
335    ! AC!         do 2110 k=1,nd ! oct3
336    ! AC!          do 2120 i=1,ncum
337    ! AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
338    ! AC! 2120     continue
339    ! AC! 2110    continue
340    ! AC! 2100   continue
341   
342    ! AC!
343!jyg<
344!  Essais pour gagner du temps en diminuant l'adressage indirect
345!!    DO j = 1, nd
346!!      DO k = 1, nd
347!!        DO i = 1, ncum
348!!          phi1(idcum(i), k, j) = phi(i, k, j) !AC!
349!!          phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
350!!          sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
351!!          elij1(idcum(i), k, j) = elij(i, k, j) !RomP
352!!          epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
353!!        END DO
354!!      END DO
355!!    END DO
356
357!!      DO i = 1, ncum
358!!        jdcum=idcum(i)
359!!        phi1    (jdcum, 1:nl+1, 1:nl+1) = phi    (i, 1:nl+1, 1:nl+1)          !AC!
360!!        phi21   (jdcum, 1:nl+1, 1:nl+1) = phi2   (i, 1:nl+1, 1:nl+1)          !RomP
361!!        sigij1  (jdcum, 1:nl+1, 1:nl+1) = sigij  (i, 1:nl+1, 1:nl+1)          !RomP
362!!        elij1   (jdcum, 1:nl+1, 1:nl+1) = elij   (i, 1:nl+1, 1:nl+1)          !RomP
363!!        epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1)          !RomP+jyg
364!!      END DO
365!  These tracer associated arrays are defined up to nl, not nl+1
366  DO i = 1, ncum
367    jdcum=idcum(i)
368    DO k = 1,nl
369      DO j = 1,nl
370        phi1    (jdcum, j, k) = phi    (i, j, k)          !AC!
371        phi21   (jdcum, j, k) = phi2   (i, j, k)          !RomP
372        sigij1  (jdcum, j, k) = sigij  (i, j, k)          !RomP
373        elij1   (jdcum, j, k) = elij   (i, j, k)          !RomP
374        epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k)          !RomP+jyg
375      END DO
376    ENDDO
377  ENDDO
378!>jyg
379    ! AC!
380   
381   
382    ! do 2220 k2=1,nd
383    ! do 2210 k1=1,nd
384    ! do 2200 i=1,ncum
385    ! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
386    ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
387    ! 2200      enddo
388    ! 2210     enddo
389    ! 2220    enddo
390!
391!jyg<
392  ELSE  !(compress)
393!
394      sig1(:,nd) = sig(:,nd)
395      ptop21(:) = ptop2(:)
396      sigd1(:) = sigd(:)
397      precip1(:) = precip(:)
398      cbmf1(:) = cbmf(:)
399      plcl1(:) = plcl(:)
400      plfc1(:) = plfc(:)
401      wbeff1(:) = wbeff(:)
402      iflag1(:) = iflag(:)
403      kbas1(:) = kbas(:)
404      ktop1(:) = ktop(:)
405      wd1(:) = wd(:)
406      cape1(:) = cape(:)
407      cin1(:) = cin(:)
408      plim11(:) = plim1(:)
409      plim21(:) = plim2(:)
410      supmax01(:) = supmax0(:)
411      asupmaxmin1(:) = asupmaxmin(:)
412#ifdef ISO
413          xtprecip1(:,:)=xtprecip(:,:)
414#endif
415!
416      sig1(:, 1:nl) = sig(:, 1:nl)
417      w01(:, 1:nl) = w0(:, 1:nl)
418      ft1(:, 1:nl) = ft(:, 1:nl)
419      fq1(:, 1:nl) = fq(:, 1:nl)
420      fu1(:, 1:nl) = fu(:, 1:nl)
421      fv1(:, 1:nl) = fv(:, 1:nl)
422      ma1(:, 1:nl) = ma(:, 1:nl)
423      mip1(:, 1:nl) = mip(:, 1:nl)
424      vprecip1(:, 1:nl) = vprecip(:, 1:nl)
425      vprecipi1(:, 1:nl) = vprecipi(:, 1:nl)
426      upwd1(:, 1:nl) = upwd(:, 1:nl)
427      dnwd1(:, 1:nl) = dnwd(:, 1:nl)
428      dnwd01(:, 1:nl) = dnwd0(:, 1:nl)
429      qcondc1(:, 1:nl) = qcondc(:, 1:nl)
430      tvp1(:, 1:nl) = tvp(:, 1:nl)
431      ftd1(:, 1:nl) = ftd(:, 1:nl)
432      fqd1(:, 1:nl) = fqd(:, 1:nl)
433      asupmax1(:, 1:nl) = asupmax(:, 1:nl)
434
435      da1(:, 1:nl) = da(:, 1:nl)              !AC!
436      mp1(:, 1:nl) = mp(:, 1:nl)              !RomP
437      d1a1(:, 1:nl) = d1a(:, 1:nl)            !RomP
438      dam1(:, 1:nl) = dam(:, 1:nl)            !RomP
439      qta1(:, 1:nl) = qta(:, 1:nl)            !jyg
440      clw1(:, 1:nl) = clw(:, 1:nl)            !RomP
441      evap1(:, 1:nl) = evap(:, 1:nl)          !RomP
442      ep1(:, 1:nl) = ep(:, 1:nl)              !RomP
443      eplamM1(:, 1:nl) = eplamM(:, 1:nl)       !RomP+jyg
444      wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl)  !RomP
445      wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl)  !RomP
446      wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl)  !RomP
447      qtc1(:, 1:nl) = qtc(:, 1:nl)
448      sigt1(:, 1:nl) = sigt(:, 1:nl)
449!
450      ma1(:, nlp) = 0.
451      vprecip1(:, nlp) = 0.
452      vprecipi1(:, nlp) = 0.
453      upwd1(:, nlp) = 0.
454      dnwd1(:, nlp) = 0.
455      dnwd01(:, nlp) = 0.
456
457!
458      phi1    (:, 1:nl, 1:nl) = phi    (:, 1:nl, 1:nl)  !AC!
459      phi21   (:, 1:nl, 1:nl) = phi2   (:, 1:nl, 1:nl)  !RomP
460      sigij1  (:, 1:nl, 1:nl) = sigij  (:, 1:nl, 1:nl)  !RomP
461      elij1   (:, 1:nl, 1:nl) = elij   (:, 1:nl, 1:nl)  !RomP
462      epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl)  !RomP+jyg
463
464#ifdef ISO
465            do ixt = 1, ntraciso
466             fxt1(:,:,1:nl)=fxt(:,:,1:nl)
467             fxtd1(:,:,1:nl)=fxtd(:,:,1:nl)
468             xtvprecip1(:,:,1:nlp)=xtvprecip(:,:,1:nlp)
469             xtvprecipi1(:,:,1:nlp)=xtvprecipi(:,:,1:nlp)
470             xtevap1(:,:,1:nl)=xtevap(:,:,1:nl)
471             xtwdtrainA1(:,:,1:nl)=xtwdtrainA(:,:,1:nl)
472             xtclw1(:,:,1:nl)=xtclw(:,:,1:nl)
473            enddo
474#endif
475
476
477#ifdef ISO
478#ifdef DIAGISO
479            water1(:,1:nl)=water(:,1:nl)
480            qp1(:,1:nl)=qp(:,1:nl)
481            fq_detrainement1(:,1:nl)=fq_detrainement(:,1:nl)
482            f_detrainement1(:,1:nl)=f_detrainement(:,1:nl)
483            q_detrainement1(:,1:nl)=q_detrainement(:,1:nl)
484            fq_ddft1(:,1:nl)=fq_ddft(:,1:nl)
485            fq_fluxmasse1(:,1:nl)=fq_fluxmasse(:,1:nl)
486            fq_evapprecip1(:,1:nl)=fq_evapprecip(:,1:nl)
487            do ixt = 1, ntraciso
488             xtwater1(:,:,1:nl)=xtwater(:,:,1:nl)
489             xtp1(:,:,1:nl)=xtp(:,:,1:nl)
490             fxt_detrainement1(:,:,1:nl)=fxt_detrainement(:,:,1:nl)
491             xt_detrainement1(:,:,1:nl)=xt_detrainement(:,:,1:nl)
492             fxt_ddft1(:,:,1:nl)=fxt_ddft(:,:,1:nl)
493             fxt_fluxmasse1(:,:,1:nl)=fxt_fluxmasse(:,:,1:nl)
494             fxt_evapprecip1(:,:,1:nl)=fxt_evapprecip(:,:,1:nl)
495            enddo
496#endif
497#endif
498
499
500  ENDIF !(compress)
501!>jyg
502
503  RETURN
504END SUBROUTINE cv3a_uncompress
505
Note: See TracBrowser for help on using the repository browser.