Changeset 888 for palm/trunk/SOURCE/advec_ws.f90
- Timestamp:
- Apr 20, 2012 3:03:46 PM (12 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/advec_ws.f90 (modified) (62 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_ws.f90
r863 r888 4 4 ! Current revisions: 5 5 ! ------------------ 6 ! Number of IBITS() calls with identical arguments is reduced. 6 7 ! 7 8 ! Former revisions: … … 274 275 IMPLICIT NONE 275 276 276 INTEGER :: i, i_omp, j, k, k_mm, k_pp, k_ppp, tn 277 INTEGER :: i, ibit0, ibit1, ibit2, ibit3, ibit4, ibit5, ibit6, & 278 ibit7, ibit8, i_omp, j, k, k_mm, k_pp, k_ppp, tn 277 279 REAL :: diss_d, div, flux_d, u_comp, v_comp 278 280 REAL, DIMENSION(:,:,:), POINTER :: sk … … 293 295 DO k = nzb+1, nzb_max 294 296 297 ibit5 = IBITS(wall_flags_0(k,j,i),5,1) 298 ibit4 = IBITS(wall_flags_0(k,j,i),4,1) 299 ibit3 = IBITS(wall_flags_0(k,j,i),3,1) 300 295 301 v_comp = v(k,j,i) - v_gtrans 296 302 swap_flux_y_local(k,tn) = v_comp * ( & 297 ( 37.0 * IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &298 + 7.0 * IBITS(wall_flags_0(k,j,i),4,1)* adv_sca_3 &299 + IBITS(wall_flags_0(k,j,i),3,1)* adv_sca_1 &300 ) *&301 ( sk(k,j,i) + sk(k,j-1,i) )&302 - ( 8.0 * IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &303 + IBITS(wall_flags_0(k,j,i),4,1)* adv_sca_3 &304 ) *&305 ( sk(k,j+1,i) + sk(k,j-2,i) )&306 + ( IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &307 ) *&308 ( sk(k,j+2,i) + sk(k,j-3,i) )&303 ( 37.0 * ibit5 * adv_sca_5 & 304 + 7.0 * ibit4 * adv_sca_3 & 305 + ibit3 * adv_sca_1 & 306 ) * & 307 ( sk(k,j,i) + sk(k,j-1,i) ) & 308 - ( 8.0 * ibit5 * adv_sca_5 & 309 + ibit4 * adv_sca_3 & 310 ) * & 311 ( sk(k,j+1,i) + sk(k,j-2,i) ) & 312 + ( ibit5 * adv_sca_5 & 313 ) * & 314 ( sk(k,j+2,i) + sk(k,j-3,i) ) & 309 315 ) 310 316 311 317 swap_diss_y_local(k,tn) = -ABS( v_comp ) * ( & 312 ( 10.0 * IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &313 + 3.0 * IBITS(wall_flags_0(k,j,i),4,1)* adv_sca_3 &314 + IBITS(wall_flags_0(k,j,i),3,1)* adv_sca_1 &315 ) *&316 ( sk(k,j,i) - sk(k,j-1,i) )&317 - ( 5.0 * IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &318 + IBITS(wall_flags_0(k,j,i),4,1)* adv_sca_3 &319 ) *&320 ( sk(k,j+1,i) - sk(k,j-2,i) )&321 + ( IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &322 ) *&323 ( sk(k,j+2,i) - sk(k,j-3,i) )&318 ( 10.0 * ibit5 * adv_sca_5 & 319 + 3.0 * ibit4 * adv_sca_3 & 320 + ibit3 * adv_sca_1 & 321 ) * & 322 ( sk(k,j,i) - sk(k,j-1,i) ) & 323 - ( 5.0 * ibit5 * adv_sca_5 & 324 + ibit4 * adv_sca_3 & 325 ) * & 326 ( sk(k,j+1,i) - sk(k,j-2,i) ) & 327 + ( ibit5 * adv_sca_5 & 328 ) * & 329 ( sk(k,j+2,i) - sk(k,j-3,i) ) & 324 330 ) 325 331 … … 329 335 DO k = nzb_max+1, nzt 330 336 331 v_comp = v(k,j,i) - v_gtrans337 v_comp = v(k,j,i) - v_gtrans 332 338 swap_flux_y_local(k,tn) = v_comp * ( & 333 339 37.0 * ( sk(k,j,i) + sk(k,j-1,i) ) & … … 350 356 DO k = nzb+1, nzb_max 351 357 352 u_comp = u(k,j,i) - u_gtrans 358 ibit2 = IBITS(wall_flags_0(k,j,i),2,1) 359 ibit1 = IBITS(wall_flags_0(k,j,i),1,1) 360 ibit0 = IBITS(wall_flags_0(k,j,i),0,1) 361 362 u_comp = u(k,j,i) - u_gtrans 353 363 swap_flux_x_local(k,j,tn) = u_comp * ( & 354 ( 37.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5 & 355 + 7.0 * IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3 & 356 + IBITS(wall_flags_0(k,j,i),0,1) * adv_sca_1 & 357 ) * & 358 ( sk(k,j,i) + sk(k,j,i-1) ) & 359 - ( 8.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5 & 360 + IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3 & 361 ) * & 362 ( sk(k,j,i+1) + sk(k,j,i-2) ) & 363 + ( IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5 & 364 ) * ( sk(k,j,i+2) + sk(k,j,i-3) ) & 364 ( 37.0 * ibit2 * adv_sca_5 & 365 + 7.0 * ibit1 * adv_sca_3 & 366 + ibit0 * adv_sca_1 & 367 ) * & 368 ( sk(k,j,i) + sk(k,j,i-1) ) & 369 - ( 8.0 * ibit2 * adv_sca_5 & 370 + ibit1 * adv_sca_3 & 371 ) * & 372 ( sk(k,j,i+1) + sk(k,j,i-2) ) & 373 + ( ibit2 * adv_sca_5 & 374 ) * & 375 ( sk(k,j,i+2) + sk(k,j,i-3) ) & 365 376 ) 366 377 367 378 swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * ( & 368 ( 10.0 * IBITS(wall_flags_0(k,j,i),2,1)* adv_sca_5 &369 + 3.0 * IBITS(wall_flags_0(k,j,i),1,1)* adv_sca_3 &370 + IBITS(wall_flags_0(k,j,i),0,1)* adv_sca_1 &371 ) *&372 ( sk(k,j,i) - sk(k,j,i-1) )&373 - ( 5.0 * IBITS(wall_flags_0(k,j,i),2,1)* adv_sca_5 &374 + IBITS(wall_flags_0(k,j,i),1,1)* adv_sca_3 &375 ) *&376 ( sk(k,j,i+1) - sk(k,j,i-2) )&377 + ( IBITS(wall_flags_0(k,j,i),2,1)* adv_sca_5 &378 ) *&379 ( sk(k,j,i+2) - sk(k,j,i-3) )&379 ( 10.0 * ibit2 * adv_sca_5 & 380 + 3.0 * ibit1 * adv_sca_3 & 381 + ibit0 * adv_sca_1 & 382 ) * & 383 ( sk(k,j,i) - sk(k,j,i-1) ) & 384 - ( 5.0 * ibit2 * adv_sca_5 & 385 + ibit1 * adv_sca_3 & 386 ) * & 387 ( sk(k,j,i+1) - sk(k,j,i-2) ) & 388 + ( ibit2 * adv_sca_5 & 389 ) * & 390 ( sk(k,j,i+2) - sk(k,j,i-3) ) & 380 391 ) 381 392 … … 412 423 !-- Note: It is faster to conduct all multiplications explicitly, e.g. 413 424 !-- * adv_sca_5 ... than to determine a factor and multiplicate the 414 !-- flux at the end. Indeed, per loop the first requires 6 415 !-- multiplications more, but the the second requires 9 more internal 416 !-- calls of IBITS(). 425 !-- flux at the end. 426 427 ibit2 = IBITS(wall_flags_0(k,j,i),2,1) 428 ibit1 = IBITS(wall_flags_0(k,j,i),1,1) 429 ibit0 = IBITS(wall_flags_0(k,j,i),0,1) 430 417 431 u_comp = u(k,j,i+1) - u_gtrans 418 432 flux_r(k) = u_comp * ( & 419 ( 37.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&420 + 7.0 * IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3&421 + IBITS(wall_flags_0(k,j,i),0,1) * adv_sca_1&433 ( 37.0 * ibit2 * adv_sca_5 & 434 + 7.0 * ibit1 * adv_sca_3 & 435 + ibit0 * adv_sca_1 & 422 436 ) * & 423 437 ( sk(k,j,i+1) + sk(k,j,i) ) & 424 - ( 8.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&425 + IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3&438 - ( 8.0 * ibit2 * adv_sca_5 & 439 + ibit1 * adv_sca_3 & 426 440 ) * & 427 441 ( sk(k,j,i+2) + sk(k,j,i-1) ) & 428 + ( IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5 & 429 ) * ( sk(k,j,i+3) + sk(k,j,i-2) ) & 442 + ( ibit2 * adv_sca_5 & 443 ) * & 444 ( sk(k,j,i+3) + sk(k,j,i-2) ) & 430 445 ) 431 446 432 447 diss_r(k) = -ABS( u_comp ) * ( & 433 ( 10.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&434 + 3.0 * IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3&435 + IBITS(wall_flags_0(k,j,i),0,1) * adv_sca_1&448 ( 10.0 * ibit2 * adv_sca_5 & 449 + 3.0 * ibit1 * adv_sca_3 & 450 + ibit0 * adv_sca_1 & 436 451 ) * & 437 452 ( sk(k,j,i+1) - sk(k,j,i) ) & 438 - ( 5.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&439 + IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3&453 - ( 5.0 * ibit2 * adv_sca_5 & 454 + ibit1 * adv_sca_3 & 440 455 ) * & 441 456 ( sk(k,j,i+2) - sk(k,j,i-1) ) & 442 + ( IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&457 + ( ibit2 * adv_sca_5 & 443 458 ) * & 444 459 ( sk(k,j,i+3) - sk(k,j,i-2) ) & 445 460 ) 446 461 462 ibit5 = IBITS(wall_flags_0(k,j,i),5,1) 463 ibit4 = IBITS(wall_flags_0(k,j,i),4,1) 464 ibit3 = IBITS(wall_flags_0(k,j,i),3,1) 465 447 466 v_comp = v(k,j+1,i) - v_gtrans 448 467 flux_n(k) = v_comp * ( & 449 ( 37.0 * IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&450 + 7.0 * IBITS(wall_flags_0(k,j,i),4,1) * adv_sca_3&451 + IBITS(wall_flags_0(k,j,i),3,1) * adv_sca_1&468 ( 37.0 * ibit5 * adv_sca_5 & 469 + 7.0 * ibit4 * adv_sca_3 & 470 + ibit3 * adv_sca_1 & 452 471 ) * & 453 472 ( sk(k,j+1,i) + sk(k,j,i) ) & 454 - ( 8.0 * IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&455 + IBITS(wall_flags_0(k,j,i),4,1) * adv_sca_3&473 - ( 8.0 * ibit5 * adv_sca_5 & 474 + ibit4 * adv_sca_3 & 456 475 ) * & 457 476 ( sk(k,j+2,i) + sk(k,j-1,i) ) & 458 + ( IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&477 + ( ibit5 * adv_sca_5 & 459 478 ) * & 460 479 ( sk(k,j+3,i) + sk(k,j-2,i) ) & … … 462 481 463 482 diss_n(k) = -ABS( v_comp ) * ( & 464 ( 10.0 * IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&465 + 3.0 * IBITS(wall_flags_0(k,j,i),4,1) * adv_sca_3&466 + IBITS(wall_flags_0(k,j,i),3,1) * adv_sca_1&483 ( 10.0 * ibit5 * adv_sca_5 & 484 + 3.0 * ibit4 * adv_sca_3 & 485 + ibit3 * adv_sca_1 & 467 486 ) * & 468 487 ( sk(k,j+1,i) - sk(k,j,i) ) & 469 - ( 5.0 * IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&470 + IBITS(wall_flags_0(k,j,i),4,1) * adv_sca_3&488 - ( 5.0 * ibit5 * adv_sca_5 & 489 + ibit4 * adv_sca_3 & 471 490 ) * & 472 491 ( sk(k,j+2,i) - sk(k,j-1,i) ) & 473 + ( IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&492 + ( ibit5 * adv_sca_5 & 474 493 ) * & 475 494 ( sk(k,j+3,i) - sk(k,j-2,i) ) & … … 478 497 !-- k index has to be modified near bottom and top, else array 479 498 !-- subscripts will be exceeded. 480 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),8,1) 481 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),6,1) ) 482 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),8,1) 499 ibit8 = IBITS(wall_flags_0(k,j,i),8,1) 500 ibit7 = IBITS(wall_flags_0(k,j,i),7,1) 501 ibit6 = IBITS(wall_flags_0(k,j,i),6,1) 502 503 k_ppp = k + 3 * ibit8 504 k_pp = k + 2 * ( 1 - ibit6 ) 505 k_mm = k - 2 * ibit8 483 506 484 507 485 508 flux_t(k) = w(k,j,i) * ( & 486 ( 37.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&487 + 7.0 * IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&488 + IBITS(wall_flags_0(k,j,i),6,1) * adv_sca_1&509 ( 37.0 * ibit8 * adv_sca_5 & 510 + 7.0 * ibit7 * adv_sca_3 & 511 + ibit6 * adv_sca_1 & 489 512 ) * & 490 513 ( sk(k+1,j,i) + sk(k,j,i) ) & 491 - ( 8.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&492 + IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&514 - ( 8.0 * ibit8 * adv_sca_5 & 515 + ibit7 * adv_sca_3 & 493 516 ) * & 494 517 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 495 + ( IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&518 + ( ibit8 * adv_sca_5 & 496 519 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 497 520 ) 498 521 499 522 diss_t(k) = -ABS( w(k,j,i) ) * ( & 500 ( 10.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&501 + 3.0 * IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&502 + IBITS(wall_flags_0(k,j,i),6,1) * adv_sca_1&523 ( 10.0 * ibit8 * adv_sca_5 & 524 + 3.0 * ibit7 * adv_sca_3 & 525 + ibit6 * adv_sca_1 & 503 526 ) * & 504 527 ( sk(k+1,j,i) - sk(k,j,i) ) & 505 - ( 5.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&506 + IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&528 - ( 5.0 * ibit8 * adv_sca_5 & 529 + ibit7 * adv_sca_3 & 507 530 ) * & 508 531 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 509 + ( IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&532 + ( ibit8 * adv_sca_5 & 510 533 ) * & 511 534 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & … … 564 587 !-- k index has to be modified near bottom and top, else array 565 588 !-- subscripts will be exceeded. 566 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),8,1) 567 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),6,1) ) 568 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),8,1) 589 ibit8 = IBITS(wall_flags_0(k,j,i),8,1) 590 ibit7 = IBITS(wall_flags_0(k,j,i),7,1) 591 ibit6 = IBITS(wall_flags_0(k,j,i),6,1) 592 593 k_ppp = k + 3 * ibit8 594 k_pp = k + 2 * ( 1 - ibit6 ) 595 k_mm = k - 2 * ibit8 596 569 597 570 598 flux_t(k) = w(k,j,i) * ( & 571 ( 37.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&572 + 7.0 * IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&573 + IBITS(wall_flags_0(k,j,i),6,1) * adv_sca_1&599 ( 37.0 * ibit8 * adv_sca_5 & 600 + 7.0 * ibit7 * adv_sca_3 & 601 + ibit6 * adv_sca_1 & 574 602 ) * & 575 603 ( sk(k+1,j,i) + sk(k,j,i) ) & 576 - ( 8.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&577 + IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&604 - ( 8.0 * ibit8 * adv_sca_5 & 605 + ibit7 * adv_sca_3 & 578 606 ) * & 579 607 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 580 + ( IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&608 + ( ibit8 * adv_sca_5 & 581 609 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 582 610 ) 583 611 584 612 diss_t(k) = -ABS( w(k,j,i) ) * ( & 585 ( 10.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&586 + 3.0 * IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&587 + IBITS(wall_flags_0(k,j,i),6,1) * adv_sca_1&613 ( 10.0 * ibit8 * adv_sca_5 & 614 + 3.0 * ibit7 * adv_sca_3 & 615 + ibit6 * adv_sca_1 & 588 616 ) * & 589 617 ( sk(k+1,j,i) - sk(k,j,i) ) & 590 - ( 5.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&591 + IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&618 - ( 5.0 * ibit8 * adv_sca_5 & 619 + ibit7 * adv_sca_3 & 592 620 ) * & 593 621 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 594 + ( IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&622 + ( ibit8 * adv_sca_5 & 595 623 ) * & 596 624 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & … … 671 699 IMPLICIT NONE 672 700 673 INTEGER :: i, i_omp, j, k, k_mm, k_pp, k_ppp, tn 701 INTEGER :: i, ibit9, ibit10, ibit11, ibit12, ibit13, ibit14, ibit15, & 702 ibit16, ibit17, i_omp, j, k, k_mm, k_pp, k_ppp, tn 674 703 REAL :: diss_d, div, flux_d, gu, gv, u_comp_l, v_comp, w_comp 675 704 REAL, DIMENSION(nzb:nzt+1) :: diss_n, diss_r, diss_t, flux_n, flux_r, & … … 684 713 DO k = nzb+1, nzb_max 685 714 715 ibit14 = IBITS(wall_flags_0(k,j,i),14,1) 716 ibit13 = IBITS(wall_flags_0(k,j,i),13,1) 717 ibit12 = IBITS(wall_flags_0(k,j,i),12,1) 718 686 719 v_comp = v(k,j,i) + v(k,j,i-1) - gv 687 720 flux_s_u(k,tn) = v_comp * ( & 688 ( 37.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&689 + 7.0 * IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&690 + IBITS(wall_flags_0(k,j,i),12,1) * adv_mom_1&691 ) *&721 ( 37.0 * ibit14 * adv_mom_5 & 722 + 7.0 * ibit13 * adv_mom_3 & 723 + ibit12 * adv_mom_1 & 724 ) * & 692 725 ( u(k,j,i) + u(k,j-1,i) ) & 693 - ( 8.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&694 + IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&695 ) *&726 - ( 8.0 * ibit14 * adv_mom_5 & 727 + ibit13 * adv_mom_3 & 728 ) * & 696 729 ( u(k,j+1,i) + u(k,j-2,i) ) & 697 + ( IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&698 ) *&730 + ( ibit14 * adv_mom_5 & 731 ) * & 699 732 ( u(k,j+2,i) + u(k,j-3,i) ) & 700 733 ) 701 734 702 735 diss_s_u(k,tn) = - ABS ( v_comp ) * ( & 703 ( 10.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&704 + 3.0 * IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&705 + IBITS(wall_flags_0(k,j,i),12,1) * adv_mom_1&706 ) *&736 ( 10.0 * ibit14 * adv_mom_5 & 737 + 3.0 * ibit13 * adv_mom_3 & 738 + ibit12 * adv_mom_1 & 739 ) * & 707 740 ( u(k,j,i) - u(k,j-1,i) ) & 708 - ( 5.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&709 + IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&710 ) *&741 - ( 5.0 * ibit14 * adv_mom_5 & 742 + ibit13 * adv_mom_3 & 743 ) * & 711 744 ( u(k,j+1,i) - u(k,j-2,i) ) & 712 + ( IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&713 ) *&745 + ( ibit14 * adv_mom_5 & 746 ) * & 714 747 ( u(k,j+2,i) - u(k,j-3,i) ) & 715 748 ) … … 738 771 DO k = nzb+1, nzb_max 739 772 773 ibit11 = IBITS(wall_flags_0(k,j,i),11,1) 774 ibit10 = IBITS(wall_flags_0(k,j,i),10,1) 775 ibit9 = IBITS(wall_flags_0(k,j,i),9,1) 776 740 777 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu 741 778 flux_l_u(k,j,tn) = u_comp_l * ( & 742 ( 37.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&743 + 7.0 * IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&744 + IBITS(wall_flags_0(k,j,i),9,1) * adv_mom_1&745 ) *&779 ( 37.0 * ibit11 * adv_mom_5 & 780 + 7.0 * ibit10 * adv_mom_3 & 781 + ibit9 * adv_mom_1 & 782 ) * & 746 783 ( u(k,j,i) + u(k,j,i-1) ) & 747 - ( 8.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&748 + IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&749 ) *&784 - ( 8.0 * ibit11 * adv_mom_5 & 785 + ibit10 * adv_mom_3 & 786 ) * & 750 787 ( u(k,j,i+1) + u(k,j,i-2) ) & 751 + ( IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&752 ) *&788 + ( ibit11 * adv_mom_5 & 789 ) * & 753 790 ( u(k,j,i+2) + u(k,j,i-3) ) & 754 791 ) 755 792 756 793 diss_l_u(k,j,tn) = - ABS( u_comp_l ) * ( & 757 ( 10.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&758 + 3.0 * IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&759 + IBITS(wall_flags_0(k,j,i),9,1) * adv_mom_1&760 ) *&794 ( 10.0 * ibit11 * adv_mom_5 & 795 + 3.0 * ibit10 * adv_mom_3 & 796 + ibit9 * adv_mom_1 & 797 ) * & 761 798 ( u(k,j,i) - u(k,j,i-1) ) & 762 - ( 5.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&763 + IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&764 ) *&799 - ( 5.0 * ibit11 * adv_mom_5 & 800 + ibit10 * adv_mom_3 & 801 ) * & 765 802 ( u(k,j,i+1) - u(k,j,i-2) ) & 766 + ( IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&767 ) *&803 + ( ibit11 * adv_mom_5 & 804 ) * & 768 805 ( u(k,j,i+2) - u(k,j,i-3) ) & 769 806 ) … … 796 833 DO k = nzb+1, nzb_max 797 834 835 ibit11 = IBITS(wall_flags_0(k,j,i),11,1) 836 ibit10 = IBITS(wall_flags_0(k,j,i),10,1) 837 ibit9 = IBITS(wall_flags_0(k,j,i),9,1) 838 798 839 u_comp(k) = u(k,j,i+1) + u(k,j,i) 799 840 flux_r(k) = ( u_comp(k) - gu ) * ( & 800 ( 37.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&801 + 7.0 * IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&802 + IBITS(wall_flags_0(k,j,i),9,1) * adv_mom_1&841 ( 37.0 * ibit11 * adv_mom_5 & 842 + 7.0 * ibit10 * adv_mom_3 & 843 + ibit9 * adv_mom_1 & 803 844 ) * & 804 845 ( u(k,j,i+1) + u(k,j,i) ) & 805 - ( 8.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&806 + IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&846 - ( 8.0 * ibit11 * adv_mom_5 & 847 + ibit10 * adv_mom_3 & 807 848 ) * & 808 849 ( u(k,j,i+2) + u(k,j,i-1) ) & 809 + ( IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&850 + ( ibit11 * adv_mom_5 & 810 851 ) * & 811 852 ( u(k,j,i+3) + u(k,j,i-2) ) & … … 813 854 814 855 diss_r(k) = - ABS( u_comp(k) - gu ) * ( & 815 ( 10.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&816 + 3.0 * IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&817 + IBITS(wall_flags_0(k,j,i),9,1) * adv_mom_1&856 ( 10.0 * ibit11 * adv_mom_5 & 857 + 3.0 * ibit10 * adv_mom_3 & 858 + ibit9 * adv_mom_1 & 818 859 ) * & 819 860 ( u(k,j,i+1) - u(k,j,i) ) & 820 - ( 5.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&821 + IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&861 - ( 5.0 * ibit11 * adv_mom_5 & 862 + ibit10 * adv_mom_3 & 822 863 ) * & 823 864 ( u(k,j,i+2) - u(k,j,i-1) ) & 824 + ( IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&865 + ( ibit11 * adv_mom_5 & 825 866 ) * & 826 867 ( u(k,j,i+3) - u(k,j,i-2) ) & 827 868 ) 828 869 870 ibit14 = IBITS(wall_flags_0(k,j,i),14,1) 871 ibit13 = IBITS(wall_flags_0(k,j,i),13,1) 872 ibit12 = IBITS(wall_flags_0(k,j,i),12,1) 873 829 874 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 830 875 flux_n(k) = v_comp * ( & 831 ( 37.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&832 + 7.0 * IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&833 + IBITS(wall_flags_0(k,j,i),12,1) * adv_mom_1&876 ( 37.0 * ibit14 * adv_mom_5 & 877 + 7.0 * ibit13 * adv_mom_3 & 878 + ibit12 * adv_mom_1 & 834 879 ) * & 835 880 ( u(k,j+1,i) + u(k,j,i) ) & 836 - ( 8.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&837 + IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&881 - ( 8.0 * ibit14 * adv_mom_5 & 882 + ibit13 * adv_mom_3 & 838 883 ) * & 839 884 ( u(k,j+2,i) + u(k,j-1,i) ) & 840 + ( IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&885 + ( ibit14 * adv_mom_5 & 841 886 ) * & 842 887 ( u(k,j+3,i) + u(k,j-2,i) ) & 843 888 ) 844 889 845 890 diss_n(k) = - ABS ( v_comp ) * ( & 846 ( 10.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&847 + 3.0 * IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&848 + IBITS(wall_flags_0(k,j,i),12,1) * adv_mom_1&891 ( 10.0 * ibit14 * adv_mom_5 & 892 + 3.0 * ibit13 * adv_mom_3 & 893 + ibit12 * adv_mom_1 & 849 894 ) * & 850 895 ( u(k,j+1,i) - u(k,j,i) ) & 851 - ( 5.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&852 + IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&896 - ( 5.0 * ibit14 * adv_mom_5 & 897 + ibit13 * adv_mom_3 & 853 898 ) * & 854 899 ( u(k,j+2,i) - u(k,j-1,i) ) & 855 + ( IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&900 + ( ibit14 * adv_mom_5 & 856 901 ) * & 857 902 ( u(k,j+3,i) - u(k,j-2,i) ) & 858 903 ) 859 904 ! 860 905 !-- k index has to be modified near bottom and top, else array 861 906 !-- subscripts will be exceeded. 862 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),17,1) 863 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),15,1) ) 864 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),17,1) 907 ibit17 = IBITS(wall_flags_0(k,j,i),17,1) 908 ibit16 = IBITS(wall_flags_0(k,j,i),16,1) 909 ibit15 = IBITS(wall_flags_0(k,j,i),15,1) 910 911 k_ppp = k + 3 * ibit17 912 k_pp = k + 2 * ( 1 - ibit15 ) 913 k_mm = k - 2 * ibit17 865 914 866 915 w_comp = w(k,j,i) + w(k,j,i-1) 867 916 flux_t(k) = w_comp * ( & 868 ( 37.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&869 + 7.0 * IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&870 + IBITS(wall_flags_0(k,j,i),15,1) * adv_mom_1&917 ( 37.0 * ibit17 * adv_mom_5 & 918 + 7.0 * ibit16 * adv_mom_3 & 919 + ibit15 * adv_mom_1 & 871 920 ) * & 872 921 ( u(k+1,j,i) + u(k,j,i) ) & 873 - ( 8.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&874 + IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&922 - ( 8.0 * ibit17 * adv_mom_5 & 923 + ibit16 * adv_mom_3 & 875 924 ) * & 876 925 ( u(k_pp,j,i) + u(k-1,j,i) ) & 877 + ( IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&926 + ( ibit17 * adv_mom_5 & 878 927 ) * & 879 928 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & … … 881 930 882 931 diss_t(k) = - ABS( w_comp ) * ( & 883 ( 10.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&884 + 3.0 * IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&885 + IBITS(wall_flags_0(k,j,i),15,1) * adv_mom_1&932 ( 10.0 * ibit17 * adv_mom_5 & 933 + 3.0 * ibit16 * adv_mom_3 & 934 + ibit15 * adv_mom_1 & 886 935 ) * & 887 936 ( u(k+1,j,i) - u(k,j,i) ) & 888 - ( 5.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&889 + IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&937 - ( 5.0 * ibit17 * adv_mom_5 & 938 + ibit16 * adv_mom_3 & 890 939 ) * & 891 940 ( u(k_pp,j,i) - u(k-1,j,i) ) & 892 + ( IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&941 + ( ibit17 * adv_mom_5 & 893 942 ) * & 894 943 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & … … 960 1009 !-- k index has to be modified near bottom and top, else array 961 1010 !-- subscripts will be exceeded. 962 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),17,1) 963 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),15,1) ) 964 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),17,1) 1011 ibit17 = IBITS(wall_flags_0(k,j,i),17,1) 1012 ibit16 = IBITS(wall_flags_0(k,j,i),16,1) 1013 ibit15 = IBITS(wall_flags_0(k,j,i),15,1) 1014 1015 k_ppp = k + 3 * ibit17 1016 k_pp = k + 2 * ( 1 - ibit15 ) 1017 k_mm = k - 2 * ibit17 965 1018 966 1019 w_comp = w(k,j,i) + w(k,j,i-1) 967 1020 flux_t(k) = w_comp * ( & 968 ( 37.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&969 + 7.0 * IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&970 + IBITS(wall_flags_0(k,j,i),15,1) * adv_mom_1&1021 ( 37.0 * ibit17 * adv_mom_5 & 1022 + 7.0 * ibit16 * adv_mom_3 & 1023 + ibit15 * adv_mom_1 & 971 1024 ) * & 972 1025 ( u(k+1,j,i) + u(k,j,i) ) & 973 - ( 8.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&974 + IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&1026 - ( 8.0 * ibit17 * adv_mom_5 & 1027 + ibit16 * adv_mom_3 & 975 1028 ) * & 976 1029 ( u(k_pp,j,i) + u(k-1,j,i) ) & 977 + ( IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&1030 + ( ibit17 * adv_mom_5 & 978 1031 ) * & 979 1032 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & … … 981 1034 982 1035 diss_t(k) = - ABS( w_comp ) * ( & 983 ( 10.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&984 + 3.0 * IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&985 + IBITS(wall_flags_0(k,j,i),15,1) * adv_mom_1&1036 ( 10.0 * ibit17 * adv_mom_5 & 1037 + 3.0 * ibit16 * adv_mom_3 & 1038 + ibit15 * adv_mom_1 & 986 1039 ) * & 987 1040 ( u(k+1,j,i) - u(k,j,i) ) & 988 - ( 5.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&989 + IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&1041 - ( 5.0 * ibit17 * adv_mom_5 & 1042 + ibit16 * adv_mom_3 & 990 1043 ) * & 991 1044 ( u(k_pp,j,i) - u(k-1,j,i) ) & 992 + ( IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&1045 + ( ibit17 * adv_mom_5 & 993 1046 ) * & 994 1047 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & … … 1058 1111 IMPLICIT NONE 1059 1112 1060 INTEGER :: i, i_omp, j, k, k_mm, k_pp, k_ppp, tn 1113 INTEGER :: i, ibit18, ibit19, ibit20, ibit21, ibit22, ibit23, ibit24, & 1114 ibit25, ibit26, i_omp, j, k, k_mm, k_pp, k_ppp, tn 1061 1115 REAL :: diss_d, div, flux_d, gu, gv, u_comp, v_comp_l, w_comp 1062 1116 REAL, DIMENSION(nzb:nzt+1) :: diss_n, diss_r, diss_t, flux_n, flux_r, & … … 1072 1126 DO k = nzb+1, nzb_max 1073 1127 1128 ibit20 = IBITS(wall_flags_0(k,j,i),20,1) 1129 ibit19 = IBITS(wall_flags_0(k,j,i),19,1) 1130 ibit18 = IBITS(wall_flags_0(k,j,i),18,1) 1131 1074 1132 u_comp = u(k,j-1,i) + u(k,j,i) - gu 1075 1133 flux_l_v(k,j,tn) = u_comp * ( & 1076 ( 37.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1077 + 7.0 * IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&1078 + IBITS(wall_flags_0(k,j,i),18,1) * adv_mom_1&1079 ) *&1134 ( 37.0 * ibit20 * adv_mom_5 & 1135 + 7.0 * ibit19 * adv_mom_3 & 1136 + ibit18 * adv_mom_1 & 1137 ) * & 1080 1138 ( v(k,j,i) + v(k,j,i-1) ) & 1081 - ( 8.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1082 + IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&1083 ) *&1139 - ( 8.0 * ibit20 * adv_mom_5 & 1140 + ibit19 * adv_mom_3 & 1141 ) * & 1084 1142 ( v(k,j,i+1) + v(k,j,i-2) ) & 1085 + ( IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1086 ) *&1143 + ( ibit20 * adv_mom_5 & 1144 ) * & 1087 1145 ( v(k,j,i+2) + v(k,j,i-3) ) & 1088 1146 ) 1089 1147 1090 1148 diss_l_v(k,j,tn) = - ABS( u_comp ) * ( & 1091 ( 10.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1092 + 3.0 * IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&1093 + IBITS(wall_flags_0(k,j,i),18,1) * adv_mom_1&1094 ) *&1149 ( 10.0 * ibit20 * adv_mom_5 & 1150 + 3.0 * ibit19 * adv_mom_3 & 1151 + ibit18 * adv_mom_1 & 1152 ) * & 1095 1153 ( v(k,j,i) - v(k,j,i-1) ) & 1096 - ( 5.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1097 + IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&1098 ) *&1154 - ( 5.0 * ibit20 * adv_mom_5 & 1155 + ibit19 * adv_mom_3 & 1156 ) * & 1099 1157 ( v(k,j,i+1) - v(k,j,i-2) ) & 1100 + ( IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1101 ) *&1158 + ( ibit20 * adv_mom_5 & 1159 ) * & 1102 1160 ( v(k,j,i+2) - v(k,j,i-3) ) & 1103 1161 ) … … 1126 1184 DO k = nzb+1, nzb_max 1127 1185 1186 ibit23 = IBITS(wall_flags_0(k,j,i),23,1) 1187 ibit22 = IBITS(wall_flags_0(k,j,i),22,1) 1188 ibit21 = IBITS(wall_flags_0(k,j,i),21,1) 1189 1128 1190 v_comp_l = v(k,j,i) + v(k,j-1,i) - gv 1129 1191 flux_s_v(k,tn) = v_comp_l * ( & 1130 ( 37.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1131 + 7.0 * IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&1132 + IBITS(wall_flags_0(k,j,i),21,1) * adv_mom_1&1133 ) *&1192 ( 37.0 * ibit23 * adv_mom_5 & 1193 + 7.0 * ibit22 * adv_mom_3 & 1194 + ibit21 * adv_mom_1 & 1195 ) * & 1134 1196 ( v(k,j,i) + v(k,j-1,i) ) & 1135 - ( 8.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1136 + IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&1137 ) *&1197 - ( 8.0 * ibit23 * adv_mom_5 & 1198 + ibit22 * adv_mom_3 & 1199 ) * & 1138 1200 ( v(k,j+1,i) + v(k,j-2,i) ) & 1139 + ( IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1140 ) *&1201 + ( ibit23 * adv_mom_5 & 1202 ) * & 1141 1203 ( v(k,j+2,i) + v(k,j-3,i) ) & 1142 1204 ) 1143 1205 1144 1206 diss_s_v(k,tn) = - ABS( v_comp_l ) * ( & 1145 ( 10.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1146 + 3.0 * IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&1147 + IBITS(wall_flags_0(k,j,i),21,1) * adv_mom_1&1148 ) *&1207 ( 10.0 * ibit23 * adv_mom_5 & 1208 + 3.0 * ibit22 * adv_mom_3 & 1209 + ibit21 * adv_mom_1 & 1210 ) * & 1149 1211 ( v(k,j,i) - v(k,j-1,i) ) & 1150 - ( 5.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1151 + IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&1152 ) *&1212 - ( 5.0 * ibit23 * adv_mom_5 & 1213 + ibit22 * adv_mom_3 & 1214 ) * & 1153 1215 ( v(k,j+1,i) - v(k,j-2,i) ) & 1154 + ( IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1155 ) *&1216 + ( ibit23 * adv_mom_5 & 1217 ) * & 1156 1218 ( v(k,j+2,i) - v(k,j-3,i) ) & 1157 1219 ) … … 1184 1246 DO k = nzb+1, nzb_max 1185 1247 1248 ibit20 = IBITS(wall_flags_0(k,j,i),20,1) 1249 ibit19 = IBITS(wall_flags_0(k,j,i),19,1) 1250 ibit18 = IBITS(wall_flags_0(k,j,i),18,1) 1251 1186 1252 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 1187 1253 flux_r(k) = u_comp * ( & 1188 ( 37.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1189 + 7.0 * IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&1190 + IBITS(wall_flags_0(k,j,i),18,1) * adv_mom_1&1254 ( 37.0 * ibit20 * adv_mom_5 & 1255 + 7.0 * ibit19 * adv_mom_3 & 1256 + ibit18 * adv_mom_1 & 1191 1257 ) * & 1192 1258 ( v(k,j,i+1) + v(k,j,i) ) & 1193 - ( 8.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1194 + IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&1259 - ( 8.0 * ibit20 * adv_mom_5 & 1260 + ibit19 * adv_mom_3 & 1195 1261 ) * & 1196 1262 ( v(k,j,i+2) + v(k,j,i-1) ) & 1197 + ( IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1263 + ( ibit20 * adv_mom_5 & 1198 1264 ) * & 1199 1265 ( v(k,j,i+3) + v(k,j,i-2) ) & … … 1201 1267 1202 1268 diss_r(k) = - ABS( u_comp ) * ( & 1203 ( 10.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1204 + 3.0 * IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&1205 + IBITS(wall_flags_0(k,j,i),18,1) * adv_mom_1&1269 ( 10.0 * ibit20 * adv_mom_5 & 1270 + 3.0 * ibit19 * adv_mom_3 & 1271 + ibit18 * adv_mom_1 & 1206 1272 ) * & 1207 1273 ( v(k,j,i+1) - v(k,j,i) ) & 1208 - ( 5.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1209 + IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&1274 - ( 5.0 * ibit20 * adv_mom_5 & 1275 + ibit19 * adv_mom_3 & 1210 1276 ) * & 1211 1277 ( v(k,j,i+2) - v(k,j,i-1) ) & 1212 + ( IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&1278 + ( ibit20 * adv_mom_5 & 1213 1279 ) * & 1214 1280 ( v(k,j,i+3) - v(k,j,i-2) ) & 1215 1281 ) 1216 1282 1283 ibit23 = IBITS(wall_flags_0(k,j,i),23,1) 1284 ibit22 = IBITS(wall_flags_0(k,j,i),22,1) 1285 ibit21 = IBITS(wall_flags_0(k,j,i),21,1) 1286 1287 1217 1288 v_comp(k) = v(k,j+1,i) + v(k,j,i) 1218 1289 flux_n(k) = ( v_comp(k) - gv ) * ( & 1219 ( 37.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1220 + 7.0 * IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&1221 + IBITS(wall_flags_0(k,j,i),21,1) * adv_mom_1&1290 ( 37.0 * ibit23 * adv_mom_5 & 1291 + 7.0 * ibit22 * adv_mom_3 & 1292 + ibit21 * adv_mom_1 & 1222 1293 ) * & 1223 1294 ( v(k,j+1,i) + v(k,j,i) ) & 1224 - ( 8.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1225 + IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&1295 - ( 8.0 * ibit23 * adv_mom_5 & 1296 + ibit22 * adv_mom_3 & 1226 1297 ) * & 1227 1298 ( v(k,j+2,i) + v(k,j-1,i) ) & 1228 + ( IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1299 + ( ibit23 * adv_mom_5 & 1229 1300 ) * & 1230 1301 ( v(k,j+3,i) + v(k,j-2,i) ) & … … 1232 1303 1233 1304 diss_n(k) = - ABS( v_comp(k) - gv ) * ( & 1234 ( 10.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1235 + 3.0 * IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&1236 + IBITS(wall_flags_0(k,j,i),21,1) * adv_mom_1&1305 ( 10.0 * ibit23 * adv_mom_5 & 1306 + 3.0 * ibit22 * adv_mom_3 & 1307 + ibit21 * adv_mom_1 & 1237 1308 ) * & 1238 1309 ( v(k,j+1,i) - v(k,j,i) ) & 1239 - ( 5.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1240 + IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&1310 - ( 5.0 * ibit23 * adv_mom_5 & 1311 + ibit22 * adv_mom_3 & 1241 1312 ) * & 1242 1313 ( v(k,j+2,i) - v(k,j-1,i) ) & 1243 + ( IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&1314 + ( ibit23 * adv_mom_5 & 1244 1315 ) * & 1245 1316 ( v(k,j+3,i) - v(k,j-2,i) ) & … … 1248 1319 !-- k index has to be modified near bottom and top, else array 1249 1320 !-- subscripts will be exceeded. 1250 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),26,1) 1251 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),24,1) ) 1252 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),26,1) 1321 ibit26 = IBITS(wall_flags_0(k,j,i),26,1) 1322 ibit25 = IBITS(wall_flags_0(k,j,i),25,1) 1323 ibit24 = IBITS(wall_flags_0(k,j,i),24,1) 1324 1325 k_ppp = k + 3 * ibit26 1326 k_pp = k + 2 * ( 1 - ibit24 ) 1327 k_mm = k - 2 * ibit26 1253 1328 1254 1329 w_comp = w(k,j-1,i) + w(k,j,i) 1255 1330 flux_t(k) = w_comp * ( & 1256 ( 37.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1257 + 7.0 * IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&1258 + IBITS(wall_flags_0(k,j,i),24,1) * adv_mom_1&1331 ( 37.0 * ibit26 * adv_mom_5 & 1332 + 7.0 * ibit25 * adv_mom_3 & 1333 + ibit24 * adv_mom_1 & 1259 1334 ) * & 1260 1335 ( v(k+1,j,i) + v(k,j,i) ) & 1261 - ( 8.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1262 + IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&1336 - ( 8.0 * ibit26 * adv_mom_5 & 1337 + ibit25 * adv_mom_3 & 1263 1338 ) * & 1264 1339 ( v(k_pp,j,i) + v(k-1,j,i) ) & 1265 + ( IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1340 + ( ibit26 * adv_mom_5 & 1266 1341 ) * & 1267 1342 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & … … 1269 1344 1270 1345 diss_t(k) = - ABS( w_comp ) * ( & 1271 ( 10.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1272 + 3.0 * IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&1273 + IBITS(wall_flags_0(k,j,i),24,1) * adv_mom_1&1346 ( 10.0 * ibit26 * adv_mom_5 & 1347 + 3.0 * ibit25 * adv_mom_3 & 1348 + ibit24 * adv_mom_1 & 1274 1349 ) * & 1275 1350 ( v(k+1,j,i) - v(k,j,i) ) & 1276 - ( 5.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1277 + IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&1351 - ( 5.0 * ibit26 * adv_mom_5 & 1352 + ibit25 * adv_mom_3 & 1278 1353 ) * & 1279 1354 ( v(k_pp,j,i) - v(k-1,j,i) ) & 1280 + ( IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1355 + ( ibit26 * adv_mom_5 & 1281 1356 ) * & 1282 1357 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & … … 1353 1428 !-- k index has to be modified near bottom and top, else array 1354 1429 !-- subscripts will be exceeded. 1355 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),26,1) 1356 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),24,1) ) 1357 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),26,1) 1430 ibit26 = IBITS(wall_flags_0(k,j,i),26,1) 1431 ibit25 = IBITS(wall_flags_0(k,j,i),25,1) 1432 ibit24 = IBITS(wall_flags_0(k,j,i),24,1) 1433 1434 k_ppp = k + 3 * ibit26 1435 k_pp = k + 2 * ( 1 - ibit24 ) 1436 k_mm = k - 2 * ibit26 1358 1437 1359 1438 w_comp = w(k,j-1,i) + w(k,j,i) 1360 1439 flux_t(k) = w_comp * ( & 1361 ( 37.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1362 + 7.0 * IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&1363 + IBITS(wall_flags_0(k,j,i),24,1) * adv_mom_1&1440 ( 37.0 * ibit26 * adv_mom_5 & 1441 + 7.0 * ibit25 * adv_mom_3 & 1442 + ibit24 * adv_mom_1 & 1364 1443 ) * & 1365 1444 ( v(k+1,j,i) + v(k,j,i) ) & 1366 - ( 8.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1367 + IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&1445 - ( 8.0 * ibit26 * adv_mom_5 & 1446 + ibit25 * adv_mom_3 & 1368 1447 ) * & 1369 1448 ( v(k_pp,j,i) + v(k-1,j,i) ) & 1370 + ( IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1449 + ( ibit26 * adv_mom_5 & 1371 1450 ) * & 1372 1451 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & … … 1374 1453 1375 1454 diss_t(k) = - ABS( w_comp ) * ( & 1376 ( 10.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1377 + 3.0 * IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&1378 + IBITS(wall_flags_0(k,j,i),24,1) * adv_mom_1&1455 ( 10.0 * ibit26 * adv_mom_5 & 1456 + 3.0 * ibit25 * adv_mom_3 & 1457 + ibit24 * adv_mom_1 & 1379 1458 ) * & 1380 1459 ( v(k+1,j,i) - v(k,j,i) ) & 1381 - ( 5.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1382 + IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&1460 - ( 5.0 * ibit26 * adv_mom_5 & 1461 + ibit25 * adv_mom_3 & 1383 1462 ) * & 1384 1463 ( v(k_pp,j,i) - v(k-1,j,i) ) & 1385 + ( IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&1464 + ( ibit26 * adv_mom_5 & 1386 1465 ) * & 1387 1466 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & … … 1451 1530 IMPLICIT NONE 1452 1531 1453 INTEGER :: i, i_omp, j, k, k_mm, k_pp, k_ppp, tn 1532 INTEGER :: i, ibit27, ibit28, ibit29, ibit30, ibit31, ibit32, ibit33, & 1533 ibit34, ibit35, i_omp, j, k, k_mm, k_pp, k_ppp, tn 1454 1534 REAL :: diss_d, div, flux_d, gu, gv, u_comp, v_comp, w_comp 1455 1535 REAL, DIMENSION(nzb:nzt+1) :: diss_n, diss_r, diss_t, flux_n, flux_r, & … … 1464 1544 1465 1545 DO k = nzb+1, nzb_max 1546 ibit32 = IBITS(wall_flags_0(k,j,i),32,1) 1547 ibit31 = IBITS(wall_flags_0(k,j,i),31,1) 1548 ibit30 = IBITS(wall_flags_0(k,j,i),30,1) 1466 1549 1467 1550 v_comp = v(k+1,j,i) + v(k,j,i) - gv 1468 1551 flux_s_w(k,tn) = v_comp * ( & 1469 ( 37.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1470 + 7.0 * IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&1471 + IBITS(wall_flags_0(k,j,i),30,1) * adv_mom_1&1472 ) *&1552 ( 37.0 * ibit32 * adv_mom_5 & 1553 + 7.0 * ibit31 * adv_mom_3 & 1554 + ibit30 * adv_mom_1 & 1555 ) * & 1473 1556 ( w(k,j,i) + w(k,j-1,i) ) & 1474 - ( 8.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1475 + IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&1476 ) *&1557 - ( 8.0 * ibit32 * adv_mom_5 & 1558 + ibit31 * adv_mom_3 & 1559 ) * & 1477 1560 ( w(k,j+1,i) + w(k,j-2,i) ) & 1478 + ( IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1479 ) *&1561 + ( ibit32 * adv_mom_5 & 1562 ) * & 1480 1563 ( w(k,j+2,i) + w(k,j-3,i) ) & 1481 1564 ) 1482 1565 1483 1566 diss_s_w(k,tn) = - ABS( v_comp ) * ( & 1484 ( 10.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1485 + 3.0 * IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&1486 + IBITS(wall_flags_0(k,j,i),30,1) * adv_mom_1&1487 ) *&1567 ( 10.0 * ibit32 * adv_mom_5 & 1568 + 3.0 * ibit31 * adv_mom_3 & 1569 + ibit30 * adv_mom_1 & 1570 ) * & 1488 1571 ( w(k,j,i) - w(k,j-1,i) ) & 1489 - ( 5.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1490 + IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&1491 ) *&1572 - ( 5.0 * ibit32 * adv_mom_5 & 1573 + ibit31 * adv_mom_3 & 1574 ) * & 1492 1575 ( w(k,j+1,i) - w(k,j-2,i) ) & 1493 + ( IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1494 ) *&1576 + ( ibit32 * adv_mom_5 & 1577 ) * & 1495 1578 ( w(k,j+2,i) - w(k,j-3,i) ) & 1496 1579 ) … … 1519 1602 DO k = nzb+1, nzb_max 1520 1603 1604 ibit29 = IBITS(wall_flags_0(k,j,i),29,1) 1605 ibit28 = IBITS(wall_flags_0(k,j,i),28,1) 1606 ibit27 = IBITS(wall_flags_0(k,j,i),27,1) 1607 1521 1608 u_comp = u(k+1,j,i) + u(k,j,i) - gu 1522 1609 flux_l_w(k,j,tn) = u_comp * ( & 1523 ( 37.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1524 + 7.0 * IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&1525 + IBITS(wall_flags_0(k,j,i),27,1) * adv_mom_1&1526 ) *&1610 ( 37.0 * ibit29 * adv_mom_5 & 1611 + 7.0 * ibit28 * adv_mom_3 & 1612 + ibit27 * adv_mom_1 & 1613 ) * & 1527 1614 ( w(k,j,i) + w(k,j,i-1) ) & 1528 - ( 8.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1529 + IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&1530 ) *&1615 - ( 8.0 * ibit29 * adv_mom_5 & 1616 + ibit28 * adv_mom_3 & 1617 ) * & 1531 1618 ( w(k,j,i+1) + w(k,j,i-2) ) & 1532 + ( IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1533 ) *&1619 + ( ibit29 * adv_mom_5 & 1620 ) * & 1534 1621 ( w(k,j,i+2) + w(k,j,i-3) ) & 1535 1622 ) 1536 1623 1537 1624 diss_l_w(k,j,tn) = - ABS( u_comp ) * ( & 1538 ( 10.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1539 + 3.0 * IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&1540 + IBITS(wall_flags_0(k,j,i),27,1) * adv_mom_1&1541 ) *&1625 ( 10.0 * ibit29 * adv_mom_5 & 1626 + 3.0 * ibit28 * adv_mom_3 & 1627 + ibit27 * adv_mom_1 & 1628 ) * & 1542 1629 ( w(k,j,i) - w(k,j,i-1) ) & 1543 - ( 5.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1544 + IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&1545 ) *&1630 - ( 5.0 * ibit29 * adv_mom_5 & 1631 + ibit28 * adv_mom_3 & 1632 ) * & 1546 1633 ( w(k,j,i+1) - w(k,j,i-2) ) & 1547 + ( IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1548 ) *&1634 + ( ibit29 * adv_mom_5 & 1635 ) * & 1549 1636 ( w(k,j,i+2) - w(k,j,i-3) ) & 1550 1637 ) … … 1582 1669 DO k = nzb+1, nzb_max 1583 1670 1671 ibit29 = IBITS(wall_flags_0(k,j,i),29,1) 1672 ibit28 = IBITS(wall_flags_0(k,j,i),28,1) 1673 ibit27 = IBITS(wall_flags_0(k,j,i),27,1) 1674 1584 1675 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 1585 1676 flux_r(k) = u_comp * ( & 1586 ( 37.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1587 + 7.0 * IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&1588 + IBITS(wall_flags_0(k,j,i),27,1) * adv_mom_1&1677 ( 37.0 * ibit29 * adv_mom_5 & 1678 + 7.0 * ibit28 * adv_mom_3 & 1679 + ibit27 * adv_mom_1 & 1589 1680 ) * & 1590 1681 ( w(k,j,i+1) + w(k,j,i) ) & 1591 - ( 8.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1592 + IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&1682 - ( 8.0 * ibit29 * adv_mom_5 & 1683 + ibit28 * adv_mom_3 & 1593 1684 ) * & 1594 1685 ( w(k,j,i+2) + w(k,j,i-1) ) & 1595 + ( IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1686 + ( ibit29 * adv_mom_5 & 1596 1687 ) * & 1597 1688 ( w(k,j,i+3) + w(k,j,i-2) ) & 1598 )1689 ) 1599 1690 1600 1691 diss_r(k) = - ABS( u_comp ) * ( & 1601 ( 10.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1602 + 3.0 * IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&1603 + IBITS(wall_flags_0(k,j,i),27,1) * adv_mom_1&1692 ( 10.0 * ibit29 * adv_mom_5 & 1693 + 3.0 * ibit28 * adv_mom_3 & 1694 + ibit27 * adv_mom_1 & 1604 1695 ) * & 1605 1696 ( w(k,j,i+1) - w(k,j,i) ) & 1606 - ( 5.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1607 + IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&1697 - ( 5.0 * ibit29 * adv_mom_5 & 1698 + ibit28 * adv_mom_3 & 1608 1699 ) * & 1609 1700 ( w(k,j,i+2) - w(k,j,i-1) ) & 1610 + ( IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&1701 + ( ibit29 * adv_mom_5 & 1611 1702 ) * & 1612 1703 ( w(k,j,i+3) - w(k,j,i-2) ) & 1613 1704 ) 1614 1705 1706 ibit32 = IBITS(wall_flags_0(k,j,i),32,1) 1707 ibit31 = IBITS(wall_flags_0(k,j,i),31,1) 1708 ibit30 = IBITS(wall_flags_0(k,j,i),30,1) 1709 1615 1710 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 1616 1711 flux_n(k) = v_comp * ( & 1617 ( 37.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1618 + 7.0 * IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&1619 + IBITS(wall_flags_0(k,j,i),30,1) * adv_mom_1&1712 ( 37.0 * ibit32 * adv_mom_5 & 1713 + 7.0 * ibit31 * adv_mom_3 & 1714 + ibit30 * adv_mom_1 & 1620 1715 ) * & 1621 1716 ( w(k,j+1,i) + w(k,j,i) ) & 1622 - ( 8.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1623 + IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&1717 - ( 8.0 * ibit32 * adv_mom_5 & 1718 + ibit31 * adv_mom_3 & 1624 1719 ) * & 1625 1720 ( w(k,j+2,i) + w(k,j-1,i) ) & 1626 + ( IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1721 + ( ibit32 * adv_mom_5 & 1627 1722 ) * & 1628 1723 ( w(k,j+3,i) + w(k,j-2,i) ) & … … 1630 1725 1631 1726 diss_n(k) = - ABS( v_comp ) * ( & 1632 ( 10.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1633 + 3.0 * IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&1634 + IBITS(wall_flags_0(k,j,i),30,1) * adv_mom_1&1727 ( 10.0 * ibit32 * adv_mom_5 & 1728 + 3.0 * ibit31 * adv_mom_3 & 1729 + ibit30 * adv_mom_1 & 1635 1730 ) * & 1636 1731 ( w(k,j+1,i) - w(k,j,i) ) & 1637 - ( 5.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1638 + IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&1732 - ( 5.0 * ibit32 * adv_mom_5 & 1733 + ibit31 * adv_mom_3 & 1639 1734 ) * & 1640 1735 ( w(k,j+2,i) - w(k,j-1,i) ) & 1641 + ( IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&1736 + ( ibit32 * adv_mom_5 & 1642 1737 ) * & 1643 1738 ( w(k,j+3,i) - w(k,j-2,i) ) & … … 1646 1741 !-- k index has to be modified near bottom and top, else array 1647 1742 !-- subscripts will be exceeded. 1648 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),35,1) 1649 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),33,1) ) 1650 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),35,1) 1743 ibit35 = IBITS(wall_flags_0(k,j,i),35,1) 1744 ibit34 = IBITS(wall_flags_0(k,j,i),34,1) 1745 ibit33 = IBITS(wall_flags_0(k,j,i),33,1) 1746 1747 k_ppp = k + 3 * ibit35 1748 k_pp = k + 2 * ( 1 - ibit33 ) 1749 k_mm = k - 2 * ibit35 1651 1750 1652 1751 w_comp = w(k+1,j,i) + w(k,j,i) 1653 1752 flux_t(k) = w_comp * ( & 1654 ( 37.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1655 + 7.0 * IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&1656 + IBITS(wall_flags_0(k,j,i),33,1) * adv_mom_1&1753 ( 37.0 * ibit35 * adv_mom_5 & 1754 + 7.0 * ibit34 * adv_mom_3 & 1755 + ibit33 * adv_mom_1 & 1657 1756 ) * & 1658 1757 ( w(k+1,j,i) + w(k,j,i) ) & 1659 - ( 8.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1660 + IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&1758 - ( 8.0 * ibit35 * adv_mom_5 & 1759 + ibit34 * adv_mom_3 & 1661 1760 ) * & 1662 1761 ( w(k_pp,j,i) + w(k-1,j,i) ) & 1663 + ( IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1762 + ( ibit35 * adv_mom_5 & 1664 1763 ) * & 1665 1764 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & … … 1667 1766 1668 1767 diss_t(k) = - ABS( w_comp ) * ( & 1669 ( 10.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1670 + 3.0 * IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&1671 + IBITS(wall_flags_0(k,j,i),33,1) * adv_mom_1&1768 ( 10.0 * ibit35 * adv_mom_5 & 1769 + 3.0 * ibit34 * adv_mom_3 & 1770 + ibit33 * adv_mom_1 & 1672 1771 ) * & 1673 1772 ( w(k+1,j,i) - w(k,j,i) ) & 1674 - ( 5.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1675 + IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&1773 - ( 5.0 * ibit35 * adv_mom_5 & 1774 + ibit34 * adv_mom_3 & 1676 1775 ) * & 1677 1776 ( w(k_pp,j,i) - w(k-1,j,i) ) & 1678 + ( IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1777 + ( ibit35 * adv_mom_5 & 1679 1778 ) * & 1680 1779 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & … … 1739 1838 !-- k index has to be modified near bottom and top, else array 1740 1839 !-- subscripts will be exceeded. 1741 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),35,1) 1742 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),33,1) ) 1743 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),35,1) 1840 ibit35 = IBITS(wall_flags_0(k,j,i),35,1) 1841 ibit34 = IBITS(wall_flags_0(k,j,i),34,1) 1842 ibit33 = IBITS(wall_flags_0(k,j,i),33,1) 1843 1844 k_ppp = k + 3 * ibit35 1845 k_pp = k + 2 * ( 1 - ibit33 ) 1846 k_mm = k - 2 * ibit35 1744 1847 1745 1848 w_comp = w(k+1,j,i) + w(k,j,i) 1746 1849 flux_t(k) = w_comp * ( & 1747 ( 37.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1748 + 7.0 * IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&1749 + IBITS(wall_flags_0(k,j,i),33,1) * adv_mom_1&1850 ( 37.0 * ibit35 * adv_mom_5 & 1851 + 7.0 * ibit34 * adv_mom_3 & 1852 + ibit33 * adv_mom_1 & 1750 1853 ) * & 1751 1854 ( w(k+1,j,i) + w(k,j,i) ) & 1752 - ( 8.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1753 + IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&1855 - ( 8.0 * ibit35 * adv_mom_5 & 1856 + ibit34 * adv_mom_3 & 1754 1857 ) * & 1755 1858 ( w(k_pp,j,i) + w(k-1,j,i) ) & 1756 + ( IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1859 + ( ibit35 * adv_mom_5 & 1757 1860 ) * & 1758 1861 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & … … 1760 1863 1761 1864 diss_t(k) = - ABS( w_comp ) * ( & 1762 ( 10.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1763 + 3.0 * IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&1764 + IBITS(wall_flags_0(k,j,i),33,1) * adv_mom_1&1865 ( 10.0 * ibit35 * adv_mom_5 & 1866 + 3.0 * ibit34 * adv_mom_3 & 1867 + ibit33 * adv_mom_1 & 1765 1868 ) * & 1766 1869 ( w(k+1,j,i) - w(k,j,i) ) & 1767 - ( 5.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1768 + IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&1870 - ( 5.0 * ibit35 * adv_mom_5 & 1871 + ibit34 * adv_mom_3 & 1769 1872 ) * & 1770 1873 ( w(k_pp,j,i) - w(k-1,j,i) ) & 1771 + ( IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&1874 + ( ibit35 * adv_mom_5 & 1772 1875 ) * & 1773 1876 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & … … 1823 1926 IMPLICIT NONE 1824 1927 1825 INTEGER :: i, j, k, k_mm, k_pp, k_ppp, tn = 0 1928 INTEGER :: i, ibit0, ibit1, ibit2, ibit3, ibit4, ibit5, ibit6, & 1929 ibit7, ibit8, j, k, k_mm, k_pp, k_ppp, tn = 0 1826 1930 REAL, DIMENSION(:,:,:), POINTER :: sk 1827 1931 REAL :: diss_d, div, flux_d, u_comp, v_comp … … 1840 1944 DO k = nzb+1, nzb_max 1841 1945 1946 ibit2 = IBITS(wall_flags_0(k,j,i),2,1) 1947 ibit1 = IBITS(wall_flags_0(k,j,i),1,1) 1948 ibit0 = IBITS(wall_flags_0(k,j,i),0,1) 1949 1842 1950 u_comp = u(k,j,i) - u_gtrans 1843 1951 swap_flux_x_local(k,j) = u_comp * ( & 1844 ( 37.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5 & 1845 + 7.0 * IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3 & 1846 + IBITS(wall_flags_0(k,j,i),0,1) * adv_sca_1 & 1847 ) * & 1848 ( sk(k,j,i) + sk(k,j,i-1) ) & 1849 - ( 8.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5 & 1850 + IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3 & 1851 ) * & 1852 ( sk(k,j,i+1) + sk(k,j,i-2) ) & 1853 + ( IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5 & 1854 ) * ( sk(k,j,i+2) + sk(k,j,i-3) ) & 1855 ) 1952 ( 37.0 * ibit2 * adv_sca_5 & 1953 + 7.0 * ibit1 * adv_sca_3 & 1954 + ibit0 * adv_sca_1 & 1955 ) * & 1956 ( sk(k,j,i) + sk(k,j,i-1) ) & 1957 - ( 8.0 * ibit2 * adv_sca_5 & 1958 + ibit1 * adv_sca_3 & 1959 ) * & 1960 ( sk(k,j,i+1) + sk(k,j,i-2) ) & 1961 + ( ibit2 * adv_sca_5 & 1962 ) * & 1963 ( sk(k,j,i+2) + sk(k,j,i-3) ) & 1964 ) 1856 1965 1857 1966 swap_diss_x_local(k,j) = -ABS( u_comp ) * ( & 1858 ( 10.0 * IBITS(wall_flags_0(k,j,i),2,1)* adv_sca_5 &1859 + 3.0 * IBITS(wall_flags_0(k,j,i),1,1)* adv_sca_3 &1860 + IBITS(wall_flags_0(k,j,i),0,1)* adv_sca_1 &1861 ) *&1862 ( sk(k,j,i) - sk(k,j,i-1) )&1863 - ( 5.0 * IBITS(wall_flags_0(k,j,i),2,1)* adv_sca_5 &1864 + IBITS(wall_flags_0(k,j,i),1,1)* adv_sca_3 &1865 ) *&1866 ( sk(k,j,i+1) - sk(k,j,i-2) )&1867 + ( IBITS(wall_flags_0(k,j,i),2,1)* adv_sca_5 &1868 ) *&1869 ( sk(k,j,i+2) - sk(k,j,i-3) )&1870 1967 ( 10.0 * ibit2 * adv_sca_5 & 1968 + 3.0 * ibit1 * adv_sca_3 & 1969 + ibit0 * adv_sca_1 & 1970 ) * & 1971 ( sk(k,j,i) - sk(k,j,i-1) ) & 1972 - ( 5.0 * ibit2 * adv_sca_5 & 1973 + ibit1 * adv_sca_3 & 1974 ) * & 1975 ( sk(k,j,i+1) - sk(k,j,i-2) ) & 1976 + ( ibit2 * adv_sca_5 & 1977 ) * & 1978 ( sk(k,j,i+2) - sk(k,j,i-3) ) & 1979 ) 1871 1980 1872 1981 ENDDO … … 1879 1988 - 8.0 * ( sk(k,j,i+1) + sk(k,j,i-2) ) & 1880 1989 + ( sk(k,j,i+2) + sk(k,j,i-3) ) & 1881 1990 ) * adv_sca_5 1882 1991 1883 1992 swap_diss_x_local(k,j) = -ABS( u_comp ) * ( & … … 1885 1994 - 5.0 * ( sk(k,j,i+1) - sk(k,j,i-2) ) & 1886 1995 + ( sk(k,j,i+2) - sk(k,j,i-3) ) & 1887 1996 ) * adv_sca_5 1888 1997 1889 1998 ENDDO … … 1896 2005 DO k = nzb+1, nzb_max 1897 2006 1898 v_comp = v(k,j,i) - v_gtrans 2007 ibit5 = IBITS(wall_flags_0(k,j,i),5,1) 2008 ibit4 = IBITS(wall_flags_0(k,j,i),4,1) 2009 ibit3 = IBITS(wall_flags_0(k,j,i),3,1) 2010 2011 v_comp = v(k,j,i) - v_gtrans 1899 2012 swap_flux_y_local(k) = v_comp * ( & 1900 ( 37.0 * IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &1901 + 7.0 * IBITS(wall_flags_0(k,j,i),4,1)* adv_sca_3 &1902 + IBITS(wall_flags_0(k,j,i),3,1)* adv_sca_1 &1903 ) *&1904 ( sk(k,j,i) + sk(k,j-1,i) )&1905 - ( 8.0 * IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &1906 + IBITS(wall_flags_0(k,j,i),4,1)* adv_sca_3 &1907 ) *&1908 ( sk(k,j+1,i) + sk(k,j-2,i) )&1909 + ( IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &1910 ) *&1911 ( sk(k,j+2,i) + sk(k,j-3,i) )&2013 ( 37.0 * ibit5 * adv_sca_5 & 2014 + 7.0 * ibit4 * adv_sca_3 & 2015 + ibit3 * adv_sca_1 & 2016 ) * & 2017 ( sk(k,j,i) + sk(k,j-1,i) ) & 2018 - ( 8.0 * ibit5 * adv_sca_5 & 2019 + ibit4 * adv_sca_3 & 2020 ) * & 2021 ( sk(k,j+1,i) + sk(k,j-2,i) ) & 2022 + ( ibit5 * adv_sca_5 & 2023 ) * & 2024 ( sk(k,j+2,i) + sk(k,j-3,i) ) & 1912 2025 ) 1913 2026 1914 2027 swap_diss_y_local(k) = -ABS( v_comp ) * ( & 1915 ( 10.0 * IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &1916 + 3.0 * IBITS(wall_flags_0(k,j,i),4,1)* adv_sca_3 &1917 + IBITS(wall_flags_0(k,j,i),3,1)* adv_sca_1 &1918 ) *&1919 ( sk(k,j,i) - sk(k,j-1,i) )&1920 - ( 5.0 * IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &1921 + IBITS(wall_flags_0(k,j,i),4,1)* adv_sca_3 &1922 ) *&1923 ( sk(k,j+1,i) - sk(k,j-2,i) )&1924 + ( IBITS(wall_flags_0(k,j,i),5,1)* adv_sca_5 &1925 ) *&1926 ( sk(k,j+2,i) - sk(k,j-3,i) )&2028 ( 10.0 * ibit5 * adv_sca_5 & 2029 + 3.0 * ibit4 * adv_sca_3 & 2030 + ibit3 * adv_sca_1 & 2031 ) * & 2032 ( sk(k,j,i) - sk(k,j-1,i) ) & 2033 - ( 5.0 * ibit5 * adv_sca_5 & 2034 + ibit4 * adv_sca_3 & 2035 ) * & 2036 ( sk(k,j+1,i) - sk(k,j-2,i) ) & 2037 + ( ibit5 * adv_sca_5 & 2038 ) * & 2039 ( sk(k,j+2,i) - sk(k,j-3,i) ) & 1927 2040 ) 1928 2041 … … 1955 2068 DO k = nzb+1, nzb_max 1956 2069 2070 ibit2 = IBITS(wall_flags_0(k,j,i),2,1) 2071 ibit1 = IBITS(wall_flags_0(k,j,i),1,1) 2072 ibit0 = IBITS(wall_flags_0(k,j,i),0,1) 2073 1957 2074 u_comp = u(k,j,i+1) - u_gtrans 1958 2075 flux_r(k) = u_comp * ( & 1959 ( 37.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&1960 + 7.0 * IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3&1961 + IBITS(wall_flags_0(k,j,i),0,1) * adv_sca_1&1962 ) *&2076 ( 37.0 * ibit2 * adv_sca_5 & 2077 + 7.0 * ibit1 * adv_sca_3 & 2078 + ibit0 * adv_sca_1 & 2079 ) * & 1963 2080 ( sk(k,j,i+1) + sk(k,j,i) ) & 1964 - ( 8.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&1965 + IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3&1966 ) *&2081 - ( 8.0 * ibit2 * adv_sca_5 & 2082 + ibit1 * adv_sca_3 & 2083 ) * & 1967 2084 ( sk(k,j,i+2) + sk(k,j,i-1) ) & 1968 + ( IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5 & 1969 ) * ( sk(k,j,i+3) + sk(k,j,i-2) ) & 2085 + ( ibit2 * adv_sca_5 & 2086 ) * & 2087 ( sk(k,j,i+3) + sk(k,j,i-2) ) & 1970 2088 ) 1971 2089 1972 2090 diss_r(k) = -ABS( u_comp ) * ( & 1973 ( 10.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&1974 + 3.0 * IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3&1975 + IBITS(wall_flags_0(k,j,i),0,1) * adv_sca_1&1976 ) *&2091 ( 10.0 * ibit2 * adv_sca_5 & 2092 + 3.0 * ibit1 * adv_sca_3 & 2093 + ibit0 * adv_sca_1 & 2094 ) * & 1977 2095 ( sk(k,j,i+1) - sk(k,j,i) ) & 1978 - ( 5.0 * IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&1979 + IBITS(wall_flags_0(k,j,i),1,1) * adv_sca_3&1980 ) *&2096 - ( 5.0 * ibit2 * adv_sca_5 & 2097 + ibit1 * adv_sca_3 & 2098 ) * & 1981 2099 ( sk(k,j,i+2) - sk(k,j,i-1) ) & 1982 + ( IBITS(wall_flags_0(k,j,i),2,1) * adv_sca_5&1983 ) *&2100 + ( ibit2 * adv_sca_5 & 2101 ) * & 1984 2102 ( sk(k,j,i+3) - sk(k,j,i-2) ) & 1985 2103 ) 1986 2104 2105 ibit5 = IBITS(wall_flags_0(k,j,i),5,1) 2106 ibit4 = IBITS(wall_flags_0(k,j,i),4,1) 2107 ibit3 = IBITS(wall_flags_0(k,j,i),3,1) 2108 1987 2109 v_comp = v(k,j+1,i) - v_gtrans 1988 2110 flux_n(k) = v_comp * ( & 1989 ( 37.0 * IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&1990 + 7.0 * IBITS(wall_flags_0(k,j,i),4,1) * adv_sca_3&1991 + IBITS(wall_flags_0(k,j,i),3,1) * adv_sca_1&1992 ) *&2111 ( 37.0 * ibit5 * adv_sca_5 & 2112 + 7.0 * ibit4 * adv_sca_3 & 2113 + ibit3 * adv_sca_1 & 2114 ) * & 1993 2115 ( sk(k,j+1,i) + sk(k,j,i) ) & 1994 - ( 8.0 * IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&1995 + IBITS(wall_flags_0(k,j,i),4,1) * adv_sca_3&1996 ) *&2116 - ( 8.0 * ibit5 * adv_sca_5 & 2117 + ibit4 * adv_sca_3 & 2118 ) * & 1997 2119 ( sk(k,j+2,i) + sk(k,j-1,i) ) & 1998 + ( IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&1999 ) *&2120 + ( ibit5 * adv_sca_5 & 2121 ) * & 2000 2122 ( sk(k,j+3,i) + sk(k,j-2,i) ) & 2001 2123 ) 2002 2124 2003 2125 diss_n(k) = -ABS( v_comp ) * ( & 2004 ( 10.0 * IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&2005 + 3.0 * IBITS(wall_flags_0(k,j,i),4,1) * adv_sca_3&2006 + IBITS(wall_flags_0(k,j,i),3,1) * adv_sca_1&2007 ) *&2126 ( 10.0 * ibit5 * adv_sca_5 & 2127 + 3.0 * ibit4 * adv_sca_3 & 2128 + ibit3 * adv_sca_1 & 2129 ) * & 2008 2130 ( sk(k,j+1,i) - sk(k,j,i) ) & 2009 - ( 5.0 * IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&2010 + IBITS(wall_flags_0(k,j,i),4,1) * adv_sca_3&2011 ) *&2131 - ( 5.0 * ibit5 * adv_sca_5 & 2132 + ibit4 * adv_sca_3 & 2133 ) * & 2012 2134 ( sk(k,j+2,i) - sk(k,j-1,i) ) & 2013 + ( IBITS(wall_flags_0(k,j,i),5,1) * adv_sca_5&2014 ) *&2135 + ( ibit5 * adv_sca_5 & 2136 ) * & 2015 2137 ( sk(k,j+3,i) - sk(k,j-2,i) ) & 2016 2138 ) … … 2018 2140 !-- k index has to be modified near bottom and top, else array 2019 2141 !-- subscripts will be exceeded. 2020 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),8,1) 2021 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),6,1) ) 2022 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),8,1) 2023 2024 2025 flux_t(k) = w(k,j,i) * ( & 2026 ( 37.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5 & 2027 + 7.0 * IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3 & 2028 + IBITS(wall_flags_0(k,j,i),6,1) * adv_sca_1 & 2029 ) * & 2030 ( sk(k+1,j,i) + sk(k,j,i) ) & 2031 - ( 8.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5 & 2032 + IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3 & 2033 ) * & 2034 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 2035 + ( IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5 & 2036 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 2142 ibit8 = IBITS(wall_flags_0(k,j,i),8,1) 2143 ibit7 = IBITS(wall_flags_0(k,j,i),7,1) 2144 ibit6 = IBITS(wall_flags_0(k,j,i),6,1) 2145 2146 k_ppp = k + 3 * ibit8 2147 k_pp = k + 2 * ( 1 - ibit6 ) 2148 k_mm = k - 2 * ibit8 2149 2150 2151 flux_t(k) = w(k,j,i) * ( & 2152 ( 37.0 * ibit8 * adv_sca_5 & 2153 + 7.0 * ibit7 * adv_sca_3 & 2154 + ibit6 * adv_sca_1 & 2155 ) * & 2156 ( sk(k+1,j,i) + sk(k,j,i) ) & 2157 - ( 8.0 * ibit8 * adv_sca_5 & 2158 + ibit7 * adv_sca_3 & 2159 ) * & 2160 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 2161 + ( ibit8 * adv_sca_5 & 2162 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 2037 2163 ) 2038 2164 2039 diss_t(k) = -ABS( w(k,j,i) ) * ( &2040 ( 10.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&2041 + 3.0 * IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&2042 + IBITS(wall_flags_0(k,j,i),6,1) * adv_sca_1&2043 ) *&2044 ( sk(k+1,j,i) - sk(k,j,i) )&2045 - ( 5.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&2046 + IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&2047 ) *&2048 ( sk(k_pp,j,i) - sk(k-1,j,i) )&2049 + ( IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&2050 ) *&2051 ( sk(k_ppp,j,i) - sk(k_mm,j,i) )&2052 2165 diss_t(k) = -ABS( w(k,j,i) ) * ( & 2166 ( 10.0 * ibit8 * adv_sca_5 & 2167 + 3.0 * ibit7 * adv_sca_3 & 2168 + ibit6 * adv_sca_1 & 2169 ) * & 2170 ( sk(k+1,j,i) - sk(k,j,i) ) & 2171 - ( 5.0 * ibit8 * adv_sca_5 & 2172 + ibit7 * adv_sca_3 & 2173 ) * & 2174 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 2175 + ( ibit8 * adv_sca_5 & 2176 ) * & 2177 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & 2178 ) 2053 2179 ! 2054 2180 !-- Calculate the divergence of the velocity field. A respective … … 2101 2227 !-- k index has to be modified near bottom and top, else array 2102 2228 !-- subscripts will be exceeded. 2103 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),8,1) 2104 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),6,1) ) 2105 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),8,1) 2106 2107 flux_t(k) = w(k,j,i) * ( & 2108 ( 37.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5 & 2109 + 7.0 * IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3 & 2110 + IBITS(wall_flags_0(k,j,i),6,1) * adv_sca_1 & 2111 ) * & 2112 ( sk(k+1,j,i) + sk(k,j,i) ) & 2113 - ( 8.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5 & 2114 + IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3 & 2115 ) * & 2116 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 2117 + ( IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5 & 2118 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 2229 ibit8 = IBITS(wall_flags_0(k,j,i),8,1) 2230 ibit7 = IBITS(wall_flags_0(k,j,i),7,1) 2231 ibit6 = IBITS(wall_flags_0(k,j,i),6,1) 2232 2233 k_ppp = k + 3 * ibit8 2234 k_pp = k + 2 * ( 1 - ibit6 ) 2235 k_mm = k - 2 * ibit8 2236 2237 2238 flux_t(k) = w(k,j,i) * ( & 2239 ( 37.0 * ibit8 * adv_sca_5 & 2240 + 7.0 * ibit7 * adv_sca_3 & 2241 + ibit6 * adv_sca_1 & 2242 ) * & 2243 ( sk(k+1,j,i) + sk(k,j,i) ) & 2244 - ( 8.0 * ibit8 * adv_sca_5 & 2245 + ibit7 * adv_sca_3 & 2246 ) * & 2247 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 2248 + ( ibit8 * adv_sca_5 & 2249 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 2119 2250 ) 2120 2251 2121 diss_t(k) = -ABS( w(k,j,i) ) * ( &2122 ( 10.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&2123 + 3.0 * IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&2124 + IBITS(wall_flags_0(k,j,i),6,1) * adv_sca_1&2125 ) *&2126 ( sk(k+1,j,i) - sk(k,j,i) )&2127 - ( 5.0 * IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&2128 + IBITS(wall_flags_0(k,j,i),7,1) * adv_sca_3&2129 ) *&2130 ( sk(k_pp,j,i) - sk(k-1,j,i) )&2131 + ( IBITS(wall_flags_0(k,j,i),8,1) * adv_sca_5&2132 ) *&2133 ( sk(k_ppp,j,i) - sk(k_mm,j,i) )&2134 2252 diss_t(k) = -ABS( w(k,j,i) ) * ( & 2253 ( 10.0 * ibit8 * adv_sca_5 & 2254 + 3.0 * ibit7 * adv_sca_3 & 2255 + ibit6 * adv_sca_1 & 2256 ) * & 2257 ( sk(k+1,j,i) - sk(k,j,i) ) & 2258 - ( 5.0 * ibit8 * adv_sca_5 & 2259 + ibit7 * adv_sca_3 & 2260 ) * & 2261 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 2262 + ( ibit8 * adv_sca_5 & 2263 ) * & 2264 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & 2265 ) 2135 2266 ! 2136 2267 !-- Calculate the divergence of the velocity field. A respective … … 2203 2334 IMPLICIT NONE 2204 2335 2205 INTEGER :: i, j, k, k_mm, k_pp, k_ppp, tn = 0 2336 INTEGER :: i, ibit9, ibit10, ibit11, ibit12, ibit13, ibit14, ibit15, & 2337 ibit16, ibit17, j, k, k_mm, k_pp, k_ppp, tn = 0 2206 2338 REAL :: diss_d, div, flux_d, gu, gv, v_comp, w_comp 2207 2339 REAL, DIMENSION(nzb+1:nzt) :: swap_diss_y_local_u, swap_flux_y_local_u … … 2220 2352 DO k = nzb+1, nzb_max 2221 2353 2354 ibit11 = IBITS(wall_flags_0(k,j,i),11,1) 2355 ibit10 = IBITS(wall_flags_0(k,j,i),10,1) 2356 ibit9 = IBITS(wall_flags_0(k,j,i),9,1) 2357 2222 2358 u_comp(k) = u(k,j,i) + u(k,j,i-1) - gu 2223 2359 swap_flux_x_local_u(k,j) = u_comp(k) * ( & 2224 ( 37.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2225 + 7.0 * IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&2226 + IBITS(wall_flags_0(k,j,i),9,1) * adv_mom_1&2227 ) *&2360 ( 37.0 * ibit11 * adv_mom_5 & 2361 + 7.0 * ibit10 * adv_mom_3 & 2362 + ibit9 * adv_mom_1 & 2363 ) * & 2228 2364 ( u(k,j,i) + u(k,j,i-1) ) & 2229 - ( 8.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2230 + IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&2231 ) *&2365 - ( 8.0 * ibit11 * adv_mom_5 & 2366 + ibit10 * adv_mom_3 & 2367 ) * & 2232 2368 ( u(k,j,i+1) + u(k,j,i-2) ) & 2233 + ( IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2234 ) *&2369 + ( ibit11 * adv_mom_5 & 2370 ) * & 2235 2371 ( u(k,j,i+2) + u(k,j,i-3) ) & 2236 2372 ) 2237 2373 2238 2374 swap_diss_x_local_u(k,j) = - ABS( u_comp(k) ) * ( & 2239 ( 10.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2240 + 3.0 * IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&2241 + IBITS(wall_flags_0(k,j,i),9,1) * adv_mom_1&2242 ) *&2375 ( 10.0 * ibit11 * adv_mom_5 & 2376 + 3.0 * ibit10 * adv_mom_3 & 2377 + ibit9 * adv_mom_1 & 2378 ) * & 2243 2379 ( u(k,j,i) - u(k,j,i-1) ) & 2244 - ( 5.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2245 + IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&2246 ) *&2380 - ( 5.0 * ibit11 * adv_mom_5 & 2381 + ibit10 * adv_mom_3 & 2382 ) * & 2247 2383 ( u(k,j,i+1) - u(k,j,i-2) ) & 2248 + ( IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2249 ) *&2384 + ( ibit11 * adv_mom_5 & 2385 ) * & 2250 2386 ( u(k,j,i+2) - u(k,j,i-3) ) & 2251 2387 ) … … 2274 2410 DO k = nzb+1, nzb_max 2275 2411 2412 ibit14 = IBITS(wall_flags_0(k,j,i),14,1) 2413 ibit13 = IBITS(wall_flags_0(k,j,i),13,1) 2414 ibit12 = IBITS(wall_flags_0(k,j,i),12,1) 2415 2276 2416 v_comp = v(k,j,i) + v(k,j,i-1) - gv 2277 2417 swap_flux_y_local_u(k) = v_comp * ( & 2278 ( 37.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2279 + 7.0 * IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&2280 + IBITS(wall_flags_0(k,j,i),12,1) * adv_mom_1&2281 ) *&2418 ( 37.0 * ibit14 * adv_mom_5 & 2419 + 7.0 * ibit13 * adv_mom_3 & 2420 + ibit12 * adv_mom_1 & 2421 ) * & 2282 2422 ( u(k,j,i) + u(k,j-1,i) ) & 2283 - ( 8.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2284 + IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&2285 ) *&2423 - ( 8.0 * ibit14 * adv_mom_5 & 2424 + ibit13 * adv_mom_3 & 2425 ) * & 2286 2426 ( u(k,j+1,i) + u(k,j-2,i) ) & 2287 + ( IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2288 ) *&2427 + ( ibit14 * adv_mom_5 & 2428 ) * & 2289 2429 ( u(k,j+2,i) + u(k,j-3,i) ) & 2290 2430 ) 2291 2431 2292 2432 swap_diss_y_local_u(k) = - ABS ( v_comp ) * ( & 2293 ( 10.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2294 + 3.0 * IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&2295 + IBITS(wall_flags_0(k,j,i),12,1) * adv_mom_1&2296 ) *&2433 ( 10.0 * ibit14 * adv_mom_5 & 2434 + 3.0 * ibit13 * adv_mom_3 & 2435 + ibit12 * adv_mom_1 & 2436 ) * & 2297 2437 ( u(k,j,i) - u(k,j-1,i) ) & 2298 - ( 5.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2299 + IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&2300 ) *&2438 - ( 5.0 * ibit14 * adv_mom_5 & 2439 + ibit13 * adv_mom_3 & 2440 ) * & 2301 2441 ( u(k,j+1,i) - u(k,j-2,i) ) & 2302 + ( IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2303 ) *&2442 + ( ibit14 * adv_mom_5 & 2443 ) * & 2304 2444 ( u(k,j+2,i) - u(k,j-3,i) ) & 2305 2445 ) … … 2331 2471 DO k = nzb+1, nzb_max 2332 2472 2473 ibit11 = IBITS(wall_flags_0(k,j,i),11,1) 2474 ibit10 = IBITS(wall_flags_0(k,j,i),10,1) 2475 ibit9 = IBITS(wall_flags_0(k,j,i),9,1) 2476 2333 2477 u_comp(k) = u(k,j,i+1) + u(k,j,i) 2334 2478 flux_r(k) = ( u_comp(k) - gu ) * ( & 2335 ( 37.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2336 + 7.0 * IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&2337 + IBITS(wall_flags_0(k,j,i),9,1) * adv_mom_1&2338 ) *&2479 ( 37.0 * ibit11 * adv_mom_5 & 2480 + 7.0 * ibit10 * adv_mom_3 & 2481 + ibit9 * adv_mom_1 & 2482 ) * & 2339 2483 ( u(k,j,i+1) + u(k,j,i) ) & 2340 - ( 8.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2341 + IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&2342 ) *&2484 - ( 8.0 * ibit11 * adv_mom_5 & 2485 + ibit10 * adv_mom_3 & 2486 ) * & 2343 2487 ( u(k,j,i+2) + u(k,j,i-1) ) & 2344 + ( IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2345 ) *&2488 + ( ibit11 * adv_mom_5 & 2489 ) * & 2346 2490 ( u(k,j,i+3) + u(k,j,i-2) ) & 2347 2491 ) 2348 2492 2349 2493 diss_r(k) = - ABS( u_comp(k) - gu ) * ( & 2350 ( 10.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2351 + 3.0 * IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3 &2352 + IBITS(wall_flags_0(k,j,i),9,1) * adv_mom_1&2353 ) *&2494 ( 10.0 * ibit11 * adv_mom_5 & 2495 + 3.0 * ibit10 * adv_mom_3 & 2496 + ibit9 * adv_mom_1 & 2497 ) * & 2354 2498 ( u(k,j,i+1) - u(k,j,i) ) & 2355 - ( 5.0 * IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2356 + IBITS(wall_flags_0(k,j,i),10,1) * adv_mom_3&2357 ) *&2499 - ( 5.0 * ibit11 * adv_mom_5 & 2500 + ibit10 * adv_mom_3 & 2501 ) * & 2358 2502 ( u(k,j,i+2) - u(k,j,i-1) ) & 2359 + ( IBITS(wall_flags_0(k,j,i),11,1) * adv_mom_5&2360 ) *&2503 + ( ibit11 * adv_mom_5 & 2504 ) * & 2361 2505 ( u(k,j,i+3) - u(k,j,i-2) ) & 2362 2506 ) 2363 2507 2508 ibit14 = IBITS(wall_flags_0(k,j,i),14,1) 2509 ibit13 = IBITS(wall_flags_0(k,j,i),13,1) 2510 ibit12 = IBITS(wall_flags_0(k,j,i),12,1) 2511 2364 2512 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 2365 2513 flux_n(k) = v_comp * ( & 2366 ( 37.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2367 + 7.0 * IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&2368 + IBITS(wall_flags_0(k,j,i),12,1) * adv_mom_1&2369 ) *&2514 ( 37.0 * ibit14 * adv_mom_5 & 2515 + 7.0 * ibit13 * adv_mom_3 & 2516 + ibit12 * adv_mom_1 & 2517 ) * & 2370 2518 ( u(k,j+1,i) + u(k,j,i) ) & 2371 - ( 8.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2372 + IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&2373 ) *&2519 - ( 8.0 * ibit14 * adv_mom_5 & 2520 + ibit13 * adv_mom_3 & 2521 ) * & 2374 2522 ( u(k,j+2,i) + u(k,j-1,i) ) & 2375 + ( IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5 &2376 ) *&2523 + ( ibit14 * adv_mom_5 & 2524 ) * & 2377 2525 ( u(k,j+3,i) + u(k,j-2,i) ) & 2378 2526 ) 2379 2527 2380 2528 diss_n(k) = - ABS ( v_comp ) * ( & 2381 ( 10.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2382 + 3.0 * IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&2383 + IBITS(wall_flags_0(k,j,i),12,1) * adv_mom_1&2384 ) *&2529 ( 10.0 * ibit14 * adv_mom_5 & 2530 + 3.0 * ibit13 * adv_mom_3 & 2531 + ibit12 * adv_mom_1 & 2532 ) * & 2385 2533 ( u(k,j+1,i) - u(k,j,i) ) & 2386 - ( 5.0 * IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2387 + IBITS(wall_flags_0(k,j,i),13,1) * adv_mom_3&2388 ) *&2534 - ( 5.0 * ibit14 * adv_mom_5 & 2535 + ibit13 * adv_mom_3 & 2536 ) * & 2389 2537 ( u(k,j+2,i) - u(k,j-1,i) ) & 2390 + ( IBITS(wall_flags_0(k,j,i),14,1) * adv_mom_5&2391 ) *&2538 + ( ibit14 * adv_mom_5 & 2539 ) * & 2392 2540 ( u(k,j+3,i) - u(k,j-2,i) ) & 2393 2541 ) … … 2395 2543 !-- k index has to be modified near bottom and top, else array 2396 2544 !-- subscripts will be exceeded. 2397 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),17,1) 2398 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),15,1) ) 2399 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),17,1) 2545 ibit17 = IBITS(wall_flags_0(k,j,i),17,1) 2546 ibit16 = IBITS(wall_flags_0(k,j,i),16,1) 2547 ibit15 = IBITS(wall_flags_0(k,j,i),15,1) 2548 2549 k_ppp = k + 3 * ibit17 2550 k_pp = k + 2 * ( 1 - ibit15 ) 2551 k_mm = k - 2 * ibit17 2400 2552 2401 2553 w_comp = w(k,j,i) + w(k,j,i-1) 2402 2554 flux_t(k) = w_comp * ( & 2403 ( 37.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2404 + 7.0 * IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&2405 + IBITS(wall_flags_0(k,j,i),15,1) * adv_mom_1 &2406 ) *&2555 ( 37.0 * ibit17 * adv_mom_5 & 2556 + 7.0 * ibit16 * adv_mom_3 & 2557 + ibit15 * adv_mom_1 & 2558 ) * & 2407 2559 ( u(k+1,j,i) + u(k,j,i) ) & 2408 - ( 8.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2409 + IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&2410 ) *&2560 - ( 8.0 * ibit17 * adv_mom_5 & 2561 + ibit16 * adv_mom_3 & 2562 ) * & 2411 2563 ( u(k_pp,j,i) + u(k-1,j,i) ) & 2412 + ( IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2413 ) *&2564 + ( ibit17 * adv_mom_5 & 2565 ) * & 2414 2566 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & 2415 2567 ) 2416 2568 2417 2569 diss_t(k) = - ABS( w_comp ) * ( & 2418 ( 10.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2419 + 3.0 * IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&2420 + IBITS(wall_flags_0(k,j,i),15,1) * adv_mom_1&2421 ) *&2570 ( 10.0 * ibit17 * adv_mom_5 & 2571 + 3.0 * ibit16 * adv_mom_3 & 2572 + ibit15 * adv_mom_1 & 2573 ) * & 2422 2574 ( u(k+1,j,i) - u(k,j,i) ) & 2423 - ( 5.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2424 + IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&2425 ) *&2575 - ( 5.0 * ibit17 * adv_mom_5 & 2576 + ibit16 * adv_mom_3 & 2577 ) * & 2426 2578 ( u(k_pp,j,i) - u(k-1,j,i) ) & 2427 + ( IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2428 ) *&2579 + ( ibit17 * adv_mom_5 & 2580 ) * & 2429 2581 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & 2430 2582 ) … … 2497 2649 !-- k index has to be modified near bottom and top, else array 2498 2650 !-- subscripts will be exceeded. 2499 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),17,1) 2500 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),15,1) ) 2501 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),17,1) 2651 ibit17 = IBITS(wall_flags_0(k,j,i),17,1) 2652 ibit16 = IBITS(wall_flags_0(k,j,i),16,1) 2653 ibit15 = IBITS(wall_flags_0(k,j,i),15,1) 2654 2655 k_ppp = k + 3 * ibit17 2656 k_pp = k + 2 * ( 1 - ibit15 ) 2657 k_mm = k - 2 * ibit17 2502 2658 2503 2659 w_comp = w(k,j,i) + w(k,j,i-1) 2504 2660 flux_t(k) = w_comp * ( & 2505 ( 37.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2506 + 7.0 * IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&2507 + IBITS(wall_flags_0(k,j,i),15,1) * adv_mom_1&2508 ) *&2661 ( 37.0 * ibit17 * adv_mom_5 & 2662 + 7.0 * ibit16 * adv_mom_3 & 2663 + ibit15 * adv_mom_1 & 2664 ) * & 2509 2665 ( u(k+1,j,i) + u(k,j,i) ) & 2510 - ( 8.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2511 + IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&2512 ) *&2666 - ( 8.0 * ibit17 * adv_mom_5 & 2667 + ibit16 * adv_mom_3 & 2668 ) * & 2513 2669 ( u(k_pp,j,i) + u(k-1,j,i) ) & 2514 + ( IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2515 ) *&2670 + ( ibit17 * adv_mom_5 & 2671 ) * & 2516 2672 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & 2517 2673 ) 2518 2674 2519 diss_t(k) = - ABS( w_comp ) * (&2520 ( 10.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2521 + 3.0 * IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&2522 + IBITS(wall_flags_0(k,j,i),15,1) * adv_mom_1&2523 ) *&2675 diss_t(k) = - ABS( w_comp ) * ( & 2676 ( 10.0 * ibit17 * adv_mom_5 & 2677 + 3.0 * ibit16 * adv_mom_3 & 2678 + ibit15 * adv_mom_1 & 2679 ) * & 2524 2680 ( u(k+1,j,i) - u(k,j,i) ) & 2525 - ( 5.0 * IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2526 + IBITS(wall_flags_0(k,j,i),16,1) * adv_mom_3&2527 ) *&2681 - ( 5.0 * ibit17 * adv_mom_5 & 2682 + ibit16 * adv_mom_3 & 2683 ) * & 2528 2684 ( u(k_pp,j,i) - u(k-1,j,i) ) & 2529 + ( IBITS(wall_flags_0(k,j,i),17,1) * adv_mom_5&2530 ) *&2685 + ( ibit17 * adv_mom_5 & 2686 ) * & 2531 2687 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & 2532 2688 ) 2533 2689 ! 2534 2690 !-- Calculate the divergence of the velocity field. A respective … … 2597 2753 2598 2754 2599 INTEGER :: i, j, k, k_mm, k_pp, k_ppp, tn = 0 2755 INTEGER :: i, ibit18, ibit19, ibit20, ibit21, ibit22, ibit23, ibit24, & 2756 ibit25, ibit26, j, k, k_mm, k_pp, k_ppp, tn = 0 2600 2757 REAL :: diss_d, div, flux_d, gu, gv, u_comp, w_comp 2601 2758 REAL, DIMENSION(nzb+1:nzt) :: swap_diss_y_local_v, swap_flux_y_local_v … … 2613 2770 DO k = nzb+1, nzb_max 2614 2771 2772 ibit20 = IBITS(wall_flags_0(k,j,i),20,1) 2773 ibit19 = IBITS(wall_flags_0(k,j,i),19,1) 2774 ibit18 = IBITS(wall_flags_0(k,j,i),18,1) 2775 2615 2776 u_comp = u(k,j-1,i) + u(k,j,i) - gu 2616 2777 swap_flux_x_local_v(k,j) = u_comp * ( & 2617 ( 37.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2618 + 7.0 * IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&2619 + IBITS(wall_flags_0(k,j,i),18,1) * adv_mom_1&2620 ) *&2778 ( 37.0 * ibit20 * adv_mom_5 & 2779 + 7.0 * ibit19 * adv_mom_3 & 2780 + ibit18 * adv_mom_1 & 2781 ) * & 2621 2782 ( v(k,j,i) + v(k,j,i-1) ) & 2622 - ( 8.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2623 + IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&2624 ) *&2783 - ( 8.0 * ibit20 * adv_mom_5 & 2784 + ibit19 * adv_mom_3 & 2785 ) * & 2625 2786 ( v(k,j,i+1) + v(k,j,i-2) ) & 2626 + ( IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2627 ) *&2787 + ( ibit20 * adv_mom_5 & 2788 ) * & 2628 2789 ( v(k,j,i+2) + v(k,j,i-3) ) & 2629 2790 ) 2630 2791 2631 2792 swap_diss_x_local_v(k,j) = - ABS( u_comp ) * ( & 2632 ( 10.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2633 + 3.0 * IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&2634 + IBITS(wall_flags_0(k,j,i),18,1) * adv_mom_1&2635 ) *&2793 ( 10.0 * ibit20 * adv_mom_5 & 2794 + 3.0 * ibit19 * adv_mom_3 & 2795 + ibit18 * adv_mom_1 & 2796 ) * & 2636 2797 ( v(k,j,i) - v(k,j,i-1) ) & 2637 - ( 5.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2638 + IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&2639 ) *&2798 - ( 5.0 * ibit20 * adv_mom_5 & 2799 + ibit19 * adv_mom_3 & 2800 ) * & 2640 2801 ( v(k,j,i+1) - v(k,j,i-2) ) & 2641 + ( IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2642 ) *&2802 + ( ibit20 * adv_mom_5 & 2803 ) * & 2643 2804 ( v(k,j,i+2) - v(k,j,i-3) ) & 2644 2805 ) … … 2667 2828 DO k = nzb+1, nzb_max 2668 2829 2830 ibit23 = IBITS(wall_flags_0(k,j,i),23,1) 2831 ibit22 = IBITS(wall_flags_0(k,j,i),22,1) 2832 ibit21 = IBITS(wall_flags_0(k,j,i),21,1) 2833 2669 2834 v_comp(k) = v(k,j,i) + v(k,j-1,i) - gv 2670 2835 swap_flux_y_local_v(k) = v_comp(k) * ( & 2671 ( 37.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2672 + 7.0 * IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&2673 + IBITS(wall_flags_0(k,j,i),21,1) * adv_mom_1&2674 ) *&2836 ( 37.0 * ibit23 * adv_mom_5 & 2837 + 7.0 * ibit22 * adv_mom_3 & 2838 + ibit21 * adv_mom_1 & 2839 ) * & 2675 2840 ( v(k,j,i) + v(k,j-1,i) ) & 2676 - ( 8.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2677 + IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&2678 ) *&2841 - ( 8.0 * ibit23 * adv_mom_5 & 2842 + ibit22 * adv_mom_3 & 2843 ) * & 2679 2844 ( v(k,j+1,i) + v(k,j-2,i) ) & 2680 + ( IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2681 ) *&2845 + ( ibit23 * adv_mom_5 & 2846 ) * & 2682 2847 ( v(k,j+2,i) + v(k,j-3,i) ) & 2683 2848 ) 2684 2849 2685 2850 swap_diss_y_local_v(k) = - ABS( v_comp(k) ) * ( & 2686 ( 10.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2687 + 3.0 * IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&2688 + IBITS(wall_flags_0(k,j,i),21,1) * adv_mom_1&2689 ) *&2851 ( 10.0 * ibit23 * adv_mom_5 & 2852 + 3.0 * ibit22 * adv_mom_3 & 2853 + ibit21 * adv_mom_1 & 2854 ) * & 2690 2855 ( v(k,j,i) - v(k,j-1,i) ) & 2691 - ( 5.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2692 + IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&2693 ) *&2856 - ( 5.0 * ibit23 * adv_mom_5 & 2857 + ibit22 * adv_mom_3 & 2858 ) * & 2694 2859 ( v(k,j+1,i) - v(k,j-2,i) ) & 2695 + ( IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2696 ) *&2860 + ( ibit23 * adv_mom_5 & 2861 ) * & 2697 2862 ( v(k,j+2,i) - v(k,j-3,i) ) & 2698 2863 ) … … 2723 2888 DO k = nzb+1, nzb_max 2724 2889 2890 ibit20 = IBITS(wall_flags_0(k,j,i),20,1) 2891 ibit19 = IBITS(wall_flags_0(k,j,i),19,1) 2892 ibit18 = IBITS(wall_flags_0(k,j,i),18,1) 2893 2725 2894 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 2726 2895 flux_r(k) = u_comp * ( & 2727 ( 37.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2728 + 7.0 * IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&2729 + IBITS(wall_flags_0(k,j,i),18,1) * adv_mom_1&2730 ) *&2896 ( 37.0 * ibit20 * adv_mom_5 & 2897 + 7.0 * ibit19 * adv_mom_3 & 2898 + ibit18 * adv_mom_1 & 2899 ) * & 2731 2900 ( v(k,j,i+1) + v(k,j,i) ) & 2732 - ( 8.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2733 + IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&2734 ) *&2901 - ( 8.0 * ibit20 * adv_mom_5 & 2902 + ibit19 * adv_mom_3 & 2903 ) * & 2735 2904 ( v(k,j,i+2) + v(k,j,i-1) ) & 2736 + ( IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2737 ) *&2905 + ( ibit20 * adv_mom_5 & 2906 ) * & 2738 2907 ( v(k,j,i+3) + v(k,j,i-2) ) & 2739 2908 ) 2740 2909 2741 2910 diss_r(k) = - ABS( u_comp ) * ( & 2742 ( 10.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2743 + 3.0 * IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&2744 + IBITS(wall_flags_0(k,j,i),18,1) * adv_mom_1&2745 ) *&2911 ( 10.0 * ibit20 * adv_mom_5 & 2912 + 3.0 * ibit19 * adv_mom_3 & 2913 + ibit18 * adv_mom_1 & 2914 ) * & 2746 2915 ( v(k,j,i+1) - v(k,j,i) ) & 2747 - ( 5.0 * IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2748 + IBITS(wall_flags_0(k,j,i),19,1) * adv_mom_3&2749 ) *&2916 - ( 5.0 * ibit20 * adv_mom_5 & 2917 + ibit19 * adv_mom_3 & 2918 ) * & 2750 2919 ( v(k,j,i+2) - v(k,j,i-1) ) & 2751 + ( IBITS(wall_flags_0(k,j,i),20,1) * adv_mom_5&2752 ) *&2920 + ( ibit20 * adv_mom_5 & 2921 ) * & 2753 2922 ( v(k,j,i+3) - v(k,j,i-2) ) & 2754 2923 ) 2755 2924 2925 ibit23 = IBITS(wall_flags_0(k,j,i),23,1) 2926 ibit22 = IBITS(wall_flags_0(k,j,i),22,1) 2927 ibit21 = IBITS(wall_flags_0(k,j,i),21,1) 2928 2756 2929 v_comp(k) = v(k,j+1,i) + v(k,j,i) 2757 2930 flux_n(k) = ( v_comp(k) - gv ) * ( & 2758 ( 37.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2759 + 7.0 * IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&2760 + IBITS(wall_flags_0(k,j,i),21,1) * adv_mom_1&2761 ) *&2931 ( 37.0 * ibit23 * adv_mom_5 & 2932 + 7.0 * ibit22 * adv_mom_3 & 2933 + ibit21 * adv_mom_1 & 2934 ) * & 2762 2935 ( v(k,j+1,i) + v(k,j,i) ) & 2763 - ( 8.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2764 + IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&2765 ) *&2936 - ( 8.0 * ibit23 * adv_mom_5 & 2937 + ibit22 * adv_mom_3 & 2938 ) * & 2766 2939 ( v(k,j+2,i) + v(k,j-1,i) ) & 2767 + ( IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2768 ) *&2940 + ( ibit23 * adv_mom_5 & 2941 ) * & 2769 2942 ( v(k,j+3,i) + v(k,j-2,i) ) & 2770 2943 ) 2771 2944 2772 2945 diss_n(k) = - ABS( v_comp(k) - gv ) * ( & 2773 ( 10.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2774 + 3.0 * IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&2775 + IBITS(wall_flags_0(k,j,i),21,1) * adv_mom_1&2776 ) *&2946 ( 10.0 * ibit23 * adv_mom_5 & 2947 + 3.0 * ibit22 * adv_mom_3 & 2948 + ibit21 * adv_mom_1 & 2949 ) * & 2777 2950 ( v(k,j+1,i) - v(k,j,i) ) & 2778 - ( 5.0 * IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2779 + IBITS(wall_flags_0(k,j,i),22,1) * adv_mom_3&2780 ) *&2951 - ( 5.0 * ibit23 * adv_mom_5 & 2952 + ibit22 * adv_mom_3 & 2953 ) * & 2781 2954 ( v(k,j+2,i) - v(k,j-1,i) ) & 2782 + ( IBITS(wall_flags_0(k,j,i),23,1) * adv_mom_5&2783 ) *&2955 + ( ibit23 * adv_mom_5 & 2956 ) * & 2784 2957 ( v(k,j+3,i) - v(k,j-2,i) ) & 2785 2958 ) … … 2787 2960 !-- k index has to be modified near bottom and top, else array 2788 2961 !-- subscripts will be exceeded. 2789 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),26,1) 2790 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),24,1) ) 2791 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),26,1) 2962 ibit26 = IBITS(wall_flags_0(k,j,i),26,1) 2963 ibit25 = IBITS(wall_flags_0(k,j,i),25,1) 2964 ibit24 = IBITS(wall_flags_0(k,j,i),24,1) 2965 2966 k_ppp = k + 3 * ibit26 2967 k_pp = k + 2 * ( 1 - ibit24 ) 2968 k_mm = k - 2 * ibit26 2792 2969 2793 2970 w_comp = w(k,j-1,i) + w(k,j,i) 2794 2971 flux_t(k) = w_comp * ( & 2795 ( 37.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2796 + 7.0 * IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&2797 + IBITS(wall_flags_0(k,j,i),24,1) * adv_mom_1&2798 ) *&2972 ( 37.0 * ibit26 * adv_mom_5 & 2973 + 7.0 * ibit25 * adv_mom_3 & 2974 + ibit24 * adv_mom_1 & 2975 ) * & 2799 2976 ( v(k+1,j,i) + v(k,j,i) ) & 2800 - ( 8.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2801 + IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&2802 ) *&2977 - ( 8.0 * ibit26 * adv_mom_5 & 2978 + ibit25 * adv_mom_3 & 2979 ) * & 2803 2980 ( v(k_pp,j,i) + v(k-1,j,i) ) & 2804 + ( IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2805 ) *&2981 + ( ibit26 * adv_mom_5 & 2982 ) * & 2806 2983 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & 2807 2984 ) 2808 2985 2809 2986 diss_t(k) = - ABS( w_comp ) * ( & 2810 ( 10.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2811 + 3.0 * IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&2812 + IBITS(wall_flags_0(k,j,i),24,1) * adv_mom_1&2813 ) *&2987 ( 10.0 * ibit26 * adv_mom_5 & 2988 + 3.0 * ibit25 * adv_mom_3 & 2989 + ibit24 * adv_mom_1 & 2990 ) * & 2814 2991 ( v(k+1,j,i) - v(k,j,i) ) & 2815 - ( 5.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2816 + IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&2817 ) *&2992 - ( 5.0 * ibit26 * adv_mom_5 & 2993 + ibit25 * adv_mom_3 & 2994 ) * & 2818 2995 ( v(k_pp,j,i) - v(k-1,j,i) ) & 2819 + ( IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2820 ) *&2996 + ( ibit26 * adv_mom_5 & 2997 ) * & 2821 2998 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & 2822 2999 ) … … 2896 3073 !-- k index has to be modified near bottom and top, else array 2897 3074 !-- subscripts will be exceeded. 2898 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),26,1) 2899 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),24,1) ) 2900 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),26,1) 3075 ibit26 = IBITS(wall_flags_0(k,j,i),26,1) 3076 ibit25 = IBITS(wall_flags_0(k,j,i),25,1) 3077 ibit24 = IBITS(wall_flags_0(k,j,i),24,1) 3078 3079 k_ppp = k + 3 * ibit26 3080 k_pp = k + 2 * ( 1 - ibit24 ) 3081 k_mm = k - 2 * ibit26 2901 3082 2902 3083 w_comp = w(k,j-1,i) + w(k,j,i) 2903 3084 flux_t(k) = w_comp * ( & 2904 ( 37.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2905 + 7.0 * IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&2906 + IBITS(wall_flags_0(k,j,i),24,1) * adv_mom_1&2907 ) *&3085 ( 37.0 * ibit26 * adv_mom_5 & 3086 + 7.0 * ibit25 * adv_mom_3 & 3087 + ibit24 * adv_mom_1 & 3088 ) * & 2908 3089 ( v(k+1,j,i) + v(k,j,i) ) & 2909 - ( 8.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2910 + IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&2911 ) *&3090 - ( 8.0 * ibit26 * adv_mom_5 & 3091 + ibit25 * adv_mom_3 & 3092 ) * & 2912 3093 ( v(k_pp,j,i) + v(k-1,j,i) ) & 2913 + ( IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2914 ) *&3094 + ( ibit26 * adv_mom_5 & 3095 ) * & 2915 3096 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & 2916 )3097 ) 2917 3098 2918 3099 diss_t(k) = - ABS( w_comp ) * ( & 2919 ( 10.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2920 + 3.0 * IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&2921 + IBITS(wall_flags_0(k,j,i),24,1) * adv_mom_1&2922 ) *&3100 ( 10.0 * ibit26 * adv_mom_5 & 3101 + 3.0 * ibit25 * adv_mom_3 & 3102 + ibit24 * adv_mom_1 & 3103 ) * & 2923 3104 ( v(k+1,j,i) - v(k,j,i) ) & 2924 - ( 5.0 * IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2925 + IBITS(wall_flags_0(k,j,i),25,1) * adv_mom_3&2926 ) *&3105 - ( 5.0 * ibit26 * adv_mom_5 & 3106 + ibit25 * adv_mom_3 & 3107 ) * & 2927 3108 ( v(k_pp,j,i) - v(k-1,j,i) ) & 2928 + ( IBITS(wall_flags_0(k,j,i),26,1) * adv_mom_5&2929 ) *&3109 + ( ibit26 * adv_mom_5 & 3110 ) * & 2930 3111 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & 2931 )3112 ) 2932 3113 ! 2933 3114 !-- Calculate the divergence of the velocity field. A respective … … 2999 3180 IMPLICIT NONE 3000 3181 3001 INTEGER :: i, j, k, k_mm, k_pp, k_ppp, tn = 0 3182 INTEGER :: i, ibit27, ibit28, ibit29, ibit30, ibit31, ibit32, ibit33, & 3183 ibit34, ibit35, j, k, k_mm, k_pp, k_ppp, tn = 0 3002 3184 REAL :: diss_d, div, flux_d, gu, gv, u_comp, v_comp, w_comp 3003 3185 REAL, DIMENSION(nzb:nzt) :: diss_t, flux_t … … 3016 3198 DO k = nzb+1, nzb_max 3017 3199 3200 ibit29 = IBITS(wall_flags_0(k,j,i),29,1) 3201 ibit28 = IBITS(wall_flags_0(k,j,i),28,1) 3202 ibit27 = IBITS(wall_flags_0(k,j,i),27,1) 3203 3018 3204 u_comp = u(k+1,j,i) + u(k,j,i) - gu 3019 3205 swap_flux_x_local_w(k,j) = u_comp * ( & 3020 ( 37.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3021 + 7.0 * IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&3022 + IBITS(wall_flags_0(k,j,i),27,1) * adv_mom_1&3023 ) *&3206 ( 37.0 * ibit29 * adv_mom_5 & 3207 + 7.0 * ibit28 * adv_mom_3 & 3208 + ibit27 * adv_mom_1 & 3209 ) * & 3024 3210 ( w(k,j,i) + w(k,j,i-1) ) & 3025 - ( 8.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3026 + IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&3027 ) *&3211 - ( 8.0 * ibit29 * adv_mom_5 & 3212 + ibit28 * adv_mom_3 & 3213 ) * & 3028 3214 ( w(k,j,i+1) + w(k,j,i-2) ) & 3029 + ( IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3030 ) *&3215 + ( ibit29 * adv_mom_5 & 3216 ) * & 3031 3217 ( w(k,j,i+2) + w(k,j,i-3) ) & 3032 3218 ) 3033 3219 3034 3220 swap_diss_x_local_w(k,j) = - ABS( u_comp ) * ( & 3035 ( 10.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3036 + 3.0 * IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&3037 + IBITS(wall_flags_0(k,j,i),27,1) * adv_mom_1&3038 ) *&3221 ( 10.0 * ibit29 * adv_mom_5 & 3222 + 3.0 * ibit28 * adv_mom_3 & 3223 + ibit27 * adv_mom_1 & 3224 ) * & 3039 3225 ( w(k,j,i) - w(k,j,i-1) ) & 3040 - ( 5.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3041 + IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&3042 ) *&3226 - ( 5.0 * ibit29 * adv_mom_5 & 3227 + ibit28 * adv_mom_3 & 3228 ) * & 3043 3229 ( w(k,j,i+1) - w(k,j,i-2) ) & 3044 + ( IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3045 ) *&3230 + ( ibit29 * adv_mom_5 & 3231 ) * & 3046 3232 ( w(k,j,i+2) - w(k,j,i-3) ) & 3047 3233 ) … … 3070 3256 DO k = nzb+1, nzb_max 3071 3257 3258 ibit32 = IBITS(wall_flags_0(k,j,i),32,1) 3259 ibit31 = IBITS(wall_flags_0(k,j,i),31,1) 3260 ibit30 = IBITS(wall_flags_0(k,j,i),30,1) 3261 3072 3262 v_comp = v(k+1,j,i) + v(k,j,i) - gv 3073 3263 swap_flux_y_local_w(k) = v_comp * ( & 3074 ( 37.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3075 + 7.0 * IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&3076 + IBITS(wall_flags_0(k,j,i),30,1) * adv_mom_1&3077 ) *&3264 ( 37.0 * ibit32 * adv_mom_5 & 3265 + 7.0 * ibit31 * adv_mom_3 & 3266 + ibit30 * adv_mom_1 & 3267 ) * & 3078 3268 ( w(k,j,i) + w(k,j-1,i) ) & 3079 - ( 8.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3080 + IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&3081 ) *&3269 - ( 8.0 * ibit32 * adv_mom_5 & 3270 + ibit31 * adv_mom_3 & 3271 ) * & 3082 3272 ( w(k,j+1,i) + w(k,j-2,i) ) & 3083 + ( IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3084 ) *&3273 + ( ibit32 * adv_mom_5 & 3274 ) * & 3085 3275 ( w(k,j+2,i) + w(k,j-3,i) ) & 3086 3276 ) 3087 3277 3088 3278 swap_diss_y_local_w(k) = - ABS( v_comp ) * ( & 3089 ( 10.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3090 + 3.0 * IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&3091 + IBITS(wall_flags_0(k,j,i),30,1) * adv_mom_1&3092 ) *&3279 ( 10.0 * ibit32 * adv_mom_5 & 3280 + 3.0 * ibit31 * adv_mom_3 & 3281 + ibit30 * adv_mom_1 & 3282 ) * & 3093 3283 ( w(k,j,i) - w(k,j-1,i) ) & 3094 - ( 5.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3095 + IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&3096 ) *&3284 - ( 5.0 * ibit32 * adv_mom_5 & 3285 + ibit31 * adv_mom_3 & 3286 ) * & 3097 3287 ( w(k,j+1,i) - w(k,j-2,i) ) & 3098 + ( IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3099 ) *&3288 + ( ibit32 * adv_mom_5 & 3289 ) * & 3100 3290 ( w(k,j+2,i) - w(k,j-3,i) ) & 3101 3291 ) … … 3132 3322 DO k = nzb+1, nzb_max 3133 3323 3324 ibit29 = IBITS(wall_flags_0(k,j,i),29,1) 3325 ibit28 = IBITS(wall_flags_0(k,j,i),28,1) 3326 ibit27 = IBITS(wall_flags_0(k,j,i),27,1) 3327 3134 3328 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 3135 3329 flux_r(k) = u_comp * ( & 3136 ( 37.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3137 + 7.0 * IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&3138 + IBITS(wall_flags_0(k,j,i),27,1) * adv_mom_1&3139 ) *&3330 ( 37.0 * ibit29 * adv_mom_5 & 3331 + 7.0 * ibit28 * adv_mom_3 & 3332 + ibit27 * adv_mom_1 & 3333 ) * & 3140 3334 ( w(k,j,i+1) + w(k,j,i) ) & 3141 - ( 8.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3142 + IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&3143 ) *&3335 - ( 8.0 * ibit29 * adv_mom_5 & 3336 + ibit28 * adv_mom_3 & 3337 ) * & 3144 3338 ( w(k,j,i+2) + w(k,j,i-1) ) & 3145 + ( IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3146 ) *&3339 + ( ibit29 * adv_mom_5 & 3340 ) * & 3147 3341 ( w(k,j,i+3) + w(k,j,i-2) ) & 3148 3342 ) 3149 3343 3150 3344 diss_r(k) = - ABS( u_comp ) * ( & 3151 ( 10.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3152 + 3.0 * IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&3153 + IBITS(wall_flags_0(k,j,i),27,1) * adv_mom_1&3154 ) *&3345 ( 10.0 * ibit29 * adv_mom_5 & 3346 + 3.0 * ibit28 * adv_mom_3 & 3347 + ibit27 * adv_mom_1 & 3348 ) * & 3155 3349 ( w(k,j,i+1) - w(k,j,i) ) & 3156 - ( 5.0 * IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3157 + IBITS(wall_flags_0(k,j,i),28,1) * adv_mom_3&3158 ) *&3350 - ( 5.0 * ibit29 * adv_mom_5 & 3351 + ibit28 * adv_mom_3 & 3352 ) * & 3159 3353 ( w(k,j,i+2) - w(k,j,i-1) ) & 3160 + ( IBITS(wall_flags_0(k,j,i),29,1) * adv_mom_5&3161 ) *&3354 + ( ibit29 * adv_mom_5 & 3355 ) * & 3162 3356 ( w(k,j,i+3) - w(k,j,i-2) ) & 3163 3357 ) 3164 3358 3359 ibit32 = IBITS(wall_flags_0(k,j,i),32,1) 3360 ibit31 = IBITS(wall_flags_0(k,j,i),31,1) 3361 ibit30 = IBITS(wall_flags_0(k,j,i),30,1) 3362 3165 3363 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 3166 3364 flux_n(k) = v_comp * ( & 3167 ( 37.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3168 + 7.0 * IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&3169 + IBITS(wall_flags_0(k,j,i),30,1) * adv_mom_1&3170 ) *&3365 ( 37.0 * ibit32 * adv_mom_5 & 3366 + 7.0 * ibit31 * adv_mom_3 & 3367 + ibit30 * adv_mom_1 & 3368 ) * & 3171 3369 ( w(k,j+1,i) + w(k,j,i) ) & 3172 - ( 8.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3173 + IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&3174 ) *&3370 - ( 8.0 * ibit32 * adv_mom_5 & 3371 + ibit31 * adv_mom_3 & 3372 ) * & 3175 3373 ( w(k,j+2,i) + w(k,j-1,i) ) & 3176 + ( IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3177 ) *&3374 + ( ibit32 * adv_mom_5 & 3375 ) * & 3178 3376 ( w(k,j+3,i) + w(k,j-2,i) ) & 3179 3377 ) 3180 3378 3181 3379 diss_n(k) = - ABS( v_comp ) * ( & 3182 ( 10.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3183 + 3.0 * IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&3184 + IBITS(wall_flags_0(k,j,i),30,1) * adv_mom_1&3185 ) *&3380 ( 10.0 * ibit32 * adv_mom_5 & 3381 + 3.0 * ibit31 * adv_mom_3 & 3382 + ibit30 * adv_mom_1 & 3383 ) * & 3186 3384 ( w(k,j+1,i) - w(k,j,i) ) & 3187 - ( 5.0 * IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3188 + IBITS(wall_flags_0(k,j,i),31,1) * adv_mom_3&3189 ) *&3385 - ( 5.0 * ibit32 * adv_mom_5 & 3386 + ibit31 * adv_mom_3 & 3387 ) * & 3190 3388 ( w(k,j+2,i) - w(k,j-1,i) ) & 3191 + ( IBITS(wall_flags_0(k,j,i),32,1) * adv_mom_5&3192 ) *&3389 + ( ibit32 * adv_mom_5 & 3390 ) * & 3193 3391 ( w(k,j+3,i) - w(k,j-2,i) ) & 3194 3392 ) … … 3196 3394 !-- k index has to be modified near bottom and top, else array 3197 3395 !-- subscripts will be exceeded. 3198 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),35,1) 3199 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),33,1) ) 3200 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),35,1) 3396 ibit35 = IBITS(wall_flags_0(k,j,i),35,1) 3397 ibit34 = IBITS(wall_flags_0(k,j,i),34,1) 3398 ibit33 = IBITS(wall_flags_0(k,j,i),33,1) 3399 3400 k_ppp = k + 3 * ibit35 3401 k_pp = k + 2 * ( 1 - ibit33 ) 3402 k_mm = k - 2 * ibit35 3201 3403 3202 3404 w_comp = w(k+1,j,i) + w(k,j,i) 3203 3405 flux_t(k) = w_comp * ( & 3204 ( 37.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3205 + 7.0 * IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&3206 + IBITS(wall_flags_0(k,j,i),33,1) * adv_mom_1&3207 ) *&3406 ( 37.0 * ibit35 * adv_mom_5 & 3407 + 7.0 * ibit34 * adv_mom_3 & 3408 + ibit33 * adv_mom_1 & 3409 ) * & 3208 3410 ( w(k+1,j,i) + w(k,j,i) ) & 3209 - ( 8.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3210 + IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&3211 ) *&3411 - ( 8.0 * ibit35 * adv_mom_5 & 3412 + ibit34 * adv_mom_3 & 3413 ) * & 3212 3414 ( w(k_pp,j,i) + w(k-1,j,i) ) & 3213 + ( IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3214 ) *&3415 + ( ibit35 * adv_mom_5 & 3416 ) * & 3215 3417 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & 3216 3418 ) 3217 3419 3218 3420 diss_t(k) = - ABS( w_comp ) * ( & 3219 ( 10.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3220 + 3.0 * IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&3221 + IBITS(wall_flags_0(k,j,i),33,1) * adv_mom_1&3222 ) *&3421 ( 10.0 * ibit35 * adv_mom_5 & 3422 + 3.0 * ibit34 * adv_mom_3 & 3423 + ibit33 * adv_mom_1 & 3424 ) * & 3223 3425 ( w(k+1,j,i) - w(k,j,i) ) & 3224 - ( 5.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3225 + IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&3226 ) *&3426 - ( 5.0 * ibit35 * adv_mom_5 & 3427 + ibit34 * adv_mom_3 & 3428 ) * & 3227 3429 ( w(k_pp,j,i) - w(k-1,j,i) ) & 3228 + ( IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3229 ) *&3430 + ( ibit35 * adv_mom_5 & 3431 ) * & 3230 3432 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & 3231 3433 ) … … 3291 3493 !-- k index has to be modified near bottom and top, else array 3292 3494 !-- subscripts will be exceeded. 3293 k_ppp = k + 3 * IBITS(wall_flags_0(k,j,i),35,1) 3294 k_pp = k + 2 * ( 1 - IBITS(wall_flags_0(k,j,i),33,1) ) 3295 k_mm = k - 2 * IBITS(wall_flags_0(k,j,i),35,1) 3495 ibit35 = IBITS(wall_flags_0(k,j,i),35,1) 3496 ibit34 = IBITS(wall_flags_0(k,j,i),34,1) 3497 ibit33 = IBITS(wall_flags_0(k,j,i),33,1) 3498 3499 k_ppp = k + 3 * ibit35 3500 k_pp = k + 2 * ( 1 - ibit33 ) 3501 k_mm = k - 2 * ibit35 3296 3502 3297 3503 w_comp = w(k+1,j,i) + w(k,j,i) 3298 3504 flux_t(k) = w_comp * ( & 3299 ( 37.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3300 + 7.0 * IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&3301 + IBITS(wall_flags_0(k,j,i),33,1) * adv_mom_1&3302 ) *&3505 ( 37.0 * ibit35 * adv_mom_5 & 3506 + 7.0 * ibit34 * adv_mom_3 & 3507 + ibit33 * adv_mom_1 & 3508 ) * & 3303 3509 ( w(k+1,j,i) + w(k,j,i) ) & 3304 - ( 8.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3305 + IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&3306 ) *&3510 - ( 8.0 * ibit35 * adv_mom_5 & 3511 + ibit34 * adv_mom_3 & 3512 ) * & 3307 3513 ( w(k_pp,j,i) + w(k-1,j,i) ) & 3308 + ( IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3309 ) *&3514 + ( ibit35 * adv_mom_5 & 3515 ) * & 3310 3516 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & 3311 )3517 ) 3312 3518 3313 3519 diss_t(k) = - ABS( w_comp ) * ( & 3314 ( 10.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3315 + 3.0 * IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&3316 + IBITS(wall_flags_0(k,j,i),33,1) * adv_mom_1&3317 ) *&3520 ( 10.0 * ibit35 * adv_mom_5 & 3521 + 3.0 * ibit34 * adv_mom_3 & 3522 + ibit33 * adv_mom_1 & 3523 ) * & 3318 3524 ( w(k+1,j,i) - w(k,j,i) ) & 3319 - ( 5.0 * IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3320 + IBITS(wall_flags_0(k,j,i),34,1) * adv_mom_3&3321 ) *&3525 - ( 5.0 * ibit35 * adv_mom_5 & 3526 + ibit34 * adv_mom_3 & 3527 ) * & 3322 3528 ( w(k_pp,j,i) - w(k-1,j,i) ) & 3323 + ( IBITS(wall_flags_0(k,j,i),35,1) * adv_mom_5&3324 ) *&3529 + ( ibit35 * adv_mom_5 & 3530 ) * & 3325 3531 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & 3326 )3532 ) 3327 3533 ! 3328 3534 !-- Calculate the divergence of the velocity field. A respective
Note: See TracChangeset
for help on using the changeset viewer.
