[3927] | 1 | SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, & |
---|
| 2 | iflag, kbas, ktop, & |
---|
| 3 | precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, & |
---|
[4727] | 4 | ft, fq, fqcomp, fu, fv, ftra, & |
---|
[3927] | 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 |
---|
[4727] | 14 | qtc, sigt, detrain, & |
---|
[3927] | 15 | epmax_diag, & ! epmax_cape |
---|
| 16 | iflag1, kbas1, ktop1, & |
---|
| 17 | precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, & |
---|
[4727] | 18 | ft1, fq1, fqcomp1, fu1, fv1, ftra1, & |
---|
[3927] | 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 |
---|
[4727] | 28 | qtc1, sigt1, detrain1, & |
---|
[3927] | 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 |
---|
[4143] | 56 | USE infotrac_phy, ONLY : ntraciso=>ntiso |
---|
[3927] | 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 |
---|
[4727] | 74 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: ft, fq, fqcomp, fu, fv |
---|
[3927] | 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 |
---|
[4727] | 101 | REAL, DIMENSION (nloc, nd), INTENT (IN) :: qtc, sigt, detrain !RomP |
---|
[3927] | 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 |
---|
[4727] | 122 | REAL, DIMENSION (len, nd), INTENT (OUT) :: ft1, fq1, fqcomp1, fu1, fv1 |
---|
[3927] | 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 |
---|
[4727] | 149 | REAL, DIMENSION (len, nd), INTENT (OUT) :: qtc1, sigt1, detrain1 !RomP |
---|
[3927] | 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) |
---|
[4727] | 246 | fqcomp1(idcum(i), k) = fqcomp(i, k) |
---|
[3927] | 247 | fu1(idcum(i), k) = fu(i, k) |
---|
| 248 | fv1(idcum(i), k) = fv(i, k) |
---|
| 249 | ma1(idcum(i), k) = ma(i, k) |
---|
| 250 | mip1(idcum(i), k) = mip(i, k) |
---|
| 251 | vprecip1(idcum(i), k) = vprecip(i, k) |
---|
| 252 | vprecipi1(idcum(i), k) = vprecipi(i, k) |
---|
| 253 | upwd1(idcum(i), k) = upwd(i, k) |
---|
| 254 | dnwd1(idcum(i), k) = dnwd(i, k) |
---|
| 255 | dnwd01(idcum(i), k) = dnwd0(i, k) |
---|
| 256 | qcondc1(idcum(i), k) = qcondc(i, k) |
---|
| 257 | tvp1(idcum(i), k) = tvp(i, k) |
---|
| 258 | ftd1(idcum(i), k) = ftd(i, k) |
---|
| 259 | fqd1(idcum(i), k) = fqd(i, k) |
---|
| 260 | asupmax1(idcum(i), k) = asupmax(i, k) |
---|
| 261 | |
---|
| 262 | da1(idcum(i), k) = da(i, k) !AC! |
---|
| 263 | mp1(idcum(i), k) = mp(i, k) !RomP |
---|
| 264 | d1a1(idcum(i), k) = d1a(i, k) !RomP |
---|
| 265 | dam1(idcum(i), k) = dam(i, k) !RomP |
---|
| 266 | qta1(idcum(i), k) = qta(i, k) !jyg |
---|
| 267 | clw1(idcum(i), k) = clw(i, k) !RomP |
---|
| 268 | evap1(idcum(i), k) = evap(i, k) !RomP |
---|
| 269 | ep1(idcum(i), k) = ep(i, k) !RomP |
---|
| 270 | eplamM1(idcum(i), k) = eplamM(i, k) !RomP+jyg |
---|
| 271 | wdtrainA1(idcum(i), k) = wdtrainA(i, k) !RomP |
---|
| 272 | wdtrainS1(idcum(i), k) = wdtrainS(i, k) !RomP |
---|
| 273 | wdtrainM1(idcum(i), k) = wdtrainM(i, k) !RomP |
---|
| 274 | qtc1(idcum(i), k) = qtc(i, k) |
---|
| 275 | sigt1(idcum(i), k) = sigt(i, k) |
---|
[4727] | 276 | detrain1(idcum(i), k) = detrain(i, k) |
---|
[3927] | 277 | |
---|
| 278 | #ifdef ISO |
---|
| 279 | do ixt = 1, ntraciso |
---|
| 280 | fxt1(ixt,idcum(i),k)=fxt(ixt,i,k) |
---|
| 281 | fxtd1(ixt,idcum(i),k)=fxtd(ixt,i,k) |
---|
| 282 | xtvprecip1(ixt,idcum(i),k)=xtvprecip(ixt,i,k) |
---|
| 283 | xtvprecipi1(ixt,idcum(i),k)=xtvprecipi(ixt,i,k) |
---|
| 284 | xtevap1(ixt,idcum(i),k)=xtevap(ixt,i,k) |
---|
| 285 | xtwdtraina1(ixt,idcum(i),k)=xtwdtraina(ixt,i,k) |
---|
| 286 | xtclw1(ixt,idcum(i),k)=xtclw(ixt,i,k) |
---|
| 287 | enddo |
---|
| 288 | #endif |
---|
| 289 | END DO |
---|
| 290 | END DO |
---|
| 291 | |
---|
| 292 | #ifdef ISO |
---|
| 293 | #ifdef DIAGISO |
---|
| 294 | do k=1,nl |
---|
| 295 | do i=1,ncum |
---|
| 296 | water1(idcum(i),k)=water(i,k) |
---|
| 297 | qp1(idcum(i),k)=qp(i,k) |
---|
| 298 | fq_detrainement1(idcum(i),k)=fq_detrainement(i,k) |
---|
| 299 | f_detrainement1(idcum(i),k)=f_detrainement(i,k) |
---|
| 300 | q_detrainement1(idcum(i),k)=q_detrainement(i,k) |
---|
| 301 | fq_ddft1(idcum(i),k)=fq_ddft(i,k) |
---|
| 302 | fq_fluxmasse1(idcum(i),k)=fq_fluxmasse(i,k) |
---|
| 303 | fq_evapprecip1(idcum(i),k)=fq_evapprecip(i,k) |
---|
| 304 | do ixt = 1, ntraciso |
---|
| 305 | xtwater1(ixt,idcum(i),k)=xtwater(ixt,i,k) |
---|
| 306 | xtp1(ixt,idcum(i),k)=xtp(ixt,i,k) |
---|
| 307 | fxt_detrainement1(ixt,idcum(i),k)=fxt_detrainement(ixt,i,k) |
---|
| 308 | xt_detrainement1(ixt,idcum(i),k)=xt_detrainement(ixt,i,k) |
---|
| 309 | fxt_ddft1(ixt,idcum(i),k)=fxt_ddft(ixt,i,k) |
---|
| 310 | fxt_fluxmasse1(ixt,idcum(i),k)=fxt_fluxmasse(ixt,i,k) |
---|
| 311 | fxt_evapprecip1(ixt,idcum(i),k)=fxt_evapprecip(ixt,i,k) |
---|
| 312 | enddo |
---|
| 313 | enddo |
---|
| 314 | enddo |
---|
| 315 | #endif |
---|
| 316 | #endif |
---|
| 317 | |
---|
| 318 | |
---|
| 319 | ! Fluxes are defined on a staggered grid and extend up to nl+1 |
---|
| 320 | DO i = 1, ncum |
---|
| 321 | ma1(idcum(i), nlp) = 0. |
---|
| 322 | vprecip1(idcum(i), nlp) = 0. |
---|
| 323 | vprecipi1(idcum(i), nlp) = 0. |
---|
| 324 | upwd1(idcum(i), nlp) = 0. |
---|
| 325 | dnwd1(idcum(i), nlp) = 0. |
---|
| 326 | dnwd01(idcum(i), nlp) = 0. |
---|
| 327 | #ifdef ISO |
---|
| 328 | do ixt=1,ntraciso |
---|
| 329 | xtvprecip1(ixt,idcum(i), nlp) = 0. |
---|
| 330 | xtvprecipi1(ixt,idcum(i), nlp) = 0. |
---|
| 331 | enddo |
---|
| 332 | #endif |
---|
| 333 | END DO |
---|
| 334 | |
---|
| 335 | ! AC! do 2100 j=1,ntra |
---|
| 336 | ! AC!c oct3 do 2110 k=1,nl |
---|
| 337 | ! AC! do 2110 k=1,nd ! oct3 |
---|
| 338 | ! AC! do 2120 i=1,ncum |
---|
| 339 | ! AC! ftra1(idcum(i),k,j)=ftra(i,k,j) |
---|
| 340 | ! AC! 2120 continue |
---|
| 341 | ! AC! 2110 continue |
---|
| 342 | ! AC! 2100 continue |
---|
| 343 | |
---|
| 344 | ! AC! |
---|
| 345 | !jyg< |
---|
| 346 | ! Essais pour gagner du temps en diminuant l'adressage indirect |
---|
| 347 | !! DO j = 1, nd |
---|
| 348 | !! DO k = 1, nd |
---|
| 349 | !! DO i = 1, ncum |
---|
| 350 | !! phi1(idcum(i), k, j) = phi(i, k, j) !AC! |
---|
| 351 | !! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP |
---|
| 352 | !! sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP |
---|
| 353 | !! elij1(idcum(i), k, j) = elij(i, k, j) !RomP |
---|
| 354 | !! epmlmMm(idcum(i), k, j) = epmlmMm(i, k, j) !RomP+jyg |
---|
| 355 | !! END DO |
---|
| 356 | !! END DO |
---|
| 357 | !! END DO |
---|
| 358 | |
---|
| 359 | !! DO i = 1, ncum |
---|
| 360 | !! jdcum=idcum(i) |
---|
| 361 | !! phi1 (jdcum, 1:nl+1, 1:nl+1) = phi (i, 1:nl+1, 1:nl+1) !AC! |
---|
| 362 | !! phi21 (jdcum, 1:nl+1, 1:nl+1) = phi2 (i, 1:nl+1, 1:nl+1) !RomP |
---|
| 363 | !! sigij1 (jdcum, 1:nl+1, 1:nl+1) = sigij (i, 1:nl+1, 1:nl+1) !RomP |
---|
| 364 | !! elij1 (jdcum, 1:nl+1, 1:nl+1) = elij (i, 1:nl+1, 1:nl+1) !RomP |
---|
| 365 | !! epmlmMm1(jdcum, 1:nl+1, 1:nl+1) = epmlmMm(i, 1:nl+1, 1:nl+1) !RomP+jyg |
---|
| 366 | !! END DO |
---|
| 367 | ! These tracer associated arrays are defined up to nl, not nl+1 |
---|
| 368 | DO i = 1, ncum |
---|
| 369 | jdcum=idcum(i) |
---|
| 370 | DO k = 1,nl |
---|
| 371 | DO j = 1,nl |
---|
| 372 | phi1 (jdcum, j, k) = phi (i, j, k) !AC! |
---|
| 373 | phi21 (jdcum, j, k) = phi2 (i, j, k) !RomP |
---|
| 374 | sigij1 (jdcum, j, k) = sigij (i, j, k) !RomP |
---|
| 375 | elij1 (jdcum, j, k) = elij (i, j, k) !RomP |
---|
| 376 | epmlmMm1(jdcum, j, k) = epmlmMm(i, j, k) !RomP+jyg |
---|
| 377 | END DO |
---|
| 378 | ENDDO |
---|
| 379 | ENDDO |
---|
| 380 | !>jyg |
---|
| 381 | ! AC! |
---|
| 382 | |
---|
| 383 | |
---|
| 384 | ! do 2220 k2=1,nd |
---|
| 385 | ! do 2210 k1=1,nd |
---|
| 386 | ! do 2200 i=1,ncum |
---|
| 387 | ! ment1(idcum(i),k1,k2) = ment(i,k1,k2) |
---|
| 388 | ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2) |
---|
| 389 | ! 2200 enddo |
---|
| 390 | ! 2210 enddo |
---|
| 391 | ! 2220 enddo |
---|
| 392 | ! |
---|
| 393 | !jyg< |
---|
| 394 | ELSE !(compress) |
---|
| 395 | ! |
---|
| 396 | sig1(:,nd) = sig(:,nd) |
---|
| 397 | ptop21(:) = ptop2(:) |
---|
| 398 | sigd1(:) = sigd(:) |
---|
| 399 | precip1(:) = precip(:) |
---|
| 400 | cbmf1(:) = cbmf(:) |
---|
| 401 | plcl1(:) = plcl(:) |
---|
| 402 | plfc1(:) = plfc(:) |
---|
| 403 | wbeff1(:) = wbeff(:) |
---|
| 404 | iflag1(:) = iflag(:) |
---|
| 405 | kbas1(:) = kbas(:) |
---|
| 406 | ktop1(:) = ktop(:) |
---|
| 407 | wd1(:) = wd(:) |
---|
| 408 | cape1(:) = cape(:) |
---|
| 409 | cin1(:) = cin(:) |
---|
| 410 | plim11(:) = plim1(:) |
---|
| 411 | plim21(:) = plim2(:) |
---|
| 412 | supmax01(:) = supmax0(:) |
---|
| 413 | asupmaxmin1(:) = asupmaxmin(:) |
---|
| 414 | #ifdef ISO |
---|
| 415 | xtprecip1(:,:)=xtprecip(:,:) |
---|
| 416 | #endif |
---|
| 417 | ! |
---|
| 418 | sig1(:, 1:nl) = sig(:, 1:nl) |
---|
| 419 | w01(:, 1:nl) = w0(:, 1:nl) |
---|
| 420 | ft1(:, 1:nl) = ft(:, 1:nl) |
---|
| 421 | fq1(:, 1:nl) = fq(:, 1:nl) |
---|
[4727] | 422 | fqcomp1(:, 1:nl) = fqcomp(:, 1:nl) |
---|
[3927] | 423 | fu1(:, 1:nl) = fu(:, 1:nl) |
---|
| 424 | fv1(:, 1:nl) = fv(:, 1:nl) |
---|
| 425 | ma1(:, 1:nl) = ma(:, 1:nl) |
---|
| 426 | mip1(:, 1:nl) = mip(:, 1:nl) |
---|
| 427 | vprecip1(:, 1:nl) = vprecip(:, 1:nl) |
---|
| 428 | vprecipi1(:, 1:nl) = vprecipi(:, 1:nl) |
---|
| 429 | upwd1(:, 1:nl) = upwd(:, 1:nl) |
---|
| 430 | dnwd1(:, 1:nl) = dnwd(:, 1:nl) |
---|
| 431 | dnwd01(:, 1:nl) = dnwd0(:, 1:nl) |
---|
| 432 | qcondc1(:, 1:nl) = qcondc(:, 1:nl) |
---|
| 433 | tvp1(:, 1:nl) = tvp(:, 1:nl) |
---|
| 434 | ftd1(:, 1:nl) = ftd(:, 1:nl) |
---|
| 435 | fqd1(:, 1:nl) = fqd(:, 1:nl) |
---|
| 436 | asupmax1(:, 1:nl) = asupmax(:, 1:nl) |
---|
| 437 | |
---|
| 438 | da1(:, 1:nl) = da(:, 1:nl) !AC! |
---|
| 439 | mp1(:, 1:nl) = mp(:, 1:nl) !RomP |
---|
| 440 | d1a1(:, 1:nl) = d1a(:, 1:nl) !RomP |
---|
| 441 | dam1(:, 1:nl) = dam(:, 1:nl) !RomP |
---|
| 442 | qta1(:, 1:nl) = qta(:, 1:nl) !jyg |
---|
| 443 | clw1(:, 1:nl) = clw(:, 1:nl) !RomP |
---|
| 444 | evap1(:, 1:nl) = evap(:, 1:nl) !RomP |
---|
| 445 | ep1(:, 1:nl) = ep(:, 1:nl) !RomP |
---|
| 446 | eplamM1(:, 1:nl) = eplamM(:, 1:nl) !RomP+jyg |
---|
| 447 | wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl) !RomP |
---|
| 448 | wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP |
---|
| 449 | wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP |
---|
| 450 | qtc1(:, 1:nl) = qtc(:, 1:nl) |
---|
| 451 | sigt1(:, 1:nl) = sigt(:, 1:nl) |
---|
[4727] | 452 | detrain1(:, 1:nl) = detrain(:, 1:nl) |
---|
[3927] | 453 | ! |
---|
| 454 | ma1(:, nlp) = 0. |
---|
| 455 | vprecip1(:, nlp) = 0. |
---|
| 456 | vprecipi1(:, nlp) = 0. |
---|
| 457 | upwd1(:, nlp) = 0. |
---|
| 458 | dnwd1(:, nlp) = 0. |
---|
| 459 | dnwd01(:, nlp) = 0. |
---|
| 460 | |
---|
| 461 | ! |
---|
| 462 | phi1 (:, 1:nl, 1:nl) = phi (:, 1:nl, 1:nl) !AC! |
---|
| 463 | phi21 (:, 1:nl, 1:nl) = phi2 (:, 1:nl, 1:nl) !RomP |
---|
| 464 | sigij1 (:, 1:nl, 1:nl) = sigij (:, 1:nl, 1:nl) !RomP |
---|
| 465 | elij1 (:, 1:nl, 1:nl) = elij (:, 1:nl, 1:nl) !RomP |
---|
| 466 | epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl) !RomP+jyg |
---|
| 467 | |
---|
| 468 | #ifdef ISO |
---|
| 469 | do ixt = 1, ntraciso |
---|
| 470 | fxt1(:,:,1:nl)=fxt(:,:,1:nl) |
---|
| 471 | fxtd1(:,:,1:nl)=fxtd(:,:,1:nl) |
---|
| 472 | xtvprecip1(:,:,1:nlp)=xtvprecip(:,:,1:nlp) |
---|
| 473 | xtvprecipi1(:,:,1:nlp)=xtvprecipi(:,:,1:nlp) |
---|
| 474 | xtevap1(:,:,1:nl)=xtevap(:,:,1:nl) |
---|
| 475 | xtwdtrainA1(:,:,1:nl)=xtwdtrainA(:,:,1:nl) |
---|
| 476 | xtclw1(:,:,1:nl)=xtclw(:,:,1:nl) |
---|
| 477 | enddo |
---|
| 478 | #endif |
---|
| 479 | |
---|
| 480 | |
---|
| 481 | #ifdef ISO |
---|
| 482 | #ifdef DIAGISO |
---|
| 483 | water1(:,1:nl)=water(:,1:nl) |
---|
| 484 | qp1(:,1:nl)=qp(:,1:nl) |
---|
| 485 | fq_detrainement1(:,1:nl)=fq_detrainement(:,1:nl) |
---|
| 486 | f_detrainement1(:,1:nl)=f_detrainement(:,1:nl) |
---|
| 487 | q_detrainement1(:,1:nl)=q_detrainement(:,1:nl) |
---|
| 488 | fq_ddft1(:,1:nl)=fq_ddft(:,1:nl) |
---|
| 489 | fq_fluxmasse1(:,1:nl)=fq_fluxmasse(:,1:nl) |
---|
| 490 | fq_evapprecip1(:,1:nl)=fq_evapprecip(:,1:nl) |
---|
| 491 | do ixt = 1, ntraciso |
---|
| 492 | xtwater1(:,:,1:nl)=xtwater(:,:,1:nl) |
---|
| 493 | xtp1(:,:,1:nl)=xtp(:,:,1:nl) |
---|
| 494 | fxt_detrainement1(:,:,1:nl)=fxt_detrainement(:,:,1:nl) |
---|
| 495 | xt_detrainement1(:,:,1:nl)=xt_detrainement(:,:,1:nl) |
---|
| 496 | fxt_ddft1(:,:,1:nl)=fxt_ddft(:,:,1:nl) |
---|
| 497 | fxt_fluxmasse1(:,:,1:nl)=fxt_fluxmasse(:,:,1:nl) |
---|
| 498 | fxt_evapprecip1(:,:,1:nl)=fxt_evapprecip(:,:,1:nl) |
---|
| 499 | enddo |
---|
| 500 | #endif |
---|
| 501 | #endif |
---|
| 502 | |
---|
| 503 | |
---|
| 504 | ENDIF !(compress) |
---|
| 505 | !>jyg |
---|
| 506 | |
---|
| 507 | RETURN |
---|
| 508 | END SUBROUTINE cv3a_uncompress |
---|
| 509 | |
---|