[3927] | 1 | SUBROUTINE cv3a_compress(len, nloc, ncum, nd, ntra, compress, & |
---|
| 2 | iflag1, nk1, icb1, icbs1, & |
---|
| 3 | plcl1, tnk1, qnk1, gznk1, hnk1, unk1, vnk1, & |
---|
| 4 | wghti1, pbase1, buoybase1, & |
---|
| 5 | t1, q1, qs1, t1_wake, q1_wake, qs1_wake, s1_wake, & |
---|
| 6 | u1, v1, gz1, th1, th1_wake, & |
---|
| 7 | tra1, & |
---|
| 8 | h1, lv1, lf1, cpn1, p1, ph1, tv1, tp1, tvp1, clw1, & |
---|
| 9 | h1_wake, lv1_wake, lf1_wake, cpn1_wake, tv1_wake, & |
---|
| 10 | sig1, w01, ptop21, & |
---|
| 11 | Ale1, Alp1, omega1, & |
---|
| 12 | iflag, nk, icb, icbs, & |
---|
| 13 | plcl, tnk, qnk, gznk, hnk, unk, vnk, & |
---|
| 14 | wghti, pbase, buoybase, & |
---|
| 15 | t, q, qs, t_wake, q_wake, qs_wake, s_wake, & |
---|
| 16 | u, v, gz, th, th_wake, & |
---|
| 17 | tra, & |
---|
| 18 | h, lv, lf, cpn, p, ph, tv, tp, tvp, clw, & |
---|
| 19 | h_wake, lv_wake, lf_wake, cpn_wake, tv_wake, & |
---|
| 20 | sig, w0, ptop2, & |
---|
| 21 | Ale, Alp, omega & |
---|
| 22 | #ifdef ISO |
---|
| 23 | & ,xtnk1,xt1,xt1_wake,xtclw1 & |
---|
| 24 | & ,xtnk,xt,xt_wake,xtclw & |
---|
| 25 | #endif |
---|
| 26 | & ) |
---|
| 27 | ! ************************************************************** |
---|
| 28 | ! * |
---|
| 29 | ! CV3A_COMPRESS * |
---|
| 30 | ! * |
---|
| 31 | ! * |
---|
| 32 | ! written by : Sandrine Bony-Lena , 17/05/2003, 11.22.15 * |
---|
| 33 | ! modified by : Jean-Yves Grandpeix, 23/06/2003, 10.28.09 * |
---|
| 34 | ! ************************************************************** |
---|
| 35 | #ifdef ISO |
---|
[4446] | 36 | use infotrac_phy, ONLY: ntraciso=>ntiso |
---|
[3927] | 37 | use isotopes_mod, ONLY: essai_convergence, iso_eau,iso_HDO |
---|
| 38 | #ifdef ISOVERIF |
---|
| 39 | use isotopes_verif_mod |
---|
| 40 | #endif |
---|
| 41 | #endif |
---|
| 42 | |
---|
| 43 | IMPLICIT NONE |
---|
| 44 | |
---|
| 45 | include "cv3param.h" |
---|
| 46 | |
---|
| 47 | ! inputs: |
---|
| 48 | INTEGER, INTENT (IN) :: len, nloc, nd, ntra |
---|
| 49 | !jyg< |
---|
| 50 | LOGICAL, INTENT (IN) :: compress ! compression is performed if compress is true |
---|
| 51 | !>jyg |
---|
| 52 | INTEGER, DIMENSION (len), INTENT (IN) :: iflag1, nk1, icb1, icbs1 |
---|
| 53 | REAL, DIMENSION (len), INTENT (IN) :: plcl1, tnk1, qnk1, gznk1 |
---|
| 54 | REAL, DIMENSION (len), INTENT (IN) :: hnk1, unk1, vnk1 |
---|
| 55 | REAL, DIMENSION (len, nd), INTENT (IN) :: wghti1(len, nd) |
---|
| 56 | REAL, DIMENSION (len), INTENT (IN) :: pbase1, buoybase1 |
---|
| 57 | REAL, DIMENSION (len, nd), INTENT (IN) :: t1, q1, qs1 |
---|
| 58 | REAL, DIMENSION (len, nd), INTENT (IN) :: t1_wake, q1_wake, qs1_wake |
---|
| 59 | REAL, DIMENSION (len), INTENT (IN) :: s1_wake |
---|
| 60 | REAL, DIMENSION (len, nd), INTENT (IN) :: u1, v1 |
---|
| 61 | REAL, DIMENSION (len, nd), INTENT (IN) :: gz1, th1, th1_wake |
---|
| 62 | REAL, DIMENSION (len, nd,ntra), INTENT (IN) :: tra1 |
---|
| 63 | REAL, DIMENSION (len, nd), INTENT (IN) :: h1, lv1, lf1, cpn1 |
---|
| 64 | REAL, DIMENSION (len, nd), INTENT (IN) :: p1 |
---|
| 65 | REAL, DIMENSION (len, nd+1), INTENT (IN) :: ph1(len, nd+1) |
---|
| 66 | REAL, DIMENSION (len, nd), INTENT (IN) :: tv1, tp1 |
---|
| 67 | REAL, DIMENSION (len, nd), INTENT (IN) :: tvp1, clw1 |
---|
| 68 | REAL, DIMENSION (len, nd), INTENT (IN) :: h1_wake, lv1_wake, cpn1_wake |
---|
| 69 | REAL, DIMENSION (len, nd), INTENT (IN) :: tv1_wake, lf1_wake |
---|
| 70 | REAL, DIMENSION (len, nd), INTENT (IN) :: sig1, w01 |
---|
| 71 | REAL, DIMENSION (len), INTENT (IN) :: ptop21 |
---|
| 72 | REAL, DIMENSION (len), INTENT (IN) :: Ale1, Alp1 |
---|
| 73 | REAL, DIMENSION (len, nd), INTENT (IN) :: omega1 |
---|
| 74 | #ifdef ISO |
---|
| 75 | REAL, DIMENSION (ntraciso,len,nd), INTENT (IN) :: xtclw1 |
---|
| 76 | REAL, DIMENSION (ntraciso,len), INTENT (IN) :: xtnk1 |
---|
| 77 | REAL, DIMENSION (ntraciso,len,nd), INTENT (IN) :: xt1 |
---|
| 78 | REAL, DIMENSION (ntraciso,len,nd), INTENT (IN) :: xt1_wake |
---|
| 79 | #endif |
---|
| 80 | ! |
---|
| 81 | ! in/out |
---|
| 82 | INTEGER, INTENT (INOUT) :: ncum |
---|
| 83 | ! |
---|
| 84 | ! outputs: |
---|
| 85 | ! en fait, on a nloc=len pour l'instant (cf cv_driver) |
---|
| 86 | INTEGER, DIMENSION (nloc), INTENT (OUT) :: iflag, nk, icb, icbs |
---|
| 87 | REAL, DIMENSION (nloc), INTENT (OUT) :: plcl, tnk, qnk, gznk |
---|
| 88 | REAL, DIMENSION (nloc), INTENT (OUT) :: hnk, unk, vnk |
---|
| 89 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: wghti |
---|
| 90 | REAL, DIMENSION (nloc), INTENT (OUT) :: pbase, buoybase |
---|
| 91 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t, q, qs |
---|
| 92 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: t_wake, q_wake, qs_wake |
---|
| 93 | REAL, DIMENSION (nloc), INTENT (OUT) :: s_wake |
---|
| 94 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: u, v |
---|
| 95 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: gz, th, th_wake |
---|
| 96 | REAL, DIMENSION (nloc, nd,ntra), INTENT (OUT) :: tra |
---|
| 97 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h, lv, lf, cpn |
---|
| 98 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: p |
---|
| 99 | REAL, DIMENSION (nloc, nd+1), INTENT (OUT) :: ph |
---|
| 100 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv, tp |
---|
| 101 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tvp, clw |
---|
| 102 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: h_wake, lv_wake, cpn_wake |
---|
| 103 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: tv_wake, lf_wake |
---|
| 104 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: sig, w0 |
---|
| 105 | REAL, DIMENSION (nloc), INTENT (OUT) :: ptop2 |
---|
| 106 | REAL, DIMENSION (nloc), INTENT (OUT) :: Ale, Alp |
---|
| 107 | REAL, DIMENSION (nloc, nd), INTENT (OUT) :: omega |
---|
| 108 | #ifdef ISO |
---|
| 109 | REAL, DIMENSION (ntraciso,nloc), INTENT (OUT) :: xtnk |
---|
| 110 | REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT) :: xtclw |
---|
| 111 | REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT) :: xt |
---|
| 112 | REAL, DIMENSION (ntraciso,nloc, nd), INTENT (OUT) :: xt_wake |
---|
| 113 | #endif |
---|
| 114 | |
---|
| 115 | ! local variables: |
---|
| 116 | INTEGER i, k, nn, j |
---|
| 117 | #ifdef ISO |
---|
| 118 | integer ixt |
---|
| 119 | #endif |
---|
| 120 | |
---|
| 121 | CHARACTER (LEN=20) :: modname = 'cv3a_compress' |
---|
| 122 | CHARACTER (LEN=80) :: abort_message |
---|
| 123 | |
---|
| 124 | #ifdef ISOVERIF |
---|
| 125 | write(*,*) 'compress=', compress |
---|
| 126 | write(*,*) 'nl=',nl |
---|
| 127 | #endif |
---|
| 128 | !jyg< |
---|
| 129 | IF (compress) THEN |
---|
| 130 | !>jyg |
---|
| 131 | |
---|
| 132 | DO k = 1, nl + 1 |
---|
| 133 | nn = 0 |
---|
| 134 | DO i = 1, len |
---|
| 135 | IF (iflag1(i)==0) THEN |
---|
| 136 | nn = nn + 1 |
---|
| 137 | wghti(nn, k) = wghti1(i, k) |
---|
| 138 | t(nn, k) = t1(i, k) |
---|
| 139 | q(nn, k) = q1(i, k) |
---|
| 140 | qs(nn, k) = qs1(i, k) |
---|
| 141 | t_wake(nn, k) = t1_wake(i, k) |
---|
| 142 | q_wake(nn, k) = q1_wake(i, k) |
---|
| 143 | qs_wake(nn, k) = qs1_wake(i, k) |
---|
| 144 | u(nn, k) = u1(i, k) |
---|
| 145 | v(nn, k) = v1(i, k) |
---|
| 146 | gz(nn, k) = gz1(i, k) |
---|
| 147 | th(nn, k) = th1(i, k) |
---|
| 148 | th_wake(nn, k) = th1_wake(i, k) |
---|
| 149 | h(nn, k) = h1(i, k) |
---|
| 150 | lv(nn, k) = lv1(i, k) |
---|
| 151 | lf(nn, k) = lf1(i, k) |
---|
| 152 | cpn(nn, k) = cpn1(i, k) |
---|
| 153 | p(nn, k) = p1(i, k) |
---|
| 154 | ph(nn, k) = ph1(i, k) |
---|
| 155 | tv(nn, k) = tv1(i, k) |
---|
| 156 | tp(nn, k) = tp1(i, k) |
---|
| 157 | tvp(nn, k) = tvp1(i, k) |
---|
| 158 | clw(nn, k) = clw1(i, k) |
---|
| 159 | h_wake(nn, k) = h1_wake(i, k) |
---|
| 160 | lv_wake(nn, k) = lv1_wake(i, k) |
---|
| 161 | lf_wake(nn, k) = lf1_wake(i, k) |
---|
| 162 | cpn_wake(nn, k) = cpn1_wake(i, k) |
---|
| 163 | tv_wake(nn, k) = tv1_wake(i, k) |
---|
| 164 | sig(nn, k) = sig1(i, k) |
---|
| 165 | w0(nn, k) = w01(i, k) |
---|
| 166 | omega(nn, k) = omega1(i, k) |
---|
| 167 | #ifdef ISO |
---|
| 168 | do ixt=1,ntraciso |
---|
| 169 | xt(ixt,nn,k)=xt1(ixt,i,k) |
---|
| 170 | xt_wake(ixt,nn,k)=xt1_wake(ixt,i,k) |
---|
| 171 | xtclw(ixt,nn,k)=xtclw1(ixt,i,k) |
---|
| 172 | enddo |
---|
| 173 | #endif |
---|
| 174 | END IF |
---|
| 175 | END DO |
---|
| 176 | END DO |
---|
| 177 | ! |
---|
| 178 | ! AC! do 121 j=1,ntra |
---|
| 179 | ! AC!ccccc do 111 k=1,nl+1 |
---|
| 180 | ! AC! do 111 k=1,nd |
---|
| 181 | ! AC! nn=0 |
---|
| 182 | ! AC! do 101 i=1,len |
---|
| 183 | ! AC! if(iflag1(i).eq.0)then |
---|
| 184 | ! AC! nn=nn+1 |
---|
| 185 | ! AC! tra(nn,k,j)=tra1(i,k,j) |
---|
| 186 | ! AC! endif |
---|
| 187 | ! AC! 101 continue |
---|
| 188 | ! AC! 111 continue |
---|
| 189 | ! AC! 121 continue |
---|
| 190 | |
---|
| 191 | IF (nn/=ncum) THEN |
---|
| 192 | PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum |
---|
| 193 | abort_message = '' |
---|
| 194 | CALL abort_physic(modname, abort_message, 1) |
---|
| 195 | END IF |
---|
| 196 | |
---|
| 197 | nn = 0 |
---|
| 198 | DO i = 1, len |
---|
| 199 | IF (iflag1(i)==0) THEN |
---|
| 200 | nn = nn + 1 |
---|
| 201 | s_wake(nn) = s1_wake(i) |
---|
| 202 | iflag(nn) = iflag1(i) |
---|
| 203 | nk(nn) = nk1(i) |
---|
| 204 | icb(nn) = icb1(i) |
---|
| 205 | icbs(nn) = icbs1(i) |
---|
| 206 | plcl(nn) = plcl1(i) |
---|
| 207 | tnk(nn) = tnk1(i) |
---|
| 208 | qnk(nn) = qnk1(i) |
---|
| 209 | gznk(nn) = gznk1(i) |
---|
| 210 | hnk(nn) = hnk1(i) |
---|
| 211 | unk(nn) = unk1(i) |
---|
| 212 | vnk(nn) = vnk1(i) |
---|
| 213 | pbase(nn) = pbase1(i) |
---|
| 214 | buoybase(nn) = buoybase1(i) |
---|
| 215 | sig(nn, nd) = sig1(i, nd) |
---|
| 216 | ptop2(nn) = ptop2(i) |
---|
| 217 | Ale(nn) = Ale1(i) |
---|
| 218 | Alp(nn) = Alp1(i) |
---|
| 219 | #ifdef ISO |
---|
| 220 | do ixt=1,ntraciso |
---|
| 221 | xtnk(ixt,nn)=xtnk1(ixt,i) |
---|
| 222 | enddo |
---|
| 223 | #endif |
---|
| 224 | END IF |
---|
| 225 | END DO |
---|
| 226 | |
---|
| 227 | IF (nn/=ncum) THEN |
---|
| 228 | PRINT *, 'WARNING nn not equal to ncum: ', nn, ncum |
---|
| 229 | abort_message = '' |
---|
| 230 | CALL abort_physic(modname, abort_message, 1) |
---|
| 231 | END IF |
---|
| 232 | ! |
---|
| 233 | !jyg< |
---|
| 234 | ELSE !(compress) |
---|
| 235 | ! |
---|
| 236 | ncum = len |
---|
| 237 | ! |
---|
| 238 | wghti(:,1:nl+1) = wghti1(:,1:nl+1) |
---|
| 239 | t(:,1:nl+1) = t1(:,1:nl+1) |
---|
| 240 | q(:,1:nl+1) = q1(:,1:nl+1) |
---|
| 241 | qs(:,1:nl+1) = qs1(:,1:nl+1) |
---|
| 242 | t_wake(:,1:nl+1) = t1_wake(:,1:nl+1) |
---|
| 243 | q_wake(:,1:nl+1) = q1_wake(:,1:nl+1) |
---|
| 244 | qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1) |
---|
| 245 | u(:,1:nl+1) = u1(:,1:nl+1) |
---|
| 246 | v(:,1:nl+1) = v1(:,1:nl+1) |
---|
| 247 | gz(:,1:nl+1) = gz1(:,1:nl+1) |
---|
| 248 | th(:,1:nl+1) = th1(:,1:nl+1) |
---|
| 249 | th_wake(:,1:nl+1) = th1_wake(:,1:nl+1) |
---|
| 250 | h(:,1:nl+1) = h1(:,1:nl+1) |
---|
| 251 | lv(:,1:nl+1) = lv1(:,1:nl+1) |
---|
| 252 | lf(:,1:nl+1) = lf1(:,1:nl+1) |
---|
| 253 | cpn(:,1:nl+1) = cpn1(:,1:nl+1) |
---|
| 254 | p(:,1:nl+1) = p1(:,1:nl+1) |
---|
| 255 | ph(:,1:nl+1) = ph1(:,1:nl+1) |
---|
| 256 | tv(:,1:nl+1) = tv1(:,1:nl+1) |
---|
| 257 | tp(:,1:nl+1) = tp1(:,1:nl+1) |
---|
| 258 | tvp(:,1:nl+1) = tvp1(:,1:nl+1) |
---|
| 259 | clw(:,1:nl+1) = clw1(:,1:nl+1) |
---|
| 260 | h_wake(:,1:nl+1) = h1_wake(:,1:nl+1) |
---|
| 261 | lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1) |
---|
| 262 | lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1) |
---|
| 263 | cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1) |
---|
| 264 | tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1) |
---|
| 265 | sig(:,1:nl+1) = sig1(:,1:nl+1) |
---|
| 266 | w0(:,1:nl+1) = w01(:,1:nl+1) |
---|
| 267 | omega(:,1:nl+1) = omega1(:,1:nl+1) |
---|
| 268 | #ifdef ISO |
---|
| 269 | xt(:,:,1:nl+1) = xt1(:,:,1:nl+1) |
---|
| 270 | xtclw(:,:,1:nl+1) = xtclw1(:,:,1:nl+1) |
---|
| 271 | xt_wake(:,:,1:nl+1) = xt1_wake(:,:,1:nl+1) |
---|
| 272 | #endif |
---|
| 273 | ! |
---|
| 274 | s_wake(:) = s1_wake(:) |
---|
| 275 | iflag(:) = iflag1(:) |
---|
| 276 | nk(:) = nk1(:) |
---|
| 277 | icb(:) = icb1(:) |
---|
| 278 | icbs(:) = icbs1(:) |
---|
| 279 | plcl(:) = plcl1(:) |
---|
| 280 | tnk(:) = tnk1(:) |
---|
| 281 | qnk(:) = qnk1(:) |
---|
| 282 | gznk(:) = gznk1(:) |
---|
| 283 | hnk(:) = hnk1(:) |
---|
| 284 | unk(:) = unk1(:) |
---|
| 285 | vnk(:) = vnk1(:) |
---|
| 286 | pbase(:) = pbase1(:) |
---|
| 287 | buoybase(:) = buoybase1(:) |
---|
| 288 | sig(:, nd) = sig1(:, nd) |
---|
| 289 | ptop2(:) = ptop2(:) |
---|
| 290 | Ale(:) = Ale1(:) |
---|
| 291 | Alp(:) = Alp1(:) |
---|
| 292 | #ifdef ISO |
---|
| 293 | xtnk(:,:) = xtnk1(:,:) |
---|
| 294 | #endif |
---|
| 295 | ! |
---|
| 296 | ENDIF !(compress) |
---|
| 297 | !>jyg |
---|
| 298 | |
---|
| 299 | RETURN |
---|
| 300 | END SUBROUTINE cv3a_compress |
---|