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

Last change on this file since 2031 was 1992, checked in by lguez, 11 years ago

Converted to free source form files in libf/phylmd which were still in
fixed source form. The conversion was done using the polish mode of
the NAG Fortran Compiler.

In addition to converting to free source form, the processing of the
files also:

-- indented the code (including comments);

-- set Fortran keywords to uppercase, and set all other identifiers
to lower case;

-- added qualifiers to end statements (for example "end subroutine
conflx", instead of "end");

-- changed the terminating statements of all DO loops so that each
loop ends with an ENDDO statement (instead of a labeled continue).

-- replaced #include by include.

  • 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: 5.9 KB
RevLine 
[1992]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
[879]8
[1992]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
[879]16
[1992]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  ! **************************************************************
[879]25
[1992]26  IMPLICIT NONE
[879]27
[1992]28  include "cv3param.h"
[879]29
[1992]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)
[879]49
[1992]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
[879]59
[1992]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)
[1650]77
[1992]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
[1650]87
[879]88
[1992]89  ! local variables:
90  INTEGER i, k, j
91  ! c    integer k1,k2
[879]92
[1992]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      wdtraina1(idcum(i), k) = wdtraina(i, k) !RomP
142      wdtrainm1(idcum(i), k) = wdtrainm(i, k) !RomP
143
144    END DO
145  END DO
146
147  DO i = 1, ncum
148    sig1(idcum(i), nd) = sig(i, nd)
149  END DO
150
151
152  ! AC!        do 2100 j=1,ntra
153  ! AC!c oct3         do 2110 k=1,nl
154  ! AC!         do 2110 k=1,nd ! oct3
155  ! AC!          do 2120 i=1,ncum
156  ! AC!            ftra1(idcum(i),k,j)=ftra(i,k,j)
157  ! AC! 2120     continue
158  ! AC! 2110    continue
159  ! AC! 2100   continue
160
161  ! AC!
162  DO j = 1, nd
163    DO k = 1, nd
164      DO i = 1, ncum
165        phi1(idcum(i), k, j) = phi(i, k, j) !AC!
166        phi21(idcum(i), k, j) = phi2(i, k, j) !RomP
167        sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP
168        elij1(idcum(i), k, j) = elij(i, k, j) !RomP
169        epmlmmm(idcum(i), k, j) = epmlmmm(i, k, j) !RomP+jyg
170      END DO
171    END DO
172  END DO
173  ! AC!
174
175
176  ! do 2220 k2=1,nd
177  ! do 2210 k1=1,nd
178  ! do 2200 i=1,ncum
179  ! ment1(idcum(i),k1,k2) = ment(i,k1,k2)
180  ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2)
181  ! 2200      enddo
182  ! 2210     enddo
183  ! 2220    enddo
184
185  RETURN
186END SUBROUTINE cv3a_uncompress
187
Note: See TracBrowser for help on using the repository browser.