source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/cv3a_uncompress.F90 @ 4934

Last change on this file since 4934 was 2303, checked in by jescribano, 9 years ago

Bugs corrections, control vector is now fine mode+coarse mode and seasalt coarse+fine, change in emission scheme parameters, more outputs at 10h30 and 13h30 LT. (Pending correct optical and sedimentation parameters)

  • 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: 6.0 KB
Line 
1SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, kbas, &
2    ktop, precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, ft, fq, fu, fv, &
3    ftra, sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, qcondc, wd, cape, cin, &
4    tvp, ftd, fqd, plim1, plim2, asupmax, supmax0, asupmaxmin &
5    , da, phi, mp, phi2, d1a, dam, sigij & ! RomP+AC+jyg
6    , clw, elij, evap, ep, epmlmmm, eplamm & ! RomP
7    , wdtraina, wdtrainm &         ! RomP
8
9    , iflag1, kbas1, ktop1, precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, &
10    ptop21, ft1, fq1, fu1, fv1, ftra1, sigd1, ma1, mip1, vprecip1, upwd1, &
11    dnwd1, dnwd01, qcondc1, wd1, cape1, cin1, tvp1, ftd1, fqd1, plim11, &
12    plim21, asupmax1, supmax01, asupmaxmin1 &
13    , da1, phi1, mp1, phi21, d1a1, dam1, sigij1 & ! RomP+AC+jyg
14    , clw1, elij1, evap1, ep1, epmlmmm1, eplamm1 & ! RomP
15    , wdtraina1, wdtrainm1) ! RomP
16
17  ! **************************************************************
18  ! *
19  ! CV3A_UNCOMPRESS                                             *
20  ! *
21  ! *
22  ! written by   : Sandrine Bony-Lena , 17/05/2003, 11.22.15    *
23  ! modified by  : Jean-Yves Grandpeix, 23/06/2003, 10.36.17    *
24  ! **************************************************************
25
26  IMPLICIT NONE
27
28  include "cv3param.h"
29
30  ! inputs:
31  INTEGER nloc, len, ncum, nd, ntra
32  INTEGER idcum(nloc)
33  INTEGER iflag(nloc), kbas(nloc), ktop(nloc)
34  REAL precip(nloc), cbmf(nloc), plcl(nloc), plfc(nloc)
35  REAL wbeff(len)
36  REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc)
37  REAL ft(nloc, nd), fq(nloc, nd), fu(nloc, nd), fv(nloc, nd)
38  REAL ftra(nloc, nd, ntra)
39  REAL sigd(nloc)
40  REAL ma(nloc, nd), mip(nloc, nd), vprecip(nloc, nd+1)
41  REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd)
42  REAL qcondc(nloc, nd)
43  REAL wd(nloc), cape(nloc), cin(nloc)
44  REAL tvp(nloc, nd)
45  REAL ftd(nloc, nd), fqd(nloc, nd)
46  REAL plim1(nloc), plim2(nloc)
47  REAL asupmax(nloc, nd), supmax0(nloc)
48  REAL asupmaxmin(nloc)
49
50  REAL da(nloc, nd), phi(nloc, nd, nd) !AC!
51  REAL mp(nloc, nd) !RomP
52  REAL phi2(nloc, nd, nd) !RomP
53  REAL d1a(nloc, nd), dam(nloc, nd) !RomP
54  REAL sigij(nloc, nd, nd) !RomP
55  REAL clw(nloc, nd), elij(nloc, nd, nd) !RomP
56  REAL evap(nloc, nd), ep(nloc, nd) !RomP
57  REAL epmlmmm(nloc, nd, nd), eplamm(nloc, nd) !RomP+jyg
58  REAL wdtraina(nloc, nd), wdtrainm(nloc, nd) !RomP
59
60  ! outputs:
61  INTEGER iflag1(len), kbas1(len), ktop1(len)
62  REAL precip1(len), cbmf1(len), plcl1(nloc), plfc1(nloc)
63  REAL wbeff1(len)
64  REAL sig1(len, nd), w01(len, nd), ptop21(len)
65  REAL ft1(len, nd), fq1(len, nd), fu1(len, nd), fv1(len, nd)
66  REAL ftra1(len, nd, ntra)
67  REAL sigd1(len)
68  REAL ma1(len, nd), mip1(len, nd), vprecip1(len, nd+1)
69  REAL upwd1(len, nd), dnwd1(len, nd), dnwd01(len, nd)
70  REAL qcondc1(len, nd)
71  REAL wd1(len), cape1(len), cin1(len)
72  REAL tvp1(len, nd)
73  REAL ftd1(len, nd), fqd1(len, nd)
74  REAL plim11(len), plim21(len)
75  REAL asupmax1(len, nd), supmax01(len)
76  REAL asupmaxmin1(len)
77
78  REAL da1(nloc, nd), phi1(nloc, nd, nd) !AC!
79  REAL mp1(nloc, nd) !RomP
80  REAL phi21(nloc, nd, nd) !RomP
81  REAL d1a1(nloc, nd), dam1(nloc, nd) !RomP
82  REAL sigij1(len, nd, nd) !RomP
83  REAL clw1(len, nd), elij1(len, nd, nd) !RomP
84  REAL evap1(len, nd), ep1(len, nd) !RomP
85  REAL epmlmmm1(len, nd, nd), eplamm1(len, nd) !RomP+jyg
86  REAL wdtraina1(len, nd), wdtrainm1(len, nd) !RomP
87
88
89  ! local variables:
90  INTEGER i, k, j
91  ! c    integer k1,k2
92
93  DO i = 1, ncum
94    ptop21(idcum(i)) = ptop2(i)
95    sigd1(idcum(i)) = sigd(i)
96    precip1(idcum(i)) = precip(i)
97    cbmf1(idcum(i)) = cbmf(i)
98    plcl1(idcum(i)) = plcl(i)
99    plfc1(idcum(i)) = plfc(i)
100    wbeff1(idcum(i)) = wbeff(i)
101    iflag1(idcum(i)) = iflag(i)
102    kbas1(idcum(i)) = kbas(i)
103    ktop1(idcum(i)) = ktop(i)
104    wd1(idcum(i)) = wd(i)
105    cape1(idcum(i)) = cape(i)
106    cin1(idcum(i)) = cin(i)
107    plim11(idcum(i)) = plim1(i)
108    plim21(idcum(i)) = plim2(i)
109    supmax01(idcum(i)) = supmax0(i)
110    asupmaxmin1(idcum(i)) = asupmaxmin(i)
111  END DO
112
113  DO k = 1, nd
114    DO i = 1, ncum
115      sig1(idcum(i), k) = sig(i, k)
116      w01(idcum(i), k) = w0(i, k)
117      ft1(idcum(i), k) = ft(i, k)
118      fq1(idcum(i), k) = fq(i, k)
119      fu1(idcum(i), k) = fu(i, k)
120      fv1(idcum(i), k) = fv(i, k)
121      ma1(idcum(i), k) = ma(i, k)
122      mip1(idcum(i), k) = mip(i, k)
123      vprecip1(idcum(i), k) = vprecip(i, k)
124      upwd1(idcum(i), k) = upwd(i, k)
125      dnwd1(idcum(i), k) = dnwd(i, k)
126      dnwd01(idcum(i), k) = dnwd0(i, k)
127      qcondc1(idcum(i), k) = qcondc(i, k)
128      tvp1(idcum(i), k) = tvp(i, k)
129      ftd1(idcum(i), k) = ftd(i, k)
130      fqd1(idcum(i), k) = fqd(i, k)
131      asupmax1(idcum(i), k) = asupmax(i, k)
132
133      da1(idcum(i), k) = da(i, k) !AC!
134      mp1(idcum(i), k) = mp(i, k) !RomP
135      d1a1(idcum(i), k) = d1a(i, k) !RomP
136      dam1(idcum(i), k) = dam(i, k) !RomP
137      clw1(idcum(i), k) = clw(i, k) !RomP
138      evap1(idcum(i), k) = evap(i, k) !RomP
139      ep1(idcum(i), k) = ep(i, k) !RomP
140      !eplamm(idcum(i), k) = eplamm(i, k) !RomP+jyg
141      eplamm1(idcum(i), k) = eplamm(i, k) !RomP+jyg _ 20150518
142      wdtraina1(idcum(i), k) = wdtraina(i, k) !RomP
143      wdtrainm1(idcum(i), k) = wdtrainm(i, k) !RomP
144
145    END DO
146  END DO
147
148  DO i = 1, ncum
149    sig1(idcum(i), nd) = sig(i, nd)
150  END DO
151
152
153  ! AC!        do 2100 j=1,ntra
154  ! AC!c oct3         do 2110 k=1,nl
155  ! AC!         do 2110 k=1,nd ! oct3
156  ! AC!          do 2120 i=1,ncum
157  ! AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
158  ! AC! 2120     continue
159  ! AC! 2110    continue
160  ! AC! 2100   continue
161
162  ! AC!
163  DO j = 1, nd
164    DO k = 1, nd
165      DO i = 1, ncum
166        phi1(idcum(i), k, j) = phi(i, k, j) !AC!
167        phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
168        sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
169        elij1(idcum(i), k, j) = elij(i, k, j) !RomP
170        !epmlmmm(idcum(i), k, j) = epmlmmm(i, k, j) !RomP+jyg
171        epmlmmm1(idcum(i), k, j) = epmlmmm(i, k, j) !RomP+jyg 20150518
172      END DO
173    END DO
174  END DO
175  ! AC!
176
177
178  ! do 2220 k2=1,nd
179  ! do 2210 k1=1,nd
180  ! do 2200 i=1,ncum
181  ! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
182  ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
183  ! 2200      enddo
184  ! 2210     enddo
185  ! 2220    enddo
186
187  RETURN
188END SUBROUTINE cv3a_uncompress
189
Note: See TracBrowser for help on using the repository browser.