source: LMDZ5/trunk/libf/phylmd/cv3a_uncompress.F90 @ 2356

Last change on this file since 2356 was 2306, checked in by jyg, 9 years ago

Improved diagnostics: pmflxr and pmflxs are now
the true vertical profiles of liquid and solid
convective precipitation (previously they where
merely diagnosed through a test on temperature).
The convective scheme internal variable for ice
precipitation is Vprecipi.
  • 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: 12.8 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                           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
48!>jyg
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
126!>jyg
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+1
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    ! AC!        do 2100 j=1,ntra
186    ! AC!c oct3         do 2110 k=1,nl
187    ! AC!         do 2110 k=1,nd ! oct3
188    ! AC!          do 2120 i=1,ncum
189    ! AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
190    ! AC! 2120     continue
191    ! AC! 2110    continue
192    ! AC! 2100   continue
193   
194    ! AC!
195!jyg<
196!  Essais pour gagner du temps en diminuant l'adressage indirect
197!!    DO j = 1, nd
198!!      DO k = 1, nd
199!!        DO i = 1, ncum
200!!          phi1(idcum(i), k, j) = phi(i, k, j) !AC!
201!!          phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
202!!          sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
203!!          elij1(idcum(i), k, j) = elij(i, k, j) !RomP
204!!          epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg
205!!        END DO
206!!      END DO
207!!    END DO
208      DO i = 1, ncum
209        jdcum=idcum(i)
210        phi1    (jdcum, 1:nl+1, 1:nl+1) = phi    (i, 1:nl+1, 1:nl+1)          !AC!
211        phi21   (jdcum, 1:nl+1, 1:nl+1) = phi2   (i, 1:nl+1, 1:nl+1)          !RomP
212        sigij1  (jdcum, 1:nl+1, 1:nl+1) = sigij  (i, 1:nl+1, 1:nl+1)          !RomP
213        elij1   (jdcum, 1:nl+1, 1:nl+1) = elij   (i, 1:nl+1, 1:nl+1)          !RomP
214        epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1)          !RomP+jyg
215      END DO
216!>jyg
217    ! AC!
218   
219   
220    ! do 2220 k2=1,nd
221    ! do 2210 k1=1,nd
222    ! do 2200 i=1,ncum
223    ! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
224    ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
225    ! 2200      enddo
226    ! 2210     enddo
227    ! 2220    enddo
228!
229!jyg<
230  ELSE  !(compress)
231!
232      sig1(:,nd) = sig(:,nd)
233      ptop21(:) = ptop2(:)
234      sigd1(:) = sigd(:)
235      precip1(:) = precip(:)
236      cbmf1(:) = cbmf(:)
237      plcl1(:) = plcl(:)
238      plfc1(:) = plfc(:)
239      wbeff1(:) = wbeff(:)
240      iflag1(:) = iflag(:)
241      kbas1(:) = kbas(:)
242      ktop1(:) = ktop(:)
243      wd1(:) = wd(:)
244      cape1(:) = cape(:)
245      cin1(:) = cin(:)
246      plim11(:) = plim1(:)
247      plim21(:) = plim2(:)
248      supmax01(:) = supmax0(:)
249      asupmaxmin1(:) = asupmaxmin(:)
250!
251      sig1(:, 1:nl+1) = sig(:, 1:nl+1)
252      w01(:, 1:nl+1) = w0(:, 1:nl+1)
253      ft1(:, 1:nl+1) = ft(:, 1:nl+1)
254      fq1(:, 1:nl+1) = fq(:, 1:nl+1)
255      fu1(:, 1:nl+1) = fu(:, 1:nl+1)
256      fv1(:, 1:nl+1) = fv(:, 1:nl+1)
257      ma1(:, 1:nl+1) = ma(:, 1:nl+1)
258      mip1(:, 1:nl+1) = mip(:, 1:nl+1)
259      vprecip1(:, 1:nl+1) = vprecip(:, 1:nl+1)
260      vprecipi1(:, 1:nl+1) = vprecipi(:, 1:nl+1)
261      upwd1(:, 1:nl+1) = upwd(:, 1:nl+1)
262      dnwd1(:, 1:nl+1) = dnwd(:, 1:nl+1)
263      dnwd01(:, 1:nl+1) = dnwd0(:, 1:nl+1)
264      qcondc1(:, 1:nl+1) = qcondc(:, 1:nl+1)
265      tvp1(:, 1:nl+1) = tvp(:, 1:nl+1)
266      ftd1(:, 1:nl+1) = ftd(:, 1:nl+1)
267      fqd1(:, 1:nl+1) = fqd(:, 1:nl+1)
268      asupmax1(:, 1:nl+1) = asupmax(:, 1:nl+1)
269
270      da1(:, 1:nl+1) = da(:, 1:nl+1)              !AC!
271      mp1(:, 1:nl+1) = mp(:, 1:nl+1)              !RomP
272      d1a1(:, 1:nl+1) = d1a(:, 1:nl+1)            !RomP
273      dam1(:, 1:nl+1) = dam(:, 1:nl+1)            !RomP
274      clw1(:, 1:nl+1) = clw(:, 1:nl+1)            !RomP
275      evap1(:, 1:nl+1) = evap(:, 1:nl+1)          !RomP
276      ep1(:, 1:nl+1) = ep(:, 1:nl+1)              !RomP
277      eplamM1(:, 1:nl+1) = eplamM(:, 1:nl+1)       !RomP+jyg
278      wdtrainA1(:, 1:nl+1) = wdtrainA(:, 1:nl+1)  !RomP
279      wdtrainM1(:, 1:nl+1) = wdtrainM(:, 1:nl+1)  !RomP
280      qtc1(:, 1:nl+1) = qtc(:, 1:nl+1)
281      sigt1(:, 1:nl+1) = sigt(:, 1:nl+1)
282!
283      phi1    (:, 1:nl+1, 1:nl+1) = phi    (:, 1:nl+1, 1:nl+1)  !AC!
284      phi21   (:, 1:nl+1, 1:nl+1) = phi2   (:, 1:nl+1, 1:nl+1)  !RomP
285      sigij1  (:, 1:nl+1, 1:nl+1) = sigij  (:, 1:nl+1, 1:nl+1)  !RomP
286      elij1   (:, 1:nl+1, 1:nl+1) = elij   (:, 1:nl+1, 1:nl+1)  !RomP
287      epmlmMm1(:, 1:nl+1, 1:nl+1) = epmlmMm(:, 1:nl+1, 1:nl+1)  !RomP+jyg
288  ENDIF !(compress)
289!>jyg
290
291  RETURN
292END SUBROUTINE cv3a_uncompress
293
Note: See TracBrowser for help on using the repository browser.