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