SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, iflag, kbas, & ktop, precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, ft, fq, fu, fv, & ftra, sigd, ma, mip, vprecip, upwd, dnwd, dnwd0, qcondc, wd, cape, cin, & tvp, ftd, fqd, plim1, plim2, asupmax, supmax0, asupmaxmin & , da, phi, mp, phi2, d1a, dam, sigij & ! RomP+AC+jyg , clw, elij, evap, ep, epmlmmm, eplamm & ! RomP , wdtraina, wdtrainm & ! RomP , iflag1, kbas1, ktop1, precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, & ptop21, ft1, fq1, fu1, fv1, ftra1, sigd1, ma1, mip1, vprecip1, upwd1, & dnwd1, dnwd01, qcondc1, wd1, cape1, cin1, tvp1, ftd1, fqd1, plim11, & plim21, asupmax1, supmax01, asupmaxmin1 & , da1, phi1, mp1, phi21, d1a1, dam1, sigij1 & ! RomP+AC+jyg , clw1, elij1, evap1, ep1, epmlmmm1, eplamm1 & ! RomP , wdtraina1, wdtrainm1) ! RomP ! ************************************************************** ! * ! CV3A_UNCOMPRESS * ! * ! * ! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 * ! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.36.17 * ! ************************************************************** IMPLICIT NONE include "cv3param.h" ! inputs: INTEGER nloc, len, ncum, nd, ntra INTEGER idcum(nloc) INTEGER iflag(nloc), kbas(nloc), ktop(nloc) REAL precip(nloc), cbmf(nloc), plcl(nloc), plfc(nloc) REAL wbeff(len) REAL sig(nloc, nd), w0(nloc, nd), ptop2(nloc) REAL ft(nloc, nd), fq(nloc, nd), fu(nloc, nd), fv(nloc, nd) REAL ftra(nloc, nd, ntra) REAL sigd(nloc) REAL ma(nloc, nd), mip(nloc, nd), vprecip(nloc, nd+1) REAL upwd(nloc, nd), dnwd(nloc, nd), dnwd0(nloc, nd) REAL qcondc(nloc, nd) REAL wd(nloc), cape(nloc), cin(nloc) REAL tvp(nloc, nd) REAL ftd(nloc, nd), fqd(nloc, nd) REAL plim1(nloc), plim2(nloc) REAL asupmax(nloc, nd), supmax0(nloc) REAL asupmaxmin(nloc) REAL da(nloc, nd), phi(nloc, nd, nd) !AC! REAL mp(nloc, nd) !RomP REAL phi2(nloc, nd, nd) !RomP REAL d1a(nloc, nd), dam(nloc, nd) !RomP REAL sigij(nloc, nd, nd) !RomP REAL clw(nloc, nd), elij(nloc, nd, nd) !RomP REAL evap(nloc, nd), ep(nloc, nd) !RomP REAL epmlmmm(nloc, nd, nd), eplamm(nloc, nd) !RomP+jyg REAL wdtraina(nloc, nd), wdtrainm(nloc, nd) !RomP ! outputs: INTEGER iflag1(len), kbas1(len), ktop1(len) REAL precip1(len), cbmf1(len), plcl1(nloc), plfc1(nloc) REAL wbeff1(len) REAL sig1(len, nd), w01(len, nd), ptop21(len) REAL ft1(len, nd), fq1(len, nd), fu1(len, nd), fv1(len, nd) REAL ftra1(len, nd, ntra) REAL sigd1(len) REAL ma1(len, nd), mip1(len, nd), vprecip1(len, nd+1) REAL upwd1(len, nd), dnwd1(len, nd), dnwd01(len, nd) REAL qcondc1(len, nd) REAL wd1(len), cape1(len), cin1(len) REAL tvp1(len, nd) REAL ftd1(len, nd), fqd1(len, nd) REAL plim11(len), plim21(len) REAL asupmax1(len, nd), supmax01(len) REAL asupmaxmin1(len) REAL da1(nloc, nd), phi1(nloc, nd, nd) !AC! REAL mp1(nloc, nd) !RomP REAL phi21(nloc, nd, nd) !RomP REAL d1a1(nloc, nd), dam1(nloc, nd) !RomP REAL sigij1(len, nd, nd) !RomP REAL clw1(len, nd), elij1(len, nd, nd) !RomP REAL evap1(len, nd), ep1(len, nd) !RomP REAL epmlmmm1(len, nd, nd), eplamm1(len, nd) !RomP+jyg REAL wdtraina1(len, nd), wdtrainm1(len, nd) !RomP ! local variables: INTEGER i, k, j ! c integer k1,k2 DO i = 1, ncum ptop21(idcum(i)) = ptop2(i) sigd1(idcum(i)) = sigd(i) precip1(idcum(i)) = precip(i) cbmf1(idcum(i)) = cbmf(i) plcl1(idcum(i)) = plcl(i) plfc1(idcum(i)) = plfc(i) wbeff1(idcum(i)) = wbeff(i) iflag1(idcum(i)) = iflag(i) kbas1(idcum(i)) = kbas(i) ktop1(idcum(i)) = ktop(i) wd1(idcum(i)) = wd(i) cape1(idcum(i)) = cape(i) cin1(idcum(i)) = cin(i) plim11(idcum(i)) = plim1(i) plim21(idcum(i)) = plim2(i) supmax01(idcum(i)) = supmax0(i) asupmaxmin1(idcum(i)) = asupmaxmin(i) END DO DO k = 1, nd DO i = 1, ncum sig1(idcum(i), k) = sig(i, k) w01(idcum(i), k) = w0(i, k) ft1(idcum(i), k) = ft(i, k) fq1(idcum(i), k) = fq(i, k) fu1(idcum(i), k) = fu(i, k) fv1(idcum(i), k) = fv(i, k) ma1(idcum(i), k) = ma(i, k) mip1(idcum(i), k) = mip(i, k) vprecip1(idcum(i), k) = vprecip(i, k) upwd1(idcum(i), k) = upwd(i, k) dnwd1(idcum(i), k) = dnwd(i, k) dnwd01(idcum(i), k) = dnwd0(i, k) qcondc1(idcum(i), k) = qcondc(i, k) tvp1(idcum(i), k) = tvp(i, k) ftd1(idcum(i), k) = ftd(i, k) fqd1(idcum(i), k) = fqd(i, k) asupmax1(idcum(i), k) = asupmax(i, k) da1(idcum(i), k) = da(i, k) !AC! mp1(idcum(i), k) = mp(i, k) !RomP d1a1(idcum(i), k) = d1a(i, k) !RomP dam1(idcum(i), k) = dam(i, k) !RomP clw1(idcum(i), k) = clw(i, k) !RomP evap1(idcum(i), k) = evap(i, k) !RomP ep1(idcum(i), k) = ep(i, k) !RomP eplamm(idcum(i), k) = eplamm(i, k) !RomP+jyg wdtraina1(idcum(i), k) = wdtraina(i, k) !RomP wdtrainm1(idcum(i), k) = wdtrainm(i, k) !RomP END DO END DO DO i = 1, ncum sig1(idcum(i), nd) = sig(i, nd) END DO ! AC! do 2100 j=1,ntra ! AC!c oct3 do 2110 k=1,nl ! AC! do 2110 k=1,nd ! oct3 ! AC! do 2120 i=1,ncum ! AC! ftra1(idcum(i),k,j)=ftra(i,k,j) ! AC! 2120 continue ! AC! 2110 continue ! AC! 2100 continue ! AC! DO j = 1, nd DO k = 1, nd DO i = 1, ncum phi1(idcum(i), k, j) = phi(i, k, j) !AC! phi21(idcum(i), k, j) = phi2(i, k, j) !RomP sigij1(idcum(i), k, j) = sigij(i, k, j) !RomP elij1(idcum(i), k, j) = elij(i, k, j) !RomP epmlmmm(idcum(i), k, j) = epmlmmm(i, k, j) !RomP+jyg END DO END DO END DO ! AC! ! do 2220 k2=1,nd ! do 2210 k1=1,nd ! do 2200 i=1,ncum ! ment1(idcum(i),k1,k2) = ment(i,k1,k2) ! sigij1(idcum(i),k1,k2) = sigij(i,k1,k2) ! 2200 enddo ! 2210 enddo ! 2220 enddo RETURN END SUBROUTINE cv3a_uncompress