Changeset 5712 for LMDZ6/trunk/libf
- Timestamp:
- Jun 16, 2025, 7:12:42 PM (7 weeks ago)
- Location:
- LMDZ6/trunk/libf/phylmd
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/phylmd/cv3a_compress.f90
r5695 r5712 195 195 ELSE !(compress) 196 196 ! 197 ncum = len 198 ! 199 wghti(:,1:nl+1) = wghti1(:,1:nl+1) 200 t(:,1:nl+1) = t1(:,1:nl+1) 201 q(:,1:nl+1) = q1(:,1:nl+1) 202 qs(:,1:nl+1) = qs1(:,1:nl+1) 203 t_wake(:,1:nl+1) = t1_wake(:,1:nl+1) 204 q_wake(:,1:nl+1) = q1_wake(:,1:nl+1) 205 qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1) 206 u(:,1:nl+1) = u1(:,1:nl+1) 207 v(:,1:nl+1) = v1(:,1:nl+1) 208 gz(:,1:nl+1) = gz1(:,1:nl+1) 209 th(:,1:nl+1) = th1(:,1:nl+1) 210 th_wake(:,1:nl+1) = th1_wake(:,1:nl+1) 211 h(:,1:nl+1) = h1(:,1:nl+1) 212 lv(:,1:nl+1) = lv1(:,1:nl+1) 213 lf(:,1:nl+1) = lf1(:,1:nl+1) 214 cpn(:,1:nl+1) = cpn1(:,1:nl+1) 215 p(:,1:nl+1) = p1(:,1:nl+1) 216 ph(:,1:nl+1) = ph1(:,1:nl+1) 217 tv(:,1:nl+1) = tv1(:,1:nl+1) 218 tp(:,1:nl+1) = tp1(:,1:nl+1) 219 tvp(:,1:nl+1) = tvp1(:,1:nl+1) 220 clw(:,1:nl+1) = clw1(:,1:nl+1) 221 h_wake(:,1:nl+1) = h1_wake(:,1:nl+1) 222 lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1) 223 lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1) 224 cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1) 225 tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1) 226 sig(:,1:nl+1) = sig1(:,1:nl+1) 227 w0(:,1:nl+1) = w01(:,1:nl+1) 228 omega(:,1:nl+1) = omega1(:,1:nl+1) 229 ! 230 s_wake(:) = s1_wake(:) 231 iflag(:) = iflag1(:) 232 nk(:) = nk1(:) 233 icb(:) = icb1(:) 234 icbs(:) = icbs1(:) 235 plcl(:) = plcl1(:) 236 tnk(:) = tnk1(:) 237 qnk(:) = qnk1(:) 238 gznk(:) = gznk1(:) 239 hnk(:) = hnk1(:) 240 unk(:) = unk1(:) 241 vnk(:) = vnk1(:) 242 pbase(:) = pbase1(:) 243 buoybase(:) = buoybase1(:) 244 sig(:, nd) = sig1(:, nd) 245 ptop2(:) = ptop2(:) 246 Ale(:) = Ale1(:) 247 Alp(:) = Alp1(:) 197 wghti(:,1:nl+1) = wghti1(:,1:nl+1) 198 t(:,1:nl+1) = t1(:,1:nl+1) 199 q(:,1:nl+1) = q1(:,1:nl+1) 200 qs(:,1:nl+1) = qs1(:,1:nl+1) 201 t_wake(:,1:nl+1) = t1_wake(:,1:nl+1) 202 q_wake(:,1:nl+1) = q1_wake(:,1:nl+1) 203 qs_wake(:,1:nl+1) = qs1_wake(:,1:nl+1) 204 u(:,1:nl+1) = u1(:,1:nl+1) 205 v(:,1:nl+1) = v1(:,1:nl+1) 206 gz(:,1:nl+1) = gz1(:,1:nl+1) 207 th(:,1:nl+1) = th1(:,1:nl+1) 208 th_wake(:,1:nl+1) = th1_wake(:,1:nl+1) 209 h(:,1:nl+1) = h1(:,1:nl+1) 210 lv(:,1:nl+1) = lv1(:,1:nl+1) 211 lf(:,1:nl+1) = lf1(:,1:nl+1) 212 cpn(:,1:nl+1) = cpn1(:,1:nl+1) 213 p(:,1:nl+1) = p1(:,1:nl+1) 214 ph(:,1:nl+1) = ph1(:,1:nl+1) 215 tv(:,1:nl+1) = tv1(:,1:nl+1) 216 tp(:,1:nl+1) = tp1(:,1:nl+1) 217 tvp(:,1:nl+1) = tvp1(:,1:nl+1) 218 clw(:,1:nl+1) = clw1(:,1:nl+1) 219 h_wake(:,1:nl+1) = h1_wake(:,1:nl+1) 220 lv_wake(:,1:nl+1) = lv1_wake(:,1:nl+1) 221 lf_wake(:,1:nl+1) = lf1_wake(:,1:nl+1) 222 cpn_wake(:,1:nl+1) = cpn1_wake(:,1:nl+1) 223 tv_wake(:,1:nl+1) = tv1_wake(:,1:nl+1) 224 sig(:,1:nl+1) = sig1(:,1:nl+1) 225 w0(:,1:nl+1) = w01(:,1:nl+1) 226 omega(:,1:nl+1) = omega1(:,1:nl+1) 227 228 s_wake(:) = s1_wake(:) 229 iflag(:) = iflag1(:) 230 nk(:) = nk1(:) 231 icb(:) = icb1(:) 232 icbs(:) = icbs1(:) 233 plcl(:) = plcl1(:) 234 tnk(:) = tnk1(:) 235 qnk(:) = qnk1(:) 236 gznk(:) = gznk1(:) 237 hnk(:) = hnk1(:) 238 unk(:) = unk1(:) 239 vnk(:) = vnk1(:) 240 pbase(:) = pbase1(:) 241 buoybase(:) = buoybase1(:) 242 sig(:, nd) = sig1(:, nd) 243 ptop2(:) = ptop2(:) 244 Ale(:) = Ale1(:) 245 Alp(:) = Alp1(:) 248 246 ! 249 247 ENDIF !(compress) -
LMDZ6/trunk/libf/phylmd/cv3a_uncompress.f90
r5692 r5712 6 6 7 7 CONTAINS 8 SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress, & 8 9 SUBROUTINE cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, is_convect, compress, & 9 10 iflag, kbas, ktop, & 10 11 precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, & … … 54 55 INTEGER, INTENT (IN) :: nloc, len, ncum, nd, ntra 55 56 INTEGER, DIMENSION (nloc), INTENT (IN) :: idcum(nloc) 57 LOGICAL, DIMENSION (nloc), INTENT (IN) :: is_convect(nloc) 56 58 !jyg< 57 59 LOGICAL, INTENT (IN) :: compress … … 277 279 ELSE !(compress) 278 280 ! 279 sig1(:,nd) = sig(:,nd) 280 ptop21(:) = ptop2(:) 281 sigd1(:) = sigd(:) 282 precip1(:) = precip(:) 283 cbmf1(:) = cbmf(:) 284 plcl1(:) = plcl(:) 285 plfc1(:) = plfc(:) 286 wbeff1(:) = wbeff(:) 287 iflag1(:) = iflag(:) 288 kbas1(:) = kbas(:) 289 ktop1(:) = ktop(:) 290 wd1(:) = wd(:) 291 cape1(:) = cape(:) 292 cin1(:) = cin(:) 293 plim11(:) = plim1(:) 294 plim21(:) = plim2(:) 295 supmax01(:) = supmax0(:) 296 asupmaxmin1(:) = asupmaxmin(:) 297 coef_clos1(:) = coef_clos(:) 298 coef_clos_eff1(:) = coef_clos_eff(:) 281 DO i = 1, len 282 IF (is_convect(i)) THEN 283 sig1(i,nd) = sig(i,nd) 284 ptop21(i) = ptop2(i) 285 sigd1(i) = sigd(i) 286 precip1(i) = precip(i) 287 cbmf1(i) = cbmf(i) 288 plcl1(i) = plcl(i) 289 plfc1(i) = plfc(i) 290 wbeff1(i) = wbeff(i) 291 iflag1(i) = iflag(i) 292 kbas1(i) = kbas(i) 293 ktop1(i) = ktop(i) 294 wd1(i) = wd(i) 295 cape1(i) = cape(i) 296 cin1(i) = cin(i) 297 plim11(i) = plim1(i) 298 plim21(i) = plim2(i) 299 supmax01(i) = supmax0(i) 300 asupmaxmin1(i) = asupmaxmin(i) 301 coef_clos1(i) = coef_clos(i) 302 coef_clos_eff1(i) = coef_clos_eff(i) 303 ENDIF 304 ENDDO 305 306 DO k = 1, nl 307 DO i = 1, len 308 IF (is_convect(i)) THEN 309 sig1(i,k) = sig(i,k) 310 w01(i,k) = w0(i,k) 311 ft1(i,k) = ft(i,k) 312 fq1(i,k) = fq(i,k) 313 fqcomp1(i,k) = fqcomp(i,k) 314 fu1(i,k) = fu(i,k) 315 fv1(i,k) = fv(i,k) 316 ma1(i,k) = ma(i,k) 317 mip1(i,k) = mip(i,k) 318 vprecip1(i,k) = vprecip(i,k) 319 vprecipi1(i,k) = vprecipi(i,k) 320 upwd1(i,k) = upwd(i,k) 321 dnwd1(i,k) = dnwd(i,k) 322 dnwd01(i,k) = dnwd0(i,k) 323 qcondc1(i,k) = qcondc(i,k) 324 tvp1(i,k) = tvp(i,k) 325 ftd1(i,k) = ftd(i,k) 326 fqd1(i,k) = fqd(i,k) 327 asupmax1(i,k) = asupmax(i,k) 328 329 da1(i,k) = da(i,k) !AC! 330 mp1(i,k) = mp(i,k) !RomP 331 d1a1(i,k) = d1a(i,k) !RomP 332 dam1(i,k) = dam(i,k) !RomP 333 qta1(i,k) = qta(i,k) !jyg 334 clw1(i,k) = clw(i,k) !RomP 335 evap1(i,k) = evap(i,k) !RomP 336 ep1(i,k) = ep(i,k) !RomP 337 eplamM1(i,k) = eplamM(i,k) !RomP+jyg 338 wdtrainA1(i,k) = wdtrainA(i,k) !RomP 339 wdtrainS1(i,k) = wdtrainS(i,k) !RomP 340 wdtrainM1(i,k) = wdtrainM(i,k) !RomP 341 qtc1(i,k) = qtc(i,k) 342 sigt1(i,k) = sigt(i,k) 343 detrain1(i,k) = detrain(i,k) 344 ENDIF 345 ENDDO 346 ENDDO 347 348 DO i = 1, len 349 IF (is_convect(i)) THEN 350 ma1(i, nlp) = 0. 351 vprecip1(i, nlp) = 0. 352 vprecipi1(i, nlp) = 0. 353 upwd1(i, nlp) = 0. 354 dnwd1(i, nlp) = 0. 355 dnwd01(i, nlp) = 0. 356 ENDIF 357 ENDDO 299 358 ! 300 sig1(:, 1:nl) = sig(:, 1:nl) 301 w01(:, 1:nl) = w0(:, 1:nl) 302 ft1(:, 1:nl) = ft(:, 1:nl) 303 fq1(:, 1:nl) = fq(:, 1:nl) 304 fqcomp1(:, 1:nl) = fqcomp(:, 1:nl) 305 fu1(:, 1:nl) = fu(:, 1:nl) 306 fv1(:, 1:nl) = fv(:, 1:nl) 307 ma1(:, 1:nl) = ma(:, 1:nl) 308 mip1(:, 1:nl) = mip(:, 1:nl) 309 vprecip1(:, 1:nl) = vprecip(:, 1:nl) 310 vprecipi1(:, 1:nl) = vprecipi(:, 1:nl) 311 upwd1(:, 1:nl) = upwd(:, 1:nl) 312 dnwd1(:, 1:nl) = dnwd(:, 1:nl) 313 dnwd01(:, 1:nl) = dnwd0(:, 1:nl) 314 qcondc1(:, 1:nl) = qcondc(:, 1:nl) 315 tvp1(:, 1:nl) = tvp(:, 1:nl) 316 ftd1(:, 1:nl) = ftd(:, 1:nl) 317 fqd1(:, 1:nl) = fqd(:, 1:nl) 318 asupmax1(:, 1:nl) = asupmax(:, 1:nl) 319 320 da1(:, 1:nl) = da(:, 1:nl) !AC! 321 mp1(:, 1:nl) = mp(:, 1:nl) !RomP 322 d1a1(:, 1:nl) = d1a(:, 1:nl) !RomP 323 dam1(:, 1:nl) = dam(:, 1:nl) !RomP 324 qta1(:, 1:nl) = qta(:, 1:nl) !jyg 325 clw1(:, 1:nl) = clw(:, 1:nl) !RomP 326 evap1(:, 1:nl) = evap(:, 1:nl) !RomP 327 ep1(:, 1:nl) = ep(:, 1:nl) !RomP 328 eplamM1(:, 1:nl) = eplamM(:, 1:nl) !RomP+jyg 329 wdtrainA1(:, 1:nl) = wdtrainA(:, 1:nl) !RomP 330 wdtrainS1(:, 1:nl) = wdtrainS(:, 1:nl) !RomP 331 wdtrainM1(:, 1:nl) = wdtrainM(:, 1:nl) !RomP 332 qtc1(:, 1:nl) = qtc(:, 1:nl) 333 sigt1(:, 1:nl) = sigt(:, 1:nl) 334 detrain1(:, 1:nl) = detrain(:, 1:nl) 335 ! 336 ma1(:, nlp) = 0. 337 vprecip1(:, nlp) = 0. 338 vprecipi1(:, nlp) = 0. 339 upwd1(:, nlp) = 0. 340 dnwd1(:, nlp) = 0. 341 dnwd01(:, nlp) = 0. 342 343 ! 344 phi1 (:, 1:nl, 1:nl) = phi (:, 1:nl, 1:nl) !AC! 345 phi21 (:, 1:nl, 1:nl) = phi2 (:, 1:nl, 1:nl) !RomP 346 sigij1 (:, 1:nl, 1:nl) = sigij (:, 1:nl, 1:nl) !RomP 347 elij1 (:, 1:nl, 1:nl) = elij (:, 1:nl, 1:nl) !RomP 348 epmlmMm1(:, 1:nl, 1:nl) = epmlmMm(:, 1:nl, 1:nl) !RomP+jyg 359 DO k = 1,nl 360 DO j = 1,nl 361 DO i = 1, len 362 IF (is_convect(i)) THEN 363 phi1 (i,j,k) = phi (i,j,k) !AC! 364 phi21 (i,j,k) = phi2 (i,j,k) !RomP 365 sigij1 (i,j,k) = sigij (i,j,k) !RomP 366 elij1 (i,j,k) = elij (i,j,k) !RomP 367 epmlmMm1(i,j,k) = epmlmMm(i,j,k) !RomP+jyg 368 ENDIF 369 ENDDO 370 ENDDO 371 ENDDO 349 372 ENDIF !(compress) 350 373 !>jyg -
LMDZ6/trunk/libf/phylmd/cv_driver.F90
r5692 r5712 347 347 ! RomP <<< 348 348 REAL epmax_diag(nloc) ! epmax_cape 349 LOGICAL is_convect(nloc) 349 350 350 351 nent(:, :) = 0 … … 532 533 533 534 IF (iflag_con==4) THEN 534 CALL cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &535 CALL cv_compress(len, nloc, ncum, nd, iflag1, .TRUE., nk1, icb1, cbmf1, plcl1, & 535 536 tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, & 536 537 tv1, tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, & … … 671 672 672 673 IF (iflag_con==4) THEN 673 CALL cv_uncompress(nloc, len, ncum, nd, idcum, i flag, precip, cbmf, ft, &674 CALL cv_uncompress(nloc, len, ncum, nd, idcum, is_convect, .TRUE., iflag, precip, cbmf, ft, & 674 675 fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, & 675 676 ma1, qcondc1) -
LMDZ6/trunk/libf/phylmd/cv_routines.f90
r5711 r5712 407 407 END SUBROUTINE cv_trigger 408 408 409 SUBROUTINE cv_compress(len, nloc, ncum, nd, iflag1, nk1, icb1, cbmf1, plcl1, &409 SUBROUTINE cv_compress(len, nloc, ncum, nd, iflag1, compress, nk1, icb1, cbmf1, plcl1, & 410 410 tnk1, qnk1, gznk1, t1, q1, qs1, u1, v1, gz1, h1, lv1, cpn1, p1, ph1, tv1, & 411 411 tp1, tvp1, clw1, iflag, nk, icb, cbmf, plcl, tnk, qnk, gznk, t, q, qs, u, & … … 419 419 INTEGER len, ncum, nd, nloc 420 420 INTEGER iflag1(len), nk1(len), icb1(len) 421 LOGICAL compress 421 422 REAL cbmf1(len), plcl1(len), tnk1(len), qnk1(len), gznk1(len) 422 423 REAL t1(len, nd), q1(len, nd), qs1(len, nd), u1(len, nd), v1(len, nd) … … 439 440 CHARACTER (LEN=80) :: abort_message 440 441 441 442 DO k = 1, nl + 1 442 IF (compress) THEN 443 DO k = 1, nl + 1 444 nn = 0 445 DO i = 1, len 446 IF (iflag1(i)==0) THEN 447 nn = nn + 1 448 t(nn, k) = t1(i, k) 449 q(nn, k) = q1(i, k) 450 qs(nn, k) = qs1(i, k) 451 u(nn, k) = u1(i, k) 452 v(nn, k) = v1(i, k) 453 gz(nn, k) = gz1(i, k) 454 h(nn, k) = h1(i, k) 455 lv(nn, k) = lv1(i, k) 456 cpn(nn, k) = cpn1(i, k) 457 p(nn, k) = p1(i, k) 458 ph(nn, k) = ph1(i, k) 459 tv(nn, k) = tv1(i, k) 460 tp(nn, k) = tp1(i, k) 461 tvp(nn, k) = tvp1(i, k) 462 clw(nn, k) = clw1(i, k) 463 END IF 464 END DO 465 END DO 466 467 IF (nn/=ncum) THEN 468 WRITE (lunout, *) 'strange! nn not equal to ncum: ', nn, ncum 469 abort_message = '' 470 CALL abort_physic(modname, abort_message, 1) 471 END IF 472 443 473 nn = 0 444 474 DO i = 1, len 445 475 IF (iflag1(i)==0) THEN 446 476 nn = nn + 1 447 t(nn, k) = t1(i, k) 448 q(nn, k) = q1(i, k) 449 qs(nn, k) = qs1(i, k) 450 u(nn, k) = u1(i, k) 451 v(nn, k) = v1(i, k) 452 gz(nn, k) = gz1(i, k) 453 h(nn, k) = h1(i, k) 454 lv(nn, k) = lv1(i, k) 455 cpn(nn, k) = cpn1(i, k) 456 p(nn, k) = p1(i, k) 457 ph(nn, k) = ph1(i, k) 458 tv(nn, k) = tv1(i, k) 459 tp(nn, k) = tp1(i, k) 460 tvp(nn, k) = tvp1(i, k) 461 clw(nn, k) = clw1(i, k) 462 END IF 463 END DO 464 END DO 465 466 IF (nn/=ncum) THEN 467 WRITE (lunout, *) 'strange! nn not equal to ncum: ', nn, ncum 468 abort_message = '' 469 CALL abort_physic(modname, abort_message, 1) 470 END IF 471 472 nn = 0 473 DO i = 1, len 474 IF (iflag1(i)==0) THEN 475 nn = nn + 1 476 cbmf(nn) = cbmf1(i) 477 plcl(nn) = plcl1(i) 478 tnk(nn) = tnk1(i) 479 qnk(nn) = qnk1(i) 480 gznk(nn) = gznk1(i) 481 nk(nn) = nk1(i) 482 icb(nn) = icb1(i) 483 iflag(nn) = iflag1(i) 484 END IF 485 END DO 477 cbmf(nn) = cbmf1(i) 478 plcl(nn) = plcl1(i) 479 tnk(nn) = tnk1(i) 480 qnk(nn) = qnk1(i) 481 gznk(nn) = gznk1(i) 482 nk(nn) = nk1(i) 483 icb(nn) = icb1(i) 484 iflag(nn) = iflag1(i) 485 END IF 486 END DO 487 488 ELSE !compress 489 t(:, 1:nl+1) = t1(:, 1:nl+1) 490 q(:, 1:nl+1) = q1(:, 1:nl+1) 491 qs(:, 1:nl+1) = qs1(:, 1:nl+1) 492 u(:, 1:nl+1) = u1(:, 1:nl+1) 493 v(:, 1:nl+1) = v1(:, 1:nl+1) 494 gz(:, 1:nl+1) = gz1(:, 1:nl+1) 495 h(:, 1:nl+1) = h1(:, 1:nl+1) 496 lv(:, 1:nl+1) = lv1(:, 1:nl+1) 497 cpn(:, 1:nl+1) = cpn1(:, 1:nl+1) 498 p(:, 1:nl+1) = p1(:, 1:nl+1) 499 ph(:, 1:nl+1) = ph1(:, 1:nl+1) 500 tv(:, 1:nl+1) = tv1(:, 1:nl+1) 501 tp(:, 1:nl+1) = tp1(:, 1:nl+1) 502 tvp(:, 1:nl+1) = tvp1(:, 1:nl+1) 503 clw(:, 1:nl+1) = clw1(:, 1:nl+1) 504 505 cbmf(:) = cbmf1(:) 506 plcl(:) = plcl1(:) 507 tnk(:) = tnk1(:) 508 qnk(:) = qnk1(:) 509 gznk(:) = gznk1(:) 510 nk(:) = nk1(:) 511 icb(:) = icb1(:) 512 iflag(:) = iflag1(:) 513 ENDIF 486 514 487 515 DO k = 1, nl … … 1702 1730 END SUBROUTINE cv_yield 1703 1731 1704 SUBROUTINE cv_uncompress(nloc, len, ncum, nd, idcum, i flag, precip, cbmf, ft, &1732 SUBROUTINE cv_uncompress(nloc, len, ncum, nd, idcum, is_convect, compress, iflag, precip, cbmf, ft, & 1705 1733 fq, fu, fv, ma, qcondc, iflag1, precip1, cbmf1, ft1, fq1, fu1, fv1, ma1, & 1706 1734 qcondc1) … … 1712 1740 INTEGER len, ncum, nd, nloc 1713 1741 INTEGER idcum(nloc) 1742 LOGICAL is_convect(nloc) 1743 LOGICAL compress 1714 1744 INTEGER iflag(nloc) 1715 1745 REAL precip(nloc), cbmf(nloc) … … 1727 1757 ! local variables: 1728 1758 INTEGER i, k 1729 1730 DO i = 1, ncum 1731 precip1(idcum(i)) = precip(i) 1732 cbmf1(idcum(i)) = cbmf(i) 1733 iflag1(idcum(i)) = iflag(i) 1734 END DO 1735 1736 DO k = 1, nl 1759 1760 IF (compress) THEN 1737 1761 DO i = 1, ncum 1738 ft1(idcum(i), k) = ft(i, k) 1739 fq1(idcum(i), k) = fq(i, k) 1740 fu1(idcum(i), k) = fu(i, k) 1741 fv1(idcum(i), k) = fv(i, k) 1742 ma1(idcum(i), k) = ma(i, k) 1743 qcondc1(idcum(i), k) = qcondc(i, k) 1744 END DO 1745 END DO 1746 1762 precip1(idcum(i)) = precip(i) 1763 cbmf1(idcum(i)) = cbmf(i) 1764 iflag1(idcum(i)) = iflag(i) 1765 END DO 1766 1767 DO k = 1, nl 1768 DO i = 1, ncum 1769 ft1(idcum(i), k) = ft(i, k) 1770 fq1(idcum(i), k) = fq(i, k) 1771 fu1(idcum(i), k) = fu(i, k) 1772 fv1(idcum(i), k) = fv(i, k) 1773 ma1(idcum(i), k) = ma(i, k) 1774 qcondc1(idcum(i), k) = qcondc(i, k) 1775 END DO 1776 END DO 1777 ELSE 1778 DO i = 1, len 1779 IF (is_convect(i)) THEN 1780 precip1(i) = precip(i) 1781 cbmf1(i) = cbmf(i) 1782 iflag1(i) = iflag(i) 1783 ENDIF 1784 END DO 1785 1786 DO k = 1, nl 1787 DO i = 1, ncum 1788 IF (is_convect(i)) THEN 1789 ft1(i, k) = ft(i, k) 1790 fq1(i, k) = fq(i, k) 1791 fu1(i, k) = fu(i, k) 1792 fv1(i, k) = fv(i, k) 1793 ma1(i, k) = ma(i, k) 1794 qcondc1(i, k) = qcondc(i, k) 1795 ENDIF 1796 END DO 1797 END DO 1798 ENDIF 1747 1799 RETURN 1748 1800 END SUBROUTINE cv_uncompress -
LMDZ6/trunk/libf/phylmd/cva_driver.f90
r5699 r5712 6 6 LOGICAL, SAVE :: debut = .TRUE. 7 7 !$OMP THREADPRIVATE(debut) 8 LOGICAL, SAVE :: never_compress=.FALSE. ! if true, compression is desactivated in convection 9 !$OMP THREADPRIVATE(never_compress) 8 10 9 11 PUBLIC cva_driver_pre, cva_driver_post, cva_driver … … 32 34 ! -- set simulation flags: 33 35 ! (common cvflag) 36 never_compress = .FALSE. 37 CALL getin_p("convection_no_compression",never_compress) 38 IF (s2s_is_initialized()) never_compress = .TRUE. ! for GPU, compression must be disabled 34 39 CALL cv_flag(iflag_ice_thermo) 35 40 … … 624 629 625 630 INTEGER, PARAMETER :: igout=1 631 LOGICAL :: is_convect(len) ! is convection is active on column 626 632 627 633 ! print *, 't1, t1_wake ',(k,t1(1,k),t1_wake(1,k),k=1,nd) … … 878 884 ! gridpoints and the weights "coef_convective" (= 1. for convective gridpoints and = 0. 879 885 ! elsewhere). 880 ncum = 0881 coef_convective(:) = 0.882 886 DO i = 1, len 883 887 IF (iflag1(i)==0) THEN 884 888 coef_convective(i) = 1. 885 ncum = ncum + 1 886 idcum(ncum) = i 889 is_convect(i) = .TRUE. 890 ELSE 891 coef_convective(i) = 0. 892 is_convect(i) = .FALSE. 887 893 END IF 888 894 END DO 889 895 890 ! print*,'len, ncum = ',len,ncum 896 897 IF (never_compress) THEN 898 compress = .FALSE. 899 DO i = 1,len 900 idcum(i) = i 901 ENDDO 902 ncum=len 903 ELSE 904 ncum = 0 905 DO i = 1, len 906 IF (iflag1(i)==0) THEN 907 ncum = ncum + 1 908 idcum(ncum) = i 909 END IF 910 END DO 911 912 IF (ncum>0) THEN 913 ! If the fraction of convective points is larger than comp_threshold, then compression 914 ! is assumed useless. 915 compress = ncum .lt. len*comp_threshold 916 IF (.not. compress) THEN 917 DO i = 1,len 918 idcum(i) = i 919 ENDDO 920 ncum=len 921 ENDIF 922 ENDIF 923 924 ENDIF 891 925 892 926 IF (ncum>0) THEN … … 898 932 899 933 IF (iflag_con==3) THEN 900 ! print*,'ncum tv1 ',ncum,tv1 901 ! print*,'tvp1 ',tvp1 902 !jyg< 903 ! If the fraction of convective points is larger than comp_threshold, then compression 904 ! is assumed useless. 905 ! 906 compress = ncum .lt. len*comp_threshold 907 ! 908 IF (.not. compress) THEN 909 DO i = 1,len 910 idcum(i) = i 911 ENDDO 912 ENDIF 913 ! 914 !>jyg 915 if (prt_level >= 9) & 916 PRINT *, 'cva_driver -> cv3a_compress' 934 if (prt_level >= 9) PRINT *, 'cva_driver -> cv3a_compress' 917 935 CALL cv3a_compress(len, nloc, ncum, nd, ntra, compress, & 918 936 iflag1, nk1, icb1, icbs1, & … … 937 955 Ale, Alp, omega) 938 956 939 ! print*,'tv ',tv940 ! print*,'tvp ',tvp941 957 942 958 END IF 943 959 944 960 IF (iflag_con==4) THEN 945 if (prt_level >= 9) & 946 PRINT *, 'cva_driver -> cv_compress' 961 if (prt_level >= 9) PRINT *, 'cva_driver -> cv_compress' 947 962 CALL cv_compress(len, nloc, ncum, nd, & 948 iflag1, nk1, icb1, &963 iflag1, compress, nk1, icb1, & 949 964 cbmf1, plcl1, tnk1, qnk1, gznk1, & 950 965 t1, q1, qs1, u1, v1, gz1, & … … 1255 1270 if (prt_level >= 9) & 1256 1271 PRINT *, 'cva_driver -> cv3a_uncompress' 1257 CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, compress,&1272 CALL cv3a_uncompress(nloc, len, ncum, nd, ntra, idcum, is_convect, compress, & 1258 1273 iflag, icb, inb, & 1259 1274 precip, cbmf, plcl, plfc, wbeff, sig, w0, ptop2, & … … 1297 1312 if (prt_level >= 9) & 1298 1313 PRINT *, 'cva_driver -> cv_uncompress' 1299 CALL cv_uncompress(nloc, len, ncum, nd, idcum, &1314 CALL cv_uncompress(nloc, len, ncum, nd, idcum, is_convect, compress, & 1300 1315 iflag, & 1301 1316 precip, cbmf, & -
LMDZ6/trunk/libf/phylmd/s2s.F90
r5482 r5712 9 9 10 10 PRIVATE 11 PUBLIC s2s_initialize 11 PUBLIC s2s_initialize, s2s_is_initialized 12 12 13 13 CONTAINS … … 15 15 SUBROUTINE s2s_initialize() 16 16 END SUBROUTINE s2s_initialize 17 17 18 FUNCTION s2s_is_initialized() 19 IMPLICIT NONE 20 LOGICAL :: s2s_is_initialized 21 s2s_is_initialized=.FALSE. 22 END FUNCTION s2s_is_initialized 23 18 24 END MODULE s2s 19 25
Note: See TracChangeset
for help on using the changeset viewer.