Changeset 2232 for palm/trunk/SOURCE/advec_ws.f90
- Timestamp:
- May 30, 2017 5:47:52 PM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/advec_ws.f90 (modified) (99 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_ws.f90
r2201 r2232 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Rename wall_flags_0 and wall_flags_00 into advc_flags_1 and advc_flags_2, 23 ! respectively. 24 ! Set advc_flags_1/2 on basis of wall_flags_0/00 instead of nzb_s/u/v/w_inner. 25 ! Setting advc_flags_1/2 also for downward-facing walls 23 26 ! 24 27 ! Former revisions: … … 147 150 ! vector version. 148 151 ! Degradation of the applied order of scheme is now steered by multiplying with 149 ! Integer wall_flags_0. 2nd order scheme, WS3 and WS5 are calculated on each152 ! Integer advc_flags_1. 2nd order scheme, WS3 and WS5 are calculated on each 150 153 ! grid point and mulitplied with the appropriate flag. 151 154 ! 2nd order numerical dissipation term changed. Now the appropriate 2nd order … … 406 409 407 410 USE indices, & 408 ONLY: nbgp, nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzb_s_inner, & 409 nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt, wall_flags_0, & 410 wall_flags_00 411 ONLY: advc_flags_1, advc_flags_2, nbgp, nxl, nxlu, nxr, nyn, nys, & 412 nysv, nzb, nzt, wall_flags_0 411 413 412 414 USE kinds … … 414 416 IMPLICIT NONE 415 417 416 INTEGER(iwp) :: i !< index variable along x 417 INTEGER(iwp) :: j !< index variable along y 418 INTEGER(iwp) :: k !< index variable along z 419 418 INTEGER(iwp) :: i !< index variable along x 419 INTEGER(iwp) :: j !< index variable along y 420 INTEGER(iwp) :: k !< index variable along z 421 INTEGER(iwp) :: k_mm !< dummy index along z 422 INTEGER(iwp) :: k_pp !< dummy index along z 423 INTEGER(iwp) :: k_ppp !< dummy index along z 424 420 425 LOGICAL :: flag_set !< steering variable for advection flags 421 426 … … 425 430 !-- Set flags to steer the degradation of the advection scheme in advec_ws 426 431 !-- near topography, inflow- and outflow boundaries as well as bottom and 427 !-- top of model domain. wall_flags_0remains zero for all non-prognostic432 !-- top of model domain. advc_flags_1 remains zero for all non-prognostic 428 433 !-- grid points. 429 434 DO i = nxl, nxr 430 435 DO j = nys, nyn 431 DO k = nzb _s_inner(j,i)+1, nzt436 DO k = nzb+1, nzt 432 437 ! 433 438 !-- scalar - x-direction 434 439 !-- WS1 (0), WS3 (1), WS5 (2) 435 IF ( ( k <= nzb_s_inner(j,i+1) .OR. k <= nzb_s_inner(j,i+2) & 436 .OR. k <= nzb_s_inner(j,i-1) ) & 437 .OR. ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 438 .AND. i == nxl ) .OR. & 440 IF ( ( .NOT. BTEST(wall_flags_0(k,j,i+1),0) & 441 .OR. .NOT. BTEST(wall_flags_0(k,j,i+2),0) & 442 .OR. .NOT. BTEST(wall_flags_0(k,j,i-1),0) ) & 443 .OR. ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 444 .AND. i == nxl ) & 445 .OR. ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & 446 .AND. i == nxr ) ) & 447 THEN 448 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 0 ) 449 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+3),0) & 450 .AND. BTEST(wall_flags_0(k,j,i+1),0) & 451 .AND. BTEST(wall_flags_0(k,j,i+2),0) & 452 .AND. BTEST(wall_flags_0(k,j,i-1),0) & 453 ) .OR. & 454 ( .NOT. BTEST(wall_flags_0(k,j,i-2),0) & 455 .AND. BTEST(wall_flags_0(k,j,i+1),0) & 456 .AND. BTEST(wall_flags_0(k,j,i+2),0) & 457 .AND. BTEST(wall_flags_0(k,j,i-1),0) & 458 ) & 459 .OR. & 439 460 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & 440 .AND. i == nxr ) ) & 461 .AND. i == nxr-1 ) .OR. & 462 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 463 .AND. i == nxlu ) ) & 441 464 THEN 442 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 ) 443 ELSEIF ( ( k <= nzb_s_inner(j,i+3) .AND. k > nzb_s_inner(j,i+1)& 444 .AND. k > nzb_s_inner(j,i+2)& 445 .AND. k > nzb_s_inner(j,i-1)& 446 ) .OR. & 447 ( k <= nzb_s_inner(j,i-2) .AND. k > nzb_s_inner(j,i+1)& 448 .AND. k > nzb_s_inner(j,i+2)& 449 .AND. k > nzb_s_inner(j,i-1)& 450 ) & 451 .OR. & 452 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & 453 .AND. i == nxr-1 ) .OR. & 454 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 455 .AND. i == nxlu ) ) & 456 THEN 457 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 ) 458 ELSEIF ( k > nzb_s_inner(j,i+1) .AND. k > nzb_s_inner(j,i+2)& 459 .AND. k > nzb_s_inner(j,i+3) .AND. k > nzb_s_inner(j,i-1)& 460 .AND. k > nzb_s_inner(j,i-2) ) & 465 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 1 ) 466 ELSEIF ( BTEST(wall_flags_0(k,j,i+1),0) & 467 .AND. BTEST(wall_flags_0(k,j,i+2),0) & 468 .AND. BTEST(wall_flags_0(k,j,i+3),0) & 469 .AND. BTEST(wall_flags_0(k,j,i-1),0) & 470 .AND. BTEST(wall_flags_0(k,j,i-2),0) ) & 461 471 THEN 462 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 2 )472 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 2 ) 463 473 ENDIF 464 474 ! 465 475 !-- scalar - y-direction 466 476 !-- WS1 (3), WS3 (4), WS5 (5) 467 IF ( ( k <= nzb_s_inner(j+1,i) .OR. k <= nzb_s_inner(j+2,i) &468 .OR. k <= nzb_s_inner(j-1,i) ) &469 .OR.&470 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )&471 .AND. j == nys ) .OR.&472 ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )&473 .AND. j == nyn ) )&477 IF ( ( .NOT. BTEST(wall_flags_0(k,j+1,i),0) & 478 .OR. .NOT. BTEST(wall_flags_0(k,j+2,i),0) & 479 .OR. .NOT. BTEST(wall_flags_0(k,j-1,i),0)) & 480 .OR. ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 481 .AND. j == nys ) & 482 .OR. ( ( inflow_n .OR. outflow_n .OR. nest_bound_n ) & 483 .AND. j == nyn ) ) & 474 484 THEN 475 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 3 )485 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 3 ) 476 486 ! 477 487 !-- WS3 478 ELSEIF ( ( k <= nzb_s_inner(j+3,i) .AND. k > nzb_s_inner(j+1,i)& 479 .AND. k > nzb_s_inner(j+2,i)& 480 .AND. k > nzb_s_inner(j-1,i)& 481 ) .OR. & 482 ( k <= nzb_s_inner(j-2,i) .AND. k > nzb_s_inner(j+1,i)& 483 .AND. k > nzb_s_inner(j+2,i)& 484 .AND. k > nzb_s_inner(j-1,i)& 485 ) & 486 .OR. & 487 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 488 .AND. j == nysv ) .OR. & 489 ( ( inflow_n .OR. outflow_n .OR. nest_bound_n ) & 490 .AND. j == nyn-1 ) ) & 488 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+3,i),0) & 489 .AND. BTEST(wall_flags_0(k,j+1,i),0) & 490 .AND. BTEST(wall_flags_0(k,j+2,i),0) & 491 .AND. BTEST(wall_flags_0(k,j-1,i),0) & 492 ) .OR. & 493 ( .NOT. BTEST(wall_flags_0(k,j-2,i),0) & 494 .AND. BTEST(wall_flags_0(k,j+1,i),0) & 495 .AND. BTEST(wall_flags_0(k,j+2,i),0) & 496 .AND. BTEST(wall_flags_0(k,j-1,i),0) & 497 ) & 498 .OR. & 499 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 500 .AND. j == nysv ) .OR. & 501 ( ( inflow_n .OR. outflow_n .OR. nest_bound_n ) & 502 .AND. j == nyn-1 ) ) & 491 503 THEN 492 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 4 )504 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 4 ) 493 505 ! 494 506 !-- WS5 495 ELSEIF ( k > nzb_s_inner(j+1,i) .AND. k > nzb_s_inner(j+2,i)& 496 .AND. k > nzb_s_inner(j+3,i) .AND. k > nzb_s_inner(j-1,i)& 497 .AND. k > nzb_s_inner(j-2,i) ) & 507 ELSEIF ( BTEST(wall_flags_0(k,j+1,i),0) & 508 .AND. BTEST(wall_flags_0(k,j+2,i),0) & 509 .AND. BTEST(wall_flags_0(k,j+3,i),0) & 510 .AND. BTEST(wall_flags_0(k,j-1,i),0) & 511 .AND. BTEST(wall_flags_0(k,j-2,i),0) ) & 498 512 THEN 499 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 5 )513 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 5 ) 500 514 ENDIF 501 515 ! 502 516 !-- scalar - z-direction 503 517 !-- WS1 (6), WS3 (7), WS5 (8) 518 IF ( k == nzb+1 ) THEN 519 k_mm = nzb 520 ELSE 521 k_mm = k - 2 522 ENDIF 523 IF ( k > nzt-1 ) THEN 524 k_pp = nzt+1 525 ELSE 526 k_pp = k + 2 527 ENDIF 528 IF ( k > nzt-2 ) THEN 529 k_ppp = nzt+1 530 ELSE 531 k_ppp = k + 3 532 ENDIF 533 504 534 flag_set = .FALSE. 505 IF ( k == nzb_s_inner(j,i) + 1 .OR. k == nzt ) THEN 506 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 6 ) 535 IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),0) .AND. & 536 BTEST(wall_flags_0(k,j,i),0) .OR. & 537 .NOT. BTEST(wall_flags_0(k_pp,j,i),0) .AND. & 538 BTEST(wall_flags_0(k,j,i),0) .OR. & 539 k == nzt ) & 540 THEN 541 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 6 ) 507 542 flag_set = .TRUE. 508 ELSEIF ( k == nzb_s_inner(j,i) + 2 .OR. k == nzt - 1 ) THEN 509 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 7 ) 543 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),0) .OR. & 544 .NOT. BTEST(wall_flags_0(k_ppp,j,i),0) ) .AND. & 545 BTEST(wall_flags_0(k-1,j,i),0) .AND. & 546 BTEST(wall_flags_0(k,j,i),0) .AND. & 547 BTEST(wall_flags_0(k+1,j,i),0) .AND. & 548 BTEST(wall_flags_0(k_pp,j,i),0) .OR. & 549 k == nzt - 1 ) & 550 THEN 551 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 7 ) 510 552 flag_set = .TRUE. 511 ELSEIF ( k > nzb_s_inner(j,i) .AND. .NOT. flag_set ) THEN 512 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 8 ) 553 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),0) & 554 .AND. BTEST(wall_flags_0(k-1,j,i),0) & 555 .AND. BTEST(wall_flags_0(k,j,i),0) & 556 .AND. BTEST(wall_flags_0(k+1,j,i),0) & 557 .AND. BTEST(wall_flags_0(k_pp,j,i),0) & 558 .AND. BTEST(wall_flags_0(k_ppp,j,i),0) & 559 .AND. .NOT. flag_set ) & 560 THEN 561 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 8 ) 513 562 ENDIF 514 563 … … 520 569 IF ( momentum_advec == 'ws-scheme' ) THEN 521 570 ! 522 !-- Set wall_flags_0to steer the degradation of the advection scheme in advec_ws571 !-- Set advc_flags_1 to steer the degradation of the advection scheme in advec_ws 523 572 !-- near topography, inflow- and outflow boundaries as well as bottom and 524 !-- top of model domain. wall_flags_0remains zero for all non-prognostic573 !-- top of model domain. advc_flags_1 remains zero for all non-prognostic 525 574 !-- grid points. 526 575 DO i = nxl, nxr … … 532 581 !-- in order to handle the left/south flux. 533 582 !-- near vertical walls. 534 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 9 )535 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )583 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 9 ) 584 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 12 ) 536 585 ! 537 586 !-- u component - x-direction 538 587 !-- WS1 (9), WS3 (10), WS5 (11) 539 IF ( k <= nzb_u_inner(j,i+1) .OR.&588 IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),1) .OR. & 540 589 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 541 590 .AND. i <= nxlu ) .OR. & … … 543 592 .AND. i == nxr ) ) & 544 593 THEN 545 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 9 )546 ELSEIF ( ( k <= nzb_u_inner(j,i+2) .AND.&547 k > nzb_u_inner(j,i+1) ) .OR.&548 k <= nzb_u_inner(j,i-1)&594 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 9 ) 595 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),1) .AND. & 596 BTEST(wall_flags_0(k,j,i+1),1) .OR. & 597 .NOT. BTEST(wall_flags_0(k,j,i-1),1) ) & 549 598 .OR. & 550 599 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 553 602 .AND. i == nxlu+1) ) & 554 603 THEN 555 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 10 )604 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 10 ) 556 605 ! 557 606 !-- Clear flag for WS1 558 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 9 ) 559 ELSEIF ( k > nzb_u_inner(j,i+1) .AND. k > nzb_u_inner(j,i+2) & 560 .AND. k > nzb_u_inner(j,i-1) ) & 607 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 9 ) 608 ELSEIF ( BTEST(wall_flags_0(k,j,i+1),1) .AND. & 609 BTEST(wall_flags_0(k,j,i+2),1) .AND. & 610 BTEST(wall_flags_0(k,j,i-1),1) ) & 561 611 THEN 562 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 11 )612 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 11 ) 563 613 ! 564 614 !-- Clear flag for WS1 565 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 9 )615 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 9 ) 566 616 ENDIF 567 617 ! 568 618 !-- u component - y-direction 569 619 !-- WS1 (12), WS3 (13), WS5 (14) 570 IF ( k <= nzb_u_inner(j+1,i) .OR.&620 IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),1) .OR. & 571 621 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 572 622 .AND. j == nys ) .OR. & … … 574 624 .AND. j == nyn ) ) & 575 625 THEN 576 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )577 ELSEIF ( ( k <= nzb_u_inner(j+2,i) .AND.&578 k > nzb_u_inner(j+1,i) ) .OR.&579 k <= nzb_u_inner(j-1,i)&626 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 12 ) 627 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),1) .AND. & 628 BTEST(wall_flags_0(k,j+1,i),1) .OR. & 629 .NOT. BTEST(wall_flags_0(k,j-1,i),1) ) & 580 630 .OR. & 581 631 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & … … 584 634 .AND. j == nyn-1 ) ) & 585 635 THEN 586 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 13 )636 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 13 ) 587 637 ! 588 638 !-- Clear flag for WS1 589 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 12 ) 590 ELSEIF ( k > nzb_u_inner(j+1,i) .AND. k > nzb_u_inner(j+2,i) & 591 .AND. k > nzb_u_inner(j-1,i) ) & 639 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 12 ) 640 ELSEIF ( BTEST(wall_flags_0(k,j+1,i),1) .AND. & 641 BTEST(wall_flags_0(k,j+2,i),1) .AND. & 642 BTEST(wall_flags_0(k,j-1,i),1) ) & 592 643 THEN 593 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 14 )644 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 14 ) 594 645 ! 595 646 !-- Clear flag for WS1 596 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 12 )647 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 12 ) 597 648 ENDIF 598 649 ! 599 650 !-- u component - z-direction 600 651 !-- WS1 (15), WS3 (16), WS5 (17) 652 IF ( k == nzb+1 ) THEN 653 k_mm = nzb 654 ELSE 655 k_mm = k - 2 656 ENDIF 657 IF ( k > nzt-1 ) THEN 658 k_pp = nzt+1 659 ELSE 660 k_pp = k + 2 661 ENDIF 662 IF ( k > nzt-2 ) THEN 663 k_ppp = nzt+1 664 ELSE 665 k_ppp = k + 3 666 ENDIF 667 601 668 flag_set = .FALSE. 602 IF ( k == nzb_u_inner(j,i) + 1 .OR. k == nzt ) THEN 603 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 15 ) 669 IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),1) .AND. & 670 BTEST(wall_flags_0(k,j,i),1) .OR. & 671 .NOT. BTEST(wall_flags_0(k_pp,j,i),1) .AND. & 672 BTEST(wall_flags_0(k,j,i),1) .OR. & 673 k == nzt ) & 674 THEN 675 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 15 ) 676 flag_set = .TRUE. 677 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),1) .OR. & 678 .NOT. BTEST(wall_flags_0(k_ppp,j,i),1) ) .AND. & 679 BTEST(wall_flags_0(k-1,j,i),1) .AND. & 680 BTEST(wall_flags_0(k,j,i),1) .AND. & 681 BTEST(wall_flags_0(k+1,j,i),1) .AND. & 682 BTEST(wall_flags_0(k_pp,j,i),1) .OR. & 683 k == nzt - 1 ) & 684 THEN 685 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 16 ) 604 686 flag_set = .TRUE. 605 ELSEIF ( k == nzb_u_inner(j,i) + 2 .OR. k == nzt - 1 ) THEN 606 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 16 ) 607 flag_set = .TRUE. 608 ELSEIF ( k > nzb_u_inner(j,i) .AND. .NOT. flag_set ) THEN 609 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 17 ) 687 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),1) .AND. & 688 BTEST(wall_flags_0(k-1,j,i),1) .AND. & 689 BTEST(wall_flags_0(k,j,i),1) .AND. & 690 BTEST(wall_flags_0(k+1,j,i),1) .AND. & 691 BTEST(wall_flags_0(k_pp,j,i),1) .AND. & 692 BTEST(wall_flags_0(k_ppp,j,i),1) .AND. & 693 .NOT. flag_set ) & 694 THEN 695 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 17 ) 610 696 ENDIF 611 697 … … 621 707 !-- Since fluxes are swapped in advec_ws.f90, this is necessary to 622 708 !-- in order to handle the left/south flux. 623 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )624 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )709 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 18 ) 710 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 21 ) 625 711 ! 626 712 !-- v component - x-direction 627 713 !-- WS1 (18), WS3 (19), WS5 (20) 628 IF ( k <= nzb_v_inner(j,i+1) .OR.&714 IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),2) .OR. & 629 715 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 630 716 .AND. i == nxl ) .OR. & … … 632 718 .AND. i == nxr ) ) & 633 719 THEN 634 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )720 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 18 ) 635 721 ! 636 722 !-- WS3 637 ELSEIF ( ( k <= nzb_v_inner(j,i+2) .AND.&638 k > nzb_v_inner(j,i+1) ) .OR.&639 k <= nzb_v_inner(j,i-1)&723 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),2) .AND. & 724 BTEST(wall_flags_0(k,j,i+1),2) ) .OR. & 725 .NOT. BTEST(wall_flags_0(k,j,i-1),2) & 640 726 .OR. & 641 727 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 644 730 .AND. i == nxlu ) ) & 645 731 THEN 646 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 19 )732 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 19 ) 647 733 ! 648 734 !-- Clear flag for WS1 649 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 18 ) 650 ELSEIF ( k > nzb_v_inner(j,i+1) .AND. k > nzb_v_inner(j,i+2) & 651 .AND. k > nzb_v_inner(j,i-1) ) & 735 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 18 ) 736 ELSEIF ( BTEST(wall_flags_0(k,j,i+1),2) .AND. & 737 BTEST(wall_flags_0(k,j,i+2),2) .AND. & 738 BTEST(wall_flags_0(k,j,i-1),2) ) & 652 739 THEN 653 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 20 )740 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 20 ) 654 741 ! 655 742 !-- Clear flag for WS1 656 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 18 )743 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 18 ) 657 744 ENDIF 658 745 ! 659 746 !-- v component - y-direction 660 747 !-- WS1 (21), WS3 (22), WS5 (23) 661 IF ( k <= nzb_v_inner(j+1,i) .OR.&748 IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),2) .OR. & 662 749 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 663 750 .AND. j <= nysv ) .OR. & … … 665 752 .AND. j == nyn ) ) & 666 753 THEN 667 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )668 ELSEIF ( ( k <= nzb_v_inner(j+2,i) .AND.&669 k > nzb_v_inner(j+1,i) ) .OR.&670 k <= nzb_v_inner(j-1,i)&754 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 21 ) 755 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),2) .AND. & 756 BTEST(wall_flags_0(k,j+1,i),2) .OR. & 757 .NOT. BTEST(wall_flags_0(k,j-1,i),2) ) & 671 758 .OR. & 672 759 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & … … 675 762 .AND. j == nyn-1 ) ) & 676 763 THEN 677 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 22 )764 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 22 ) 678 765 ! 679 766 !-- Clear flag for WS1 680 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 21 ) 681 ELSEIF ( k > nzb_v_inner(j+1,i) .AND. k > nzb_v_inner(j+2,i) & 682 .AND. k > nzb_v_inner(j-1,i) ) & 767 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 21 ) 768 ELSEIF ( BTEST(wall_flags_0(k,j+1,i),2) .AND. & 769 BTEST(wall_flags_0(k,j+2,i),2) .AND. & 770 BTEST(wall_flags_0(k,j-1,i),2) ) & 683 771 THEN 684 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )772 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 23 ) 685 773 ! 686 774 !-- Clear flag for WS1 687 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 21 )775 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 21 ) 688 776 ENDIF 689 777 ! 690 778 !-- v component - z-direction 691 779 !-- WS1 (24), WS3 (25), WS5 (26) 780 IF ( k == nzb+1 ) THEN 781 k_mm = nzb 782 ELSE 783 k_mm = k - 2 784 ENDIF 785 IF ( k > nzt-1 ) THEN 786 k_pp = nzt+1 787 ELSE 788 k_pp = k + 2 789 ENDIF 790 IF ( k > nzt-2 ) THEN 791 k_ppp = nzt+1 792 ELSE 793 k_ppp = k + 3 794 ENDIF 795 692 796 flag_set = .FALSE. 693 IF ( k == nzb_v_inner(j,i) + 1 .OR. k == nzt ) THEN 694 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 24 ) 797 IF ( .NOT. BTEST(wall_flags_0(k-1,j,i),2) .AND. & 798 BTEST(wall_flags_0(k,j,i),2) .OR. & 799 .NOT. BTEST(wall_flags_0(k_pp,j,i),2) .AND. & 800 BTEST(wall_flags_0(k,j,i),2) .OR. & 801 k == nzt ) & 802 THEN 803 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 24 ) 695 804 flag_set = .TRUE. 696 ELSEIF ( k == nzb_v_inner(j,i) + 2 .OR. k == nzt - 1 ) THEN 697 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 25 ) 805 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),2) .OR. & 806 .NOT. BTEST(wall_flags_0(k_ppp,j,i),2) ) .AND. & 807 BTEST(wall_flags_0(k-1,j,i),2) .AND. & 808 BTEST(wall_flags_0(k,j,i),2) .AND. & 809 BTEST(wall_flags_0(k+1,j,i),2) .AND. & 810 BTEST(wall_flags_0(k_pp,j,i),2) .OR. & 811 k == nzt - 1 ) & 812 THEN 813 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 25 ) 698 814 flag_set = .TRUE. 699 ELSEIF ( k > nzb_v_inner(j,i) .AND. .NOT. flag_set ) THEN 700 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 26 ) 815 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),2) .AND. & 816 BTEST(wall_flags_0(k-1,j,i),2) .AND. & 817 BTEST(wall_flags_0(k,j,i),2) .AND. & 818 BTEST(wall_flags_0(k+1,j,i),2) .AND. & 819 BTEST(wall_flags_0(k_pp,j,i),2) .AND. & 820 BTEST(wall_flags_0(k_ppp,j,i),2) .AND. & 821 .NOT. flag_set ) & 822 THEN 823 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 26 ) 701 824 ENDIF 702 825 … … 711 834 !-- Since fluxes are swapped in advec_ws.f90, this is necessary to 712 835 !-- in order to handle the left/south flux. 713 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )714 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )836 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 27 ) 837 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 30 ) 715 838 ! 716 839 !-- w component - x-direction 717 840 !-- WS1 (27), WS3 (28), WS5 (29) 718 IF ( k <= nzb_w_inner(j,i+1) .OR.&841 IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),3) .OR. & 719 842 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 720 843 .AND. i == nxl ) .OR. & … … 722 845 .AND. i == nxr ) ) & 723 846 THEN 724 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )725 ELSEIF ( ( k <= nzb_w_inner(j,i+2) .AND.&726 k > nzb_w_inner(j,i+1) ) .OR.&727 k <= nzb_w_inner(j,i-1)&847 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 27 ) 848 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j,i+2),3) .AND. & 849 BTEST(wall_flags_0(k,j,i+1),3) .OR. & 850 .NOT. BTEST(wall_flags_0(k,j,i-1),3) ) & 728 851 .OR. & 729 852 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 732 855 .AND. i == nxlu ) ) & 733 856 THEN 734 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 28 )857 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 28 ) 735 858 ! 736 859 !-- Clear flag for WS1 737 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 27 ) 738 ELSEIF ( k > nzb_w_inner(j,i+1) .AND. k > nzb_w_inner(j,i+2) & 739 .AND. k > nzb_w_inner(j,i-1) ) & 860 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 27 ) 861 ELSEIF ( BTEST(wall_flags_0(k,j,i+1),3) .AND. & 862 BTEST(wall_flags_0(k,j,i+2),3) .AND. & 863 BTEST(wall_flags_0(k,j,i-1),3) ) & 740 864 THEN 741 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i),29 )865 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i),29 ) 742 866 ! 743 867 !-- Clear flag for WS1 744 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 27 )868 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 27 ) 745 869 ENDIF 746 870 ! 747 871 !-- w component - y-direction 748 872 !-- WS1 (30), WS3 (31), WS5 (32) 749 IF ( k <= nzb_w_inner(j+1,i) .OR.&873 IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),3) .OR. & 750 874 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 751 875 .AND. j == nys ) .OR. & … … 753 877 .AND. j == nyn ) ) & 754 878 THEN 755 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )756 ELSEIF ( ( k <= nzb_w_inner(j+2,i) .AND.&757 k > nzb_w_inner(j+1,i) ) .OR.&758 k <= nzb_w_inner(j-1,i)&879 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 30 ) 880 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k,j+2,i),3) .AND. & 881 BTEST(wall_flags_0(k,j+1,i),3) .OR. & 882 .NOT. BTEST(wall_flags_0(k,j-1,i),3) ) & 759 883 .OR. & 760 884 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & … … 763 887 .AND. j == nyn-1 ) ) & 764 888 THEN 765 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 31 )889 advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 31 ) 766 890 ! 767 891 !-- Clear flag for WS1 768 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 30 ) 769 ELSEIF ( k > nzb_w_inner(j+1,i) .AND. k > nzb_w_inner(j+2,i) & 770 .AND. k > nzb_w_inner(j-1,i) ) & 892 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 30 ) 893 ELSEIF ( BTEST(wall_flags_0(k,j+1,i),3) .AND. & 894 BTEST(wall_flags_0(k,j+2,i),3) .AND. & 895 BTEST(wall_flags_0(k,j-1,i),3) ) & 771 896 THEN 772 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 0 )897 advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 0 ) 773 898 ! 774 899 !-- Clear flag for WS1 775 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 30 )900 advc_flags_1(k,j,i) = IBCLR( advc_flags_1(k,j,i), 30 ) 776 901 ENDIF 777 902 ! … … 779 904 !-- WS1 (33), WS3 (34), WS5 (35) 780 905 flag_set = .FALSE. 781 IF ( k == nzb_w_inner(j,i) .OR. k == nzb_w_inner(j,i) + 1 & 782 .OR. k == nzt ) THEN 906 IF ( k == nzb+1 ) THEN 907 k_mm = nzb 908 ELSE 909 k_mm = k - 2 910 ENDIF 911 IF ( k > nzt-1 ) THEN 912 k_pp = nzt+1 913 ELSE 914 k_pp = k + 2 915 ENDIF 916 IF ( k > nzt-2 ) THEN 917 k_ppp = nzt+1 918 ELSE 919 k_ppp = k + 3 920 ENDIF 921 922 IF ( ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 923 .NOT. BTEST(wall_flags_0(k,j,i),3) .AND. & 924 BTEST(wall_flags_0(k+1,j,i),3) ) .OR. & 925 ( .NOT. BTEST(wall_flags_0(k-1,j,i),3) .AND. & 926 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 927 ( .NOT. BTEST(wall_flags_0(k+1,j,i),3) .AND. & 928 BTEST(wall_flags_0(k,j,i),3) ) .OR. & 929 k == nzt ) & 930 THEN 783 931 ! 784 932 !-- Please note, at k == nzb_w_inner(j,i) a flag is explictely … … 787 935 !-- because flux_t(nzb_w_inner(j,i)) is used for the tendency 788 936 !-- at k == nzb_w_inner(j,i)+1. 789 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 1 )937 advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 1 ) 790 938 flag_set = .TRUE. 791 ELSEIF ( k == nzb_w_inner(j,i) + 2 .OR. k == nzt - 1 ) THEN 792 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 2 ) 939 ELSEIF ( ( .NOT. BTEST(wall_flags_0(k_mm,j,i),3) .OR. & 940 .NOT. BTEST(wall_flags_0(k_ppp,j,i),3) ) .AND. & 941 BTEST(wall_flags_0(k-1,j,i),3) .AND. & 942 BTEST(wall_flags_0(k,j,i),3) .AND. & 943 BTEST(wall_flags_0(k+1,j,i),3) .OR. & 944 k == nzt - 1 ) & 945 THEN 946 advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 2 ) 793 947 flag_set = .TRUE. 794 ELSEIF ( k > nzb_w_inner(j,i) .AND. .NOT. flag_set ) THEN 795 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 3 ) 948 ELSEIF ( BTEST(wall_flags_0(k_mm,j,i),3) .AND. & 949 BTEST(wall_flags_0(k-1,j,i),3) .AND. & 950 BTEST(wall_flags_0(k,j,i),3) .AND. & 951 BTEST(wall_flags_0(k+1,j,i),3) .AND. & 952 BTEST(wall_flags_0(k_pp,j,i),3) .AND. & 953 BTEST(wall_flags_0(k_ppp,j,i),3) .AND. & 954 .NOT. flag_set ) & 955 THEN 956 advc_flags_2(k,j,i) = IBSET( advc_flags_2(k,j,i), 3 ) 796 957 ENDIF 797 958 … … 809 970 ! 810 971 !-- Exchange ghost points for advection flags 811 CALL exchange_horiz_int( wall_flags_0,nbgp )812 CALL exchange_horiz_int( wall_flags_00, nbgp )972 CALL exchange_horiz_int( advc_flags_1, nbgp ) 973 CALL exchange_horiz_int( advc_flags_2, nbgp ) 813 974 ! 814 975 !-- Set boundary flags at inflow and outflow boundary in case of 815 976 !-- non-cyclic boundary conditions. 816 977 IF ( inflow_l .OR. outflow_l .OR. nest_bound_l ) THEN 817 wall_flags_0(:,:,nxl-1) = wall_flags_0(:,:,nxl)818 wall_flags_00(:,:,nxl-1) = wall_flags_00(:,:,nxl)978 advc_flags_1(:,:,nxl-1) = advc_flags_1(:,:,nxl) 979 advc_flags_2(:,:,nxl-1) = advc_flags_2(:,:,nxl) 819 980 ENDIF 820 981 821 982 IF ( inflow_r .OR. outflow_r .OR. nest_bound_r ) THEN 822 wall_flags_0(:,:,nxr+1) = wall_flags_0(:,:,nxr)823 wall_flags_00(:,:,nxr+1) = wall_flags_00(:,:,nxr)983 advc_flags_1(:,:,nxr+1) = advc_flags_1(:,:,nxr) 984 advc_flags_2(:,:,nxr+1) = advc_flags_2(:,:,nxr) 824 985 ENDIF 825 986 826 987 IF ( inflow_n .OR. outflow_n .OR. nest_bound_n ) THEN 827 wall_flags_0(:,nyn+1,:) = wall_flags_0(:,nyn,:)828 wall_flags_00(:,nyn+1,:) = wall_flags_00(:,nyn,:)988 advc_flags_1(:,nyn+1,:) = advc_flags_1(:,nyn,:) 989 advc_flags_2(:,nyn+1,:) = advc_flags_2(:,nyn,:) 829 990 ENDIF 830 991 831 992 IF ( inflow_s .OR. outflow_s .OR. nest_bound_s ) THEN 832 wall_flags_0(:,nys-1,:) = wall_flags_0(:,nys,:)833 wall_flags_00(:,nys-1,:) = wall_flags_00(:,nys,:)993 advc_flags_1(:,nys-1,:) = advc_flags_1(:,nys,:) 994 advc_flags_2(:,nys-1,:) = advc_flags_2(:,nys,:) 834 995 ENDIF 835 996 … … 910 1071 USE indices, & 911 1072 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, & 912 nzt, wall_flags_01073 nzt, advc_flags_1 913 1074 914 1075 USE kinds … … 976 1137 DO k = nzb+1, nzb_max 977 1138 978 ibit5 = IBITS( wall_flags_0(k,j-1,i),5,1)979 ibit4 = IBITS( wall_flags_0(k,j-1,i),4,1)980 ibit3 = IBITS( wall_flags_0(k,j-1,i),3,1)1139 ibit5 = IBITS(advc_flags_1(k,j-1,i),5,1) 1140 ibit4 = IBITS(advc_flags_1(k,j-1,i),4,1) 1141 ibit3 = IBITS(advc_flags_1(k,j-1,i),3,1) 981 1142 982 1143 v_comp = v(k,j,i) - v_gtrans … … 1037 1198 DO k = nzb+1, nzb_max 1038 1199 1039 ibit2 = IBITS( wall_flags_0(k,j,i-1),2,1)1040 ibit1 = IBITS( wall_flags_0(k,j,i-1),1,1)1041 ibit0 = IBITS( wall_flags_0(k,j,i-1),0,1)1200 ibit2 = IBITS(advc_flags_1(k,j,i-1),2,1) 1201 ibit1 = IBITS(advc_flags_1(k,j,i-1),1,1) 1202 ibit0 = IBITS(advc_flags_1(k,j,i-1),0,1) 1042 1203 1043 1204 u_comp = u(k,j,i) - u_gtrans … … 1106 1267 !-- flux at the end. 1107 1268 1108 ibit2 = IBITS( wall_flags_0(k,j,i),2,1)1109 ibit1 = IBITS( wall_flags_0(k,j,i),1,1)1110 ibit0 = IBITS( wall_flags_0(k,j,i),0,1)1269 ibit2 = IBITS(advc_flags_1(k,j,i),2,1) 1270 ibit1 = IBITS(advc_flags_1(k,j,i),1,1) 1271 ibit0 = IBITS(advc_flags_1(k,j,i),0,1) 1111 1272 1112 1273 u_comp = u(k,j,i+1) - u_gtrans … … 1141 1302 ) 1142 1303 1143 ibit5 = IBITS( wall_flags_0(k,j,i),5,1)1144 ibit4 = IBITS( wall_flags_0(k,j,i),4,1)1145 ibit3 = IBITS( wall_flags_0(k,j,i),3,1)1304 ibit5 = IBITS(advc_flags_1(k,j,i),5,1) 1305 ibit4 = IBITS(advc_flags_1(k,j,i),4,1) 1306 ibit3 = IBITS(advc_flags_1(k,j,i),3,1) 1146 1307 1147 1308 v_comp = v(k,j+1,i) - v_gtrans … … 1178 1339 !-- k index has to be modified near bottom and top, else array 1179 1340 !-- subscripts will be exceeded. 1180 ibit8 = IBITS( wall_flags_0(k,j,i),8,1)1181 ibit7 = IBITS( wall_flags_0(k,j,i),7,1)1182 ibit6 = IBITS( wall_flags_0(k,j,i),6,1)1341 ibit8 = IBITS(advc_flags_1(k,j,i),8,1) 1342 ibit7 = IBITS(advc_flags_1(k,j,i),7,1) 1343 ibit6 = IBITS(advc_flags_1(k,j,i),6,1) 1183 1344 1184 1345 k_ppp = k + 3 * ibit8 … … 1220 1381 !-- by a not sufficient reduction of divergences near topography. 1221 1382 div = ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 ) & 1222 - u(k,j,i) * ( IBITS( wall_flags_0(k,j,i-1),0,1) &1223 + IBITS( wall_flags_0(k,j,i-1),1,1) &1224 + IBITS( wall_flags_0(k,j,i-1),2,1) &1383 - u(k,j,i) * ( IBITS(advc_flags_1(k,j,i-1),0,1) & 1384 + IBITS(advc_flags_1(k,j,i-1),1,1) & 1385 + IBITS(advc_flags_1(k,j,i-1),2,1) & 1225 1386 ) & 1226 1387 ) * rho_air(k) * ddx & 1227 1388 + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 ) & 1228 - v(k,j,i) * ( IBITS( wall_flags_0(k,j-1,i),3,1) &1229 + IBITS( wall_flags_0(k,j-1,i),4,1) &1230 + IBITS( wall_flags_0(k,j-1,i),5,1) &1389 - v(k,j,i) * ( IBITS(advc_flags_1(k,j-1,i),3,1) & 1390 + IBITS(advc_flags_1(k,j-1,i),4,1) & 1391 + IBITS(advc_flags_1(k,j-1,i),5,1) & 1231 1392 ) & 1232 1393 ) * rho_air(k) * ddy & … … 1234 1395 ( ibit6 + ibit7 + ibit8 ) & 1235 1396 - w(k-1,j,i) * rho_air_zw(k-1) * & 1236 ( IBITS( wall_flags_0(k-1,j,i),6,1) &1237 + IBITS( wall_flags_0(k-1,j,i),7,1) &1238 + IBITS( wall_flags_0(k-1,j,i),8,1) &1397 ( IBITS(advc_flags_1(k-1,j,i),6,1) & 1398 + IBITS(advc_flags_1(k-1,j,i),7,1) & 1399 + IBITS(advc_flags_1(k-1,j,i),8,1) & 1239 1400 ) & 1240 1401 ) * ddzw(k) … … 1287 1448 !-- k index has to be modified near bottom and top, else array 1288 1449 !-- subscripts will be exceeded. 1289 ibit8 = IBITS( wall_flags_0(k,j,i),8,1)1290 ibit7 = IBITS( wall_flags_0(k,j,i),7,1)1291 ibit6 = IBITS( wall_flags_0(k,j,i),6,1)1450 ibit8 = IBITS(advc_flags_1(k,j,i),8,1) 1451 ibit7 = IBITS(advc_flags_1(k,j,i),7,1) 1452 ibit6 = IBITS(advc_flags_1(k,j,i),6,1) 1292 1453 1293 1454 k_ppp = k + 3 * ibit8 … … 1450 1611 1451 1612 USE indices, & 1452 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_01613 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1 1453 1614 1454 1615 USE kinds … … 1502 1663 DO k = nzb+1, nzb_max 1503 1664 1504 ibit14 = IBITS( wall_flags_0(k,j-1,i),14,1)1505 ibit13 = IBITS( wall_flags_0(k,j-1,i),13,1)1506 ibit12 = IBITS( wall_flags_0(k,j-1,i),12,1)1665 ibit14 = IBITS(advc_flags_1(k,j-1,i),14,1) 1666 ibit13 = IBITS(advc_flags_1(k,j-1,i),13,1) 1667 ibit12 = IBITS(advc_flags_1(k,j-1,i),12,1) 1507 1668 1508 1669 v_comp = v(k,j,i) + v(k,j,i-1) - gv … … 1560 1721 DO k = nzb+1, nzb_max 1561 1722 1562 ibit11 = IBITS( wall_flags_0(k,j,i-1),11,1)1563 ibit10 = IBITS( wall_flags_0(k,j,i-1),10,1)1564 ibit9 = IBITS( wall_flags_0(k,j,i-1),9,1)1723 ibit11 = IBITS(advc_flags_1(k,j,i-1),11,1) 1724 ibit10 = IBITS(advc_flags_1(k,j,i-1),10,1) 1725 ibit9 = IBITS(advc_flags_1(k,j,i-1),9,1) 1565 1726 1566 1727 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu … … 1622 1783 DO k = nzb+1, nzb_max 1623 1784 1624 ibit11 = IBITS( wall_flags_0(k,j,i),11,1)1625 ibit10 = IBITS( wall_flags_0(k,j,i),10,1)1626 ibit9 = IBITS( wall_flags_0(k,j,i),9,1)1785 ibit11 = IBITS(advc_flags_1(k,j,i),11,1) 1786 ibit10 = IBITS(advc_flags_1(k,j,i),10,1) 1787 ibit9 = IBITS(advc_flags_1(k,j,i),9,1) 1627 1788 1628 1789 u_comp(k) = u(k,j,i+1) + u(k,j,i) … … 1657 1818 ) 1658 1819 1659 ibit14 = IBITS( wall_flags_0(k,j,i),14,1)1660 ibit13 = IBITS( wall_flags_0(k,j,i),13,1)1661 ibit12 = IBITS( wall_flags_0(k,j,i),12,1)1820 ibit14 = IBITS(advc_flags_1(k,j,i),14,1) 1821 ibit13 = IBITS(advc_flags_1(k,j,i),13,1) 1822 ibit12 = IBITS(advc_flags_1(k,j,i),12,1) 1662 1823 1663 1824 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv … … 1694 1855 !-- k index has to be modified near bottom and top, else array 1695 1856 !-- subscripts will be exceeded. 1696 ibit17 = IBITS( wall_flags_0(k,j,i),17,1)1697 ibit16 = IBITS( wall_flags_0(k,j,i),16,1)1698 ibit15 = IBITS( wall_flags_0(k,j,i),15,1)1857 ibit17 = IBITS(advc_flags_1(k,j,i),17,1) 1858 ibit16 = IBITS(advc_flags_1(k,j,i),16,1) 1859 ibit15 = IBITS(advc_flags_1(k,j,i),15,1) 1699 1860 1700 1861 k_ppp = k + 3 * ibit17 … … 1738 1899 div = ( ( u_comp(k) * ( ibit9 + ibit10 + ibit11 ) & 1739 1900 - ( u(k,j,i) + u(k,j,i-1) ) & 1740 * ( IBITS( wall_flags_0(k,j,i-1),9,1) &1741 + IBITS( wall_flags_0(k,j,i-1),10,1) &1742 + IBITS( wall_flags_0(k,j,i-1),11,1) &1901 * ( IBITS(advc_flags_1(k,j,i-1),9,1) & 1902 + IBITS(advc_flags_1(k,j,i-1),10,1) & 1903 + IBITS(advc_flags_1(k,j,i-1),11,1) & 1743 1904 ) & 1744 1905 ) * rho_air(k) * ddx & 1745 1906 + ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 ) & 1746 1907 - ( v(k,j,i) + v(k,j,i-1 ) ) & 1747 * ( IBITS( wall_flags_0(k,j-1,i),12,1) &1748 + IBITS( wall_flags_0(k,j-1,i),13,1) &1749 + IBITS( wall_flags_0(k,j-1,i),14,1) &1908 * ( IBITS(advc_flags_1(k,j-1,i),12,1) & 1909 + IBITS(advc_flags_1(k,j-1,i),13,1) & 1910 + IBITS(advc_flags_1(k,j-1,i),14,1) & 1750 1911 ) & 1751 1912 ) * rho_air(k) * ddy & 1752 1913 + ( w_comp * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 ) & 1753 1914 - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & 1754 * ( IBITS( wall_flags_0(k-1,j,i),15,1) &1755 + IBITS( wall_flags_0(k-1,j,i),16,1) &1756 + IBITS( wall_flags_0(k-1,j,i),17,1) &1915 * ( IBITS(advc_flags_1(k-1,j,i),15,1) & 1916 + IBITS(advc_flags_1(k-1,j,i),16,1) & 1917 + IBITS(advc_flags_1(k-1,j,i),17,1) & 1757 1918 ) & 1758 1919 ) * ddzw(k) & … … 1823 1984 !-- k index has to be modified near bottom and top, else array 1824 1985 !-- subscripts will be exceeded. 1825 ibit17 = IBITS( wall_flags_0(k,j,i),17,1)1826 ibit16 = IBITS( wall_flags_0(k,j,i),16,1)1827 ibit15 = IBITS( wall_flags_0(k,j,i),15,1)1986 ibit17 = IBITS(advc_flags_1(k,j,i),17,1) 1987 ibit16 = IBITS(advc_flags_1(k,j,i),16,1) 1988 ibit15 = IBITS(advc_flags_1(k,j,i),15,1) 1828 1989 1829 1990 k_ppp = k + 3 * ibit17 … … 1942 2103 1943 2104 USE indices, & 1944 ONLY: nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_02105 ONLY: nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, advc_flags_1 1945 2106 1946 2107 USE kinds … … 1995 2156 DO k = nzb+1, nzb_max 1996 2157 1997 ibit20 = IBITS( wall_flags_0(k,j,i-1),20,1)1998 ibit19 = IBITS( wall_flags_0(k,j,i-1),19,1)1999 ibit18 = IBITS( wall_flags_0(k,j,i-1),18,1)2158 ibit20 = IBITS(advc_flags_1(k,j,i-1),20,1) 2159 ibit19 = IBITS(advc_flags_1(k,j,i-1),19,1) 2160 ibit18 = IBITS(advc_flags_1(k,j,i-1),18,1) 2000 2161 2001 2162 u_comp = u(k,j-1,i) + u(k,j,i) - gu … … 2053 2214 DO k = nzb+1, nzb_max 2054 2215 2055 ibit23 = IBITS( wall_flags_0(k,j-1,i),23,1)2056 ibit22 = IBITS( wall_flags_0(k,j-1,i),22,1)2057 ibit21 = IBITS( wall_flags_0(k,j-1,i),21,1)2216 ibit23 = IBITS(advc_flags_1(k,j-1,i),23,1) 2217 ibit22 = IBITS(advc_flags_1(k,j-1,i),22,1) 2218 ibit21 = IBITS(advc_flags_1(k,j-1,i),21,1) 2058 2219 2059 2220 v_comp_l = v(k,j,i) + v(k,j-1,i) - gv … … 2115 2276 DO k = nzb+1, nzb_max 2116 2277 2117 ibit20 = IBITS( wall_flags_0(k,j,i),20,1)2118 ibit19 = IBITS( wall_flags_0(k,j,i),19,1)2119 ibit18 = IBITS( wall_flags_0(k,j,i),18,1)2278 ibit20 = IBITS(advc_flags_1(k,j,i),20,1) 2279 ibit19 = IBITS(advc_flags_1(k,j,i),19,1) 2280 ibit18 = IBITS(advc_flags_1(k,j,i),18,1) 2120 2281 2121 2282 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu … … 2150 2311 ) 2151 2312 2152 ibit23 = IBITS( wall_flags_0(k,j,i),23,1)2153 ibit22 = IBITS( wall_flags_0(k,j,i),22,1)2154 ibit21 = IBITS( wall_flags_0(k,j,i),21,1)2313 ibit23 = IBITS(advc_flags_1(k,j,i),23,1) 2314 ibit22 = IBITS(advc_flags_1(k,j,i),22,1) 2315 ibit21 = IBITS(advc_flags_1(k,j,i),21,1) 2155 2316 2156 2317 … … 2188 2349 !-- k index has to be modified near bottom and top, else array 2189 2350 !-- subscripts will be exceeded. 2190 ibit26 = IBITS( wall_flags_0(k,j,i),26,1)2191 ibit25 = IBITS( wall_flags_0(k,j,i),25,1)2192 ibit24 = IBITS( wall_flags_0(k,j,i),24,1)2351 ibit26 = IBITS(advc_flags_1(k,j,i),26,1) 2352 ibit25 = IBITS(advc_flags_1(k,j,i),25,1) 2353 ibit24 = IBITS(advc_flags_1(k,j,i),24,1) 2193 2354 2194 2355 k_ppp = k + 3 * ibit26 … … 2233 2394 * ( ibit18 + ibit19 + ibit20 ) & 2234 2395 - ( u(k,j-1,i) + u(k,j,i) ) & 2235 * ( IBITS( wall_flags_0(k,j,i-1),18,1) &2236 + IBITS( wall_flags_0(k,j,i-1),19,1) &2237 + IBITS( wall_flags_0(k,j,i-1),20,1) &2396 * ( IBITS(advc_flags_1(k,j,i-1),18,1) & 2397 + IBITS(advc_flags_1(k,j,i-1),19,1) & 2398 + IBITS(advc_flags_1(k,j,i-1),20,1) & 2238 2399 ) & 2239 2400 ) * rho_air(k) * ddx & … … 2241 2402 * ( ibit21 + ibit22 + ibit23 ) & 2242 2403 - ( v(k,j,i) + v(k,j-1,i) ) & 2243 * ( IBITS( wall_flags_0(k,j-1,i),21,1) &2244 + IBITS( wall_flags_0(k,j-1,i),22,1) &2245 + IBITS( wall_flags_0(k,j-1,i),23,1) &2404 * ( IBITS(advc_flags_1(k,j-1,i),21,1) & 2405 + IBITS(advc_flags_1(k,j-1,i),22,1) & 2406 + IBITS(advc_flags_1(k,j-1,i),23,1) & 2246 2407 ) & 2247 2408 ) * rho_air(k) * ddy & 2248 2409 + ( w_comp * rho_air_zw(k) * ( ibit24 + ibit25 + ibit26 ) & 2249 2410 - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & 2250 * ( IBITS( wall_flags_0(k-1,j,i),24,1) &2251 + IBITS( wall_flags_0(k-1,j,i),25,1) &2252 + IBITS( wall_flags_0(k-1,j,i),26,1) &2411 * ( IBITS(advc_flags_1(k-1,j,i),24,1) & 2412 + IBITS(advc_flags_1(k-1,j,i),25,1) & 2413 + IBITS(advc_flags_1(k-1,j,i),26,1) & 2253 2414 ) & 2254 2415 ) * ddzw(k) & … … 2324 2485 !-- k index has to be modified near bottom and top, else array 2325 2486 !-- subscripts will be exceeded. 2326 ibit26 = IBITS( wall_flags_0(k,j,i),26,1)2327 ibit25 = IBITS( wall_flags_0(k,j,i),25,1)2328 ibit24 = IBITS( wall_flags_0(k,j,i),24,1)2487 ibit26 = IBITS(advc_flags_1(k,j,i),26,1) 2488 ibit25 = IBITS(advc_flags_1(k,j,i),25,1) 2489 ibit24 = IBITS(advc_flags_1(k,j,i),24,1) 2329 2490 2330 2491 k_ppp = k + 3 * ibit26 … … 2443 2604 2444 2605 USE indices, & 2445 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0, &2446 wall_flags_002606 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1, & 2607 advc_flags_2 2447 2608 2448 2609 USE kinds … … 2495 2656 2496 2657 DO k = nzb+1, nzb_max 2497 ibit32 = IBITS( wall_flags_00(k,j-1,i),0,1)2498 ibit31 = IBITS( wall_flags_0(k,j-1,i),31,1)2499 ibit30 = IBITS( wall_flags_0(k,j-1,i),30,1)2658 ibit32 = IBITS(advc_flags_2(k,j-1,i),0,1) 2659 ibit31 = IBITS(advc_flags_1(k,j-1,i),31,1) 2660 ibit30 = IBITS(advc_flags_1(k,j-1,i),30,1) 2500 2661 2501 2662 v_comp = v(k+1,j,i) + v(k,j,i) - gv … … 2553 2714 DO k = nzb+1, nzb_max 2554 2715 2555 ibit29 = IBITS( wall_flags_0(k,j,i-1),29,1)2556 ibit28 = IBITS( wall_flags_0(k,j,i-1),28,1)2557 ibit27 = IBITS( wall_flags_0(k,j,i-1),27,1)2716 ibit29 = IBITS(advc_flags_1(k,j,i-1),29,1) 2717 ibit28 = IBITS(advc_flags_1(k,j,i-1),28,1) 2718 ibit27 = IBITS(advc_flags_1(k,j,i-1),27,1) 2558 2719 2559 2720 u_comp = u(k+1,j,i) + u(k,j,i) - gu … … 2608 2769 !-- The lower flux has to be calculated explicetely for the tendency at 2609 2770 !-- the first w-level. For topography wall this is done implicitely by 2610 !-- wall_flags_0.2771 !-- advc_flags_1. 2611 2772 k = nzb + 1 2612 2773 w_comp = w(k,j,i) + w(k-1,j,i) … … 2620 2781 DO k = nzb+1, nzb_max 2621 2782 2622 ibit29 = IBITS( wall_flags_0(k,j,i),29,1)2623 ibit28 = IBITS( wall_flags_0(k,j,i),28,1)2624 ibit27 = IBITS( wall_flags_0(k,j,i),27,1)2783 ibit29 = IBITS(advc_flags_1(k,j,i),29,1) 2784 ibit28 = IBITS(advc_flags_1(k,j,i),28,1) 2785 ibit27 = IBITS(advc_flags_1(k,j,i),27,1) 2625 2786 2626 2787 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu … … 2655 2816 ) 2656 2817 2657 ibit32 = IBITS( wall_flags_00(k,j,i),0,1)2658 ibit31 = IBITS( wall_flags_0(k,j,i),31,1)2659 ibit30 = IBITS( wall_flags_0(k,j,i),30,1)2818 ibit32 = IBITS(advc_flags_2(k,j,i),0,1) 2819 ibit31 = IBITS(advc_flags_1(k,j,i),31,1) 2820 ibit30 = IBITS(advc_flags_1(k,j,i),30,1) 2660 2821 2661 2822 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv … … 2692 2853 !-- k index has to be modified near bottom and top, else array 2693 2854 !-- subscripts will be exceeded. 2694 ibit35 = IBITS( wall_flags_00(k,j,i),3,1)2695 ibit34 = IBITS( wall_flags_00(k,j,i),2,1)2696 ibit33 = IBITS( wall_flags_00(k,j,i),1,1)2855 ibit35 = IBITS(advc_flags_2(k,j,i),3,1) 2856 ibit34 = IBITS(advc_flags_2(k,j,i),2,1) 2857 ibit33 = IBITS(advc_flags_2(k,j,i),1,1) 2697 2858 2698 2859 k_ppp = k + 3 * ibit35 … … 2737 2898 div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 ) & 2738 2899 - ( u(k+1,j,i) + u(k,j,i) ) & 2739 * ( IBITS( wall_flags_0(k,j,i-1),27,1) &2740 + IBITS( wall_flags_0(k,j,i-1),28,1) &2741 + IBITS( wall_flags_0(k,j,i-1),29,1) &2900 * ( IBITS(advc_flags_1(k,j,i-1),27,1) & 2901 + IBITS(advc_flags_1(k,j,i-1),28,1) & 2902 + IBITS(advc_flags_1(k,j,i-1),29,1) & 2742 2903 ) & 2743 2904 ) * rho_air_zw(k) * ddx & 2744 2905 + ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 ) & 2745 2906 - ( v(k+1,j,i) + v(k,j,i) ) & 2746 * ( IBITS( wall_flags_0(k,j-1,i),30,1) &2747 + IBITS( wall_flags_0(k,j-1,i),31,1) &2748 + IBITS( wall_flags_00(k,j-1,i),0,1)&2907 * ( IBITS(advc_flags_1(k,j-1,i),30,1) & 2908 + IBITS(advc_flags_1(k,j-1,i),31,1) & 2909 + IBITS(advc_flags_2(k,j-1,i),0,1) & 2749 2910 ) & 2750 2911 ) * rho_air_zw(k) * ddy & 2751 2912 + ( w_comp * rho_air(k+1) * ( ibit33 + ibit34 + ibit35 ) & 2752 2913 - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k) & 2753 * ( IBITS( wall_flags_00(k-1,j,i),1,1)&2754 + IBITS( wall_flags_00(k-1,j,i),2,1)&2755 + IBITS( wall_flags_00(k-1,j,i),3,1)&2914 * ( IBITS(advc_flags_2(k-1,j,i),1,1) & 2915 + IBITS(advc_flags_2(k-1,j,i),2,1) & 2916 + IBITS(advc_flags_2(k-1,j,i),3,1) & 2756 2917 ) & 2757 2918 ) * ddzu(k+1) & … … 2814 2975 !-- k index has to be modified near bottom and top, else array 2815 2976 !-- subscripts will be exceeded. 2816 ibit35 = IBITS( wall_flags_00(k,j,i),3,1)2817 ibit34 = IBITS( wall_flags_00(k,j,i),2,1)2818 ibit33 = IBITS( wall_flags_00(k,j,i),1,1)2977 ibit35 = IBITS(advc_flags_2(k,j,i),3,1) 2978 ibit34 = IBITS(advc_flags_2(k,j,i),2,1) 2979 ibit33 = IBITS(advc_flags_2(k,j,i),1,1) 2819 2980 2820 2981 k_ppp = k + 3 * ibit35 … … 2919 3080 USE indices, & 2920 3081 ONLY: nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max, & 2921 nzt, wall_flags_03082 nzt, advc_flags_1 2922 3083 2923 3084 USE kinds … … 2983 3144 DO k = nzb+1, nzb_max 2984 3145 2985 ibit2 = IBITS( wall_flags_0(k,j,i-1),2,1)2986 ibit1 = IBITS( wall_flags_0(k,j,i-1),1,1)2987 ibit0 = IBITS( wall_flags_0(k,j,i-1),0,1)3146 ibit2 = IBITS(advc_flags_1(k,j,i-1),2,1) 3147 ibit1 = IBITS(advc_flags_1(k,j,i-1),1,1) 3148 ibit0 = IBITS(advc_flags_1(k,j,i-1),0,1) 2988 3149 2989 3150 u_comp = u(k,j,i) - u_gtrans … … 3044 3205 DO k = nzb+1, nzb_max 3045 3206 3046 ibit5 = IBITS( wall_flags_0(k,j-1,i),5,1)3047 ibit4 = IBITS( wall_flags_0(k,j-1,i),4,1)3048 ibit3 = IBITS( wall_flags_0(k,j-1,i),3,1)3207 ibit5 = IBITS(advc_flags_1(k,j-1,i),5,1) 3208 ibit4 = IBITS(advc_flags_1(k,j-1,i),4,1) 3209 ibit3 = IBITS(advc_flags_1(k,j-1,i),3,1) 3049 3210 3050 3211 v_comp = v(k,j,i) - v_gtrans … … 3107 3268 DO k = nzb+1, nzb_max 3108 3269 3109 ibit2 = IBITS( wall_flags_0(k,j,i),2,1)3110 ibit1 = IBITS( wall_flags_0(k,j,i),1,1)3111 ibit0 = IBITS( wall_flags_0(k,j,i),0,1)3270 ibit2 = IBITS(advc_flags_1(k,j,i),2,1) 3271 ibit1 = IBITS(advc_flags_1(k,j,i),1,1) 3272 ibit0 = IBITS(advc_flags_1(k,j,i),0,1) 3112 3273 3113 3274 u_comp = u(k,j,i+1) - u_gtrans … … 3142 3303 ) 3143 3304 3144 ibit5 = IBITS( wall_flags_0(k,j,i),5,1)3145 ibit4 = IBITS( wall_flags_0(k,j,i),4,1)3146 ibit3 = IBITS( wall_flags_0(k,j,i),3,1)3305 ibit5 = IBITS(advc_flags_1(k,j,i),5,1) 3306 ibit4 = IBITS(advc_flags_1(k,j,i),4,1) 3307 ibit3 = IBITS(advc_flags_1(k,j,i),3,1) 3147 3308 3148 3309 v_comp = v(k,j+1,i) - v_gtrans … … 3179 3340 !-- k index has to be modified near bottom and top, else array 3180 3341 !-- subscripts will be exceeded. 3181 ibit8 = IBITS( wall_flags_0(k,j,i),8,1)3182 ibit7 = IBITS( wall_flags_0(k,j,i),7,1)3183 ibit6 = IBITS( wall_flags_0(k,j,i),6,1)3342 ibit8 = IBITS(advc_flags_1(k,j,i),8,1) 3343 ibit7 = IBITS(advc_flags_1(k,j,i),7,1) 3344 ibit6 = IBITS(advc_flags_1(k,j,i),6,1) 3184 3345 3185 3346 k_ppp = k + 3 * ibit8 … … 3221 3382 !-- by a not sufficient reduction of divergences near topography. 3222 3383 div = ( u(k,j,i+1) * ( ibit0 + ibit1 + ibit2 ) & 3223 - u(k,j,i) * ( IBITS( wall_flags_0(k,j,i-1),0,1) &3224 + IBITS( wall_flags_0(k,j,i-1),1,1) &3225 + IBITS( wall_flags_0(k,j,i-1),2,1) &3384 - u(k,j,i) * ( IBITS(advc_flags_1(k,j,i-1),0,1) & 3385 + IBITS(advc_flags_1(k,j,i-1),1,1) & 3386 + IBITS(advc_flags_1(k,j,i-1),2,1) & 3226 3387 ) & 3227 3388 ) * rho_air(k) * ddx & 3228 3389 + ( v(k,j+1,i) * ( ibit3 + ibit4 + ibit5 ) & 3229 - v(k,j,i) * ( IBITS( wall_flags_0(k,j-1,i),3,1) &3230 + IBITS( wall_flags_0(k,j-1,i),4,1) &3231 + IBITS( wall_flags_0(k,j-1,i),5,1) &3390 - v(k,j,i) * ( IBITS(advc_flags_1(k,j-1,i),3,1) & 3391 + IBITS(advc_flags_1(k,j-1,i),4,1) & 3392 + IBITS(advc_flags_1(k,j-1,i),5,1) & 3232 3393 ) & 3233 3394 ) * rho_air(k) * ddy & … … 3235 3396 ( ibit6 + ibit7 + ibit8 ) & 3236 3397 - w(k-1,j,i) * rho_air_zw(k-1) * & 3237 ( IBITS( wall_flags_0(k-1,j,i),6,1) &3238 + IBITS( wall_flags_0(k-1,j,i),7,1) &3239 + IBITS( wall_flags_0(k-1,j,i),8,1) &3398 ( IBITS(advc_flags_1(k-1,j,i),6,1) & 3399 + IBITS(advc_flags_1(k-1,j,i),7,1) & 3400 + IBITS(advc_flags_1(k-1,j,i),8,1) & 3240 3401 ) & 3241 3402 ) * ddzw(k) … … 3285 3446 !-- k index has to be modified near bottom and top, else array 3286 3447 !-- subscripts will be exceeded. 3287 ibit8 = IBITS( wall_flags_0(k,j,i),8,1)3288 ibit7 = IBITS( wall_flags_0(k,j,i),7,1)3289 ibit6 = IBITS( wall_flags_0(k,j,i),6,1)3448 ibit8 = IBITS(advc_flags_1(k,j,i),8,1) 3449 ibit7 = IBITS(advc_flags_1(k,j,i),7,1) 3450 ibit6 = IBITS(advc_flags_1(k,j,i),6,1) 3290 3451 3291 3452 k_ppp = k + 3 * ibit8 … … 3429 3590 3430 3591 3431 3432 3592 !------------------------------------------------------------------------------! 3433 3593 ! Description: … … 3450 3610 3451 3611 USE indices, & 3452 ONLY: nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_03612 ONLY: nxl, nxlu, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1 3453 3613 3454 3614 USE kinds … … 3507 3667 DO k = nzb+1, nzb_max 3508 3668 3509 ibit11 = IBITS( wall_flags_0(k,j,i-1),11,1)3510 ibit10 = IBITS( wall_flags_0(k,j,i-1),10,1)3511 ibit9 = IBITS( wall_flags_0(k,j,i-1),9,1)3669 ibit11 = IBITS(advc_flags_1(k,j,i-1),11,1) 3670 ibit10 = IBITS(advc_flags_1(k,j,i-1),10,1) 3671 ibit9 = IBITS(advc_flags_1(k,j,i-1),9,1) 3512 3672 3513 3673 u_comp(k) = u(k,j,i) + u(k,j,i-1) - gu … … 3565 3725 DO k = nzb+1, nzb_max 3566 3726 3567 ibit14 = IBITS( wall_flags_0(k,j-1,i),14,1)3568 ibit13 = IBITS( wall_flags_0(k,j-1,i),13,1)3569 ibit12 = IBITS( wall_flags_0(k,j-1,i),12,1)3727 ibit14 = IBITS(advc_flags_1(k,j-1,i),14,1) 3728 ibit13 = IBITS(advc_flags_1(k,j-1,i),13,1) 3729 ibit12 = IBITS(advc_flags_1(k,j-1,i),12,1) 3570 3730 3571 3731 v_comp = v(k,j,i) + v(k,j,i-1) - gv … … 3626 3786 DO k = nzb+1, nzb_max 3627 3787 3628 ibit11 = IBITS( wall_flags_0(k,j,i),11,1)3629 ibit10 = IBITS( wall_flags_0(k,j,i),10,1)3630 ibit9 = IBITS( wall_flags_0(k,j,i),9,1)3788 ibit11 = IBITS(advc_flags_1(k,j,i),11,1) 3789 ibit10 = IBITS(advc_flags_1(k,j,i),10,1) 3790 ibit9 = IBITS(advc_flags_1(k,j,i),9,1) 3631 3791 3632 3792 u_comp(k) = u(k,j,i+1) + u(k,j,i) … … 3661 3821 ) 3662 3822 3663 ibit14 = IBITS( wall_flags_0(k,j,i),14,1)3664 ibit13 = IBITS( wall_flags_0(k,j,i),13,1)3665 ibit12 = IBITS( wall_flags_0(k,j,i),12,1)3823 ibit14 = IBITS(advc_flags_1(k,j,i),14,1) 3824 ibit13 = IBITS(advc_flags_1(k,j,i),13,1) 3825 ibit12 = IBITS(advc_flags_1(k,j,i),12,1) 3666 3826 3667 3827 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv … … 3698 3858 !-- k index has to be modified near bottom and top, else array 3699 3859 !-- subscripts will be exceeded. 3700 ibit17 = IBITS( wall_flags_0(k,j,i),17,1)3701 ibit16 = IBITS( wall_flags_0(k,j,i),16,1)3702 ibit15 = IBITS( wall_flags_0(k,j,i),15,1)3860 ibit17 = IBITS(advc_flags_1(k,j,i),17,1) 3861 ibit16 = IBITS(advc_flags_1(k,j,i),16,1) 3862 ibit15 = IBITS(advc_flags_1(k,j,i),15,1) 3703 3863 3704 3864 k_ppp = k + 3 * ibit17 … … 3742 3902 div = ( ( u_comp(k) * ( ibit9 + ibit10 + ibit11 ) & 3743 3903 - ( u(k,j,i) + u(k,j,i-1) ) & 3744 * ( IBITS( wall_flags_0(k,j,i-1),9,1) &3745 + IBITS( wall_flags_0(k,j,i-1),10,1) &3746 + IBITS( wall_flags_0(k,j,i-1),11,1) &3904 * ( IBITS(advc_flags_1(k,j,i-1),9,1) & 3905 + IBITS(advc_flags_1(k,j,i-1),10,1) & 3906 + IBITS(advc_flags_1(k,j,i-1),11,1) & 3747 3907 ) & 3748 3908 ) * rho_air(k) * ddx & 3749 3909 + ( ( v_comp + gv ) * ( ibit12 + ibit13 + ibit14 ) & 3750 3910 - ( v(k,j,i) + v(k,j,i-1 ) ) & 3751 * ( IBITS( wall_flags_0(k,j-1,i),12,1) &3752 + IBITS( wall_flags_0(k,j-1,i),13,1) &3753 + IBITS( wall_flags_0(k,j-1,i),14,1) &3911 * ( IBITS(advc_flags_1(k,j-1,i),12,1) & 3912 + IBITS(advc_flags_1(k,j-1,i),13,1) & 3913 + IBITS(advc_flags_1(k,j-1,i),14,1) & 3754 3914 ) & 3755 3915 ) * rho_air(k) * ddy & 3756 3916 + ( w_comp * rho_air_zw(k) * ( ibit15 + ibit16 + ibit17 ) & 3757 3917 - ( w(k-1,j,i) + w(k-1,j,i-1) ) * rho_air_zw(k-1) & 3758 * ( IBITS( wall_flags_0(k-1,j,i),15,1) &3759 + IBITS( wall_flags_0(k-1,j,i),16,1) &3760 + IBITS( wall_flags_0(k-1,j,i),17,1) &3918 * ( IBITS(advc_flags_1(k-1,j,i),15,1) & 3919 + IBITS(advc_flags_1(k-1,j,i),16,1) & 3920 + IBITS(advc_flags_1(k-1,j,i),17,1) & 3761 3921 ) & 3762 3922 ) * ddzw(k) & … … 3829 3989 !-- k index has to be modified near bottom and top, else array 3830 3990 !-- subscripts will be exceeded. 3831 ibit17 = IBITS( wall_flags_0(k,j,i),17,1)3832 ibit16 = IBITS( wall_flags_0(k,j,i),16,1)3833 ibit15 = IBITS( wall_flags_0(k,j,i),15,1)3991 ibit17 = IBITS(advc_flags_1(k,j,i),17,1) 3992 ibit16 = IBITS(advc_flags_1(k,j,i),16,1) 3993 ibit15 = IBITS(advc_flags_1(k,j,i),15,1) 3834 3994 3835 3995 k_ppp = k + 3 * ibit17 … … 3925 4085 END SUBROUTINE advec_u_ws 3926 4086 3927 4087 3928 4088 !------------------------------------------------------------------------------! 3929 4089 ! Description: … … 3946 4106 3947 4107 USE indices, & 3948 ONLY: nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, wall_flags_04108 ONLY: nxl, nxr, nyn, nys, nysv, nzb, nzb_max, nzt, advc_flags_1 3949 4109 3950 4110 USE kinds … … 4003 4163 DO k = nzb+1, nzb_max 4004 4164 4005 ibit20 = IBITS( wall_flags_0(k,j,i-1),20,1)4006 ibit19 = IBITS( wall_flags_0(k,j,i-1),19,1)4007 ibit18 = IBITS( wall_flags_0(k,j,i-1),18,1)4165 ibit20 = IBITS(advc_flags_1(k,j,i-1),20,1) 4166 ibit19 = IBITS(advc_flags_1(k,j,i-1),19,1) 4167 ibit18 = IBITS(advc_flags_1(k,j,i-1),18,1) 4008 4168 4009 4169 u_comp = u(k,j-1,i) + u(k,j,i) - gu … … 4061 4221 DO k = nzb+1, nzb_max 4062 4222 4063 ibit23 = IBITS( wall_flags_0(k,j-1,i),23,1)4064 ibit22 = IBITS( wall_flags_0(k,j-1,i),22,1)4065 ibit21 = IBITS( wall_flags_0(k,j-1,i),21,1)4223 ibit23 = IBITS(advc_flags_1(k,j-1,i),23,1) 4224 ibit22 = IBITS(advc_flags_1(k,j-1,i),22,1) 4225 ibit21 = IBITS(advc_flags_1(k,j-1,i),21,1) 4066 4226 4067 4227 v_comp(k) = v(k,j,i) + v(k,j-1,i) - gv … … 4121 4281 DO k = nzb+1, nzb_max 4122 4282 4123 ibit20 = IBITS( wall_flags_0(k,j,i),20,1)4124 ibit19 = IBITS( wall_flags_0(k,j,i),19,1)4125 ibit18 = IBITS( wall_flags_0(k,j,i),18,1)4283 ibit20 = IBITS(advc_flags_1(k,j,i),20,1) 4284 ibit19 = IBITS(advc_flags_1(k,j,i),19,1) 4285 ibit18 = IBITS(advc_flags_1(k,j,i),18,1) 4126 4286 4127 4287 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu … … 4156 4316 ) 4157 4317 4158 ibit23 = IBITS( wall_flags_0(k,j,i),23,1)4159 ibit22 = IBITS( wall_flags_0(k,j,i),22,1)4160 ibit21 = IBITS( wall_flags_0(k,j,i),21,1)4318 ibit23 = IBITS(advc_flags_1(k,j,i),23,1) 4319 ibit22 = IBITS(advc_flags_1(k,j,i),22,1) 4320 ibit21 = IBITS(advc_flags_1(k,j,i),21,1) 4161 4321 4162 4322 v_comp(k) = v(k,j+1,i) + v(k,j,i) … … 4193 4353 !-- k index has to be modified near bottom and top, else array 4194 4354 !-- subscripts will be exceeded. 4195 ibit26 = IBITS( wall_flags_0(k,j,i),26,1)4196 ibit25 = IBITS( wall_flags_0(k,j,i),25,1)4197 ibit24 = IBITS( wall_flags_0(k,j,i),24,1)4355 ibit26 = IBITS(advc_flags_1(k,j,i),26,1) 4356 ibit25 = IBITS(advc_flags_1(k,j,i),25,1) 4357 ibit24 = IBITS(advc_flags_1(k,j,i),24,1) 4198 4358 4199 4359 k_ppp = k + 3 * ibit26 … … 4238 4398 * ( ibit18 + ibit19 + ibit20 ) & 4239 4399 - ( u(k,j-1,i) + u(k,j,i) ) & 4240 * ( IBITS( wall_flags_0(k,j,i-1),18,1) &4241 + IBITS( wall_flags_0(k,j,i-1),19,1) &4242 + IBITS( wall_flags_0(k,j,i-1),20,1) &4400 * ( IBITS(advc_flags_1(k,j,i-1),18,1) & 4401 + IBITS(advc_flags_1(k,j,i-1),19,1) & 4402 + IBITS(advc_flags_1(k,j,i-1),20,1) & 4243 4403 ) & 4244 4404 ) * rho_air(k) * ddx & … … 4246 4406 * ( ibit21 + ibit22 + ibit23 ) & 4247 4407 - ( v(k,j,i) + v(k,j-1,i) ) & 4248 * ( IBITS( wall_flags_0(k,j-1,i),21,1) &4249 + IBITS( wall_flags_0(k,j-1,i),22,1) &4250 + IBITS( wall_flags_0(k,j-1,i),23,1) &4408 * ( IBITS(advc_flags_1(k,j-1,i),21,1) & 4409 + IBITS(advc_flags_1(k,j-1,i),22,1) & 4410 + IBITS(advc_flags_1(k,j-1,i),23,1) & 4251 4411 ) & 4252 4412 ) * rho_air(k) * ddy & … … 4254 4414 * ( ibit24 + ibit25 + ibit26 ) & 4255 4415 - ( w(k-1,j-1,i) + w(k-1,j,i) ) * rho_air_zw(k-1) & 4256 * ( IBITS( wall_flags_0(k-1,j,i),24,1) &4257 + IBITS( wall_flags_0(k-1,j,i),25,1) &4258 + IBITS( wall_flags_0(k-1,j,i),26,1) &4416 * ( IBITS(advc_flags_1(k-1,j,i),24,1) & 4417 + IBITS(advc_flags_1(k-1,j,i),25,1) & 4418 + IBITS(advc_flags_1(k-1,j,i),26,1) & 4259 4419 ) & 4260 4420 ) * ddzw(k) & … … 4332 4492 !-- k index has to be modified near bottom and top, else array 4333 4493 !-- subscripts will be exceeded. 4334 ibit26 = IBITS( wall_flags_0(k,j,i),26,1)4335 ibit25 = IBITS( wall_flags_0(k,j,i),25,1)4336 ibit24 = IBITS( wall_flags_0(k,j,i),24,1)4494 ibit26 = IBITS(advc_flags_1(k,j,i),26,1) 4495 ibit25 = IBITS(advc_flags_1(k,j,i),25,1) 4496 ibit24 = IBITS(advc_flags_1(k,j,i),24,1) 4337 4497 4338 4498 k_ppp = k + 3 * ibit26 … … 4433 4593 4434 4594 4435 4436 4437 4595 !------------------------------------------------------------------------------! 4438 4596 ! Description: … … 4455 4613 4456 4614 USE indices, & 4457 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0, &4458 wall_flags_004615 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, advc_flags_1, & 4616 advc_flags_2 4459 4617 4460 4618 USE kinds … … 4512 4670 DO k = nzb+1, nzb_max 4513 4671 4514 ibit29 = IBITS( wall_flags_0(k,j,i-1),29,1)4515 ibit28 = IBITS( wall_flags_0(k,j,i-1),28,1)4516 ibit27 = IBITS( wall_flags_0(k,j,i-1),27,1)4672 ibit29 = IBITS(advc_flags_1(k,j,i-1),29,1) 4673 ibit28 = IBITS(advc_flags_1(k,j,i-1),28,1) 4674 ibit27 = IBITS(advc_flags_1(k,j,i-1),27,1) 4517 4675 4518 4676 u_comp = u(k+1,j,i) + u(k,j,i) - gu … … 4570 4728 DO k = nzb+1, nzb_max 4571 4729 4572 ibit32 = IBITS( wall_flags_00(k,j-1,i),0,1)4573 ibit31 = IBITS( wall_flags_0(k,j-1,i),31,1)4574 ibit30 = IBITS( wall_flags_0(k,j-1,i),30,1)4730 ibit32 = IBITS(advc_flags_2(k,j-1,i),0,1) 4731 ibit31 = IBITS(advc_flags_1(k,j-1,i),31,1) 4732 ibit30 = IBITS(advc_flags_1(k,j-1,i),30,1) 4575 4733 4576 4734 v_comp = v(k+1,j,i) + v(k,j,i) - gv … … 4626 4784 !-- The lower flux has to be calculated explicetely for the tendency 4627 4785 !-- at the first w-level. For topography wall this is done implicitely 4628 !-- by wall_flags_0.4786 !-- by advc_flags_1. 4629 4787 k = nzb + 1 4630 4788 w_comp = w(k,j,i) + w(k-1,j,i) … … 4636 4794 DO k = nzb+1, nzb_max 4637 4795 4638 ibit29 = IBITS( wall_flags_0(k,j,i),29,1)4639 ibit28 = IBITS( wall_flags_0(k,j,i),28,1)4640 ibit27 = IBITS( wall_flags_0(k,j,i),27,1)4796 ibit29 = IBITS(advc_flags_1(k,j,i),29,1) 4797 ibit28 = IBITS(advc_flags_1(k,j,i),28,1) 4798 ibit27 = IBITS(advc_flags_1(k,j,i),27,1) 4641 4799 4642 4800 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu … … 4671 4829 ) 4672 4830 4673 ibit32 = IBITS( wall_flags_00(k,j,i),0,1)4674 ibit31 = IBITS( wall_flags_0(k,j,i),31,1)4675 ibit30 = IBITS( wall_flags_0(k,j,i),30,1)4831 ibit32 = IBITS(advc_flags_2(k,j,i),0,1) 4832 ibit31 = IBITS(advc_flags_1(k,j,i),31,1) 4833 ibit30 = IBITS(advc_flags_1(k,j,i),30,1) 4676 4834 4677 4835 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv … … 4708 4866 !-- k index has to be modified near bottom and top, else array 4709 4867 !-- subscripts will be exceeded. 4710 ibit35 = IBITS( wall_flags_00(k,j,i),3,1)4711 ibit34 = IBITS( wall_flags_00(k,j,i),2,1)4712 ibit33 = IBITS( wall_flags_00(k,j,i),1,1)4868 ibit35 = IBITS(advc_flags_2(k,j,i),3,1) 4869 ibit34 = IBITS(advc_flags_2(k,j,i),2,1) 4870 ibit33 = IBITS(advc_flags_2(k,j,i),1,1) 4713 4871 4714 4872 k_ppp = k + 3 * ibit35 … … 4752 4910 div = ( ( ( u_comp + gu ) * ( ibit27 + ibit28 + ibit29 ) & 4753 4911 - ( u(k+1,j,i) + u(k,j,i) ) & 4754 * ( IBITS( wall_flags_0(k,j,i-1),27,1) &4755 + IBITS( wall_flags_0(k,j,i-1),28,1) &4756 + IBITS( wall_flags_0(k,j,i-1),29,1) &4912 * ( IBITS(advc_flags_1(k,j,i-1),27,1) & 4913 + IBITS(advc_flags_1(k,j,i-1),28,1) & 4914 + IBITS(advc_flags_1(k,j,i-1),29,1) & 4757 4915 ) & 4758 4916 ) * rho_air_zw(k) * ddx & 4759 4917 + ( ( v_comp + gv ) * ( ibit30 + ibit31 + ibit32 ) & 4760 4918 - ( v(k+1,j,i) + v(k,j,i) ) & 4761 * ( IBITS( wall_flags_0(k,j-1,i),30,1) &4762 + IBITS( wall_flags_0(k,j-1,i),31,1) &4763 + IBITS( wall_flags_00(k,j-1,i),0,1)&4919 * ( IBITS(advc_flags_1(k,j-1,i),30,1) & 4920 + IBITS(advc_flags_1(k,j-1,i),31,1) & 4921 + IBITS(advc_flags_2(k,j-1,i),0,1) & 4764 4922 ) & 4765 4923 ) * rho_air_zw(k) * ddy & 4766 4924 + ( w_comp * rho_air(k+1) * ( ibit33 + ibit34 + ibit35 ) & 4767 4925 - ( w(k,j,i) + w(k-1,j,i) ) * rho_air(k) & 4768 * ( IBITS( wall_flags_00(k-1,j,i),1,1)&4769 + IBITS( wall_flags_00(k-1,j,i),2,1)&4770 + IBITS( wall_flags_00(k-1,j,i),3,1)&4926 * ( IBITS(advc_flags_2(k-1,j,i),1,1) & 4927 + IBITS(advc_flags_2(k-1,j,i),2,1) & 4928 + IBITS(advc_flags_2(k-1,j,i),3,1) & 4771 4929 ) & 4772 4930 ) * ddzu(k+1) & … … 4831 4989 !-- k index has to be modified near bottom and top, else array 4832 4990 !-- subscripts will be exceeded. 4833 ibit35 = IBITS( wall_flags_00(k,j,i),3,1)4834 ibit34 = IBITS( wall_flags_00(k,j,i),2,1)4835 ibit33 = IBITS( wall_flags_00(k,j,i),1,1)4991 ibit35 = IBITS(advc_flags_2(k,j,i),3,1) 4992 ibit34 = IBITS(advc_flags_2(k,j,i),2,1) 4993 ibit33 = IBITS(advc_flags_2(k,j,i),1,1) 4836 4994 4837 4995 k_ppp = k + 3 * ibit35 … … 4916 5074 END SUBROUTINE advec_w_ws 4917 5075 4918 4919 5076 END MODULE advec_ws
Note: See TracChangeset
for help on using the changeset viewer.
