Changeset 1353 for palm/trunk/SOURCE/advec_ws.f90
- Timestamp:
- Apr 8, 2014 3:21:23 PM (11 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/advec_ws.f90 (modified) (188 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_ws.f90
r1323 r1353 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! REAL constants provided with KIND-attribute, 23 ! module kinds added 24 ! some formatting adjustments 23 25 ! 24 26 ! Former revisions: … … 116 118 117 119 PRIVATE 118 PUBLIC advec_s_ws, advec_s_ws_acc, advec_u_ws, advec_u_ws_acc, &119 advec_v_ws, advec_v_ws_acc, advec_w_ws, advec_w_ws_acc, &120 PUBLIC advec_s_ws, advec_s_ws_acc, advec_u_ws, advec_u_ws_acc, & 121 advec_v_ws, advec_v_ws_acc, advec_w_ws, advec_w_ws_acc, & 120 122 ws_init, ws_statistics 121 123 … … 187 189 188 190 USE indices, & 189 ONLY: nyn, nys, nzb, nzt 191 ONLY: nyn, nys, nzb, nzt 192 193 USE kinds 190 194 191 195 USE pegrid … … 214 218 sums_ws2_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 215 219 216 sums_wsus_ws_l = 0.0 217 sums_wsvs_ws_l = 0.0 218 sums_us2_ws_l = 0.0 219 sums_vs2_ws_l = 0.0 220 sums_ws2_ws_l = 0.0 220 sums_wsus_ws_l = 0.0_wp 221 sums_wsvs_ws_l = 0.0_wp 222 sums_us2_ws_l = 0.0_wp 223 sums_vs2_ws_l = 0.0_wp 224 sums_ws2_ws_l = 0.0_wp 221 225 222 226 ENDIF … … 225 229 226 230 ALLOCATE( sums_wspts_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 227 sums_wspts_ws_l = 0.0 231 sums_wspts_ws_l = 0.0_wp 228 232 229 233 IF ( humidity .OR. passive_scalar ) THEN 230 234 ALLOCATE( sums_wsqs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 231 sums_wsqs_ws_l = 0.0 235 sums_wsqs_ws_l = 0.0_wp 232 236 ENDIF 233 237 … … 236 240 ALLOCATE( sums_wsqrs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 237 241 ALLOCATE( sums_wsnrs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 238 sums_wsqrs_ws_l = 0.0 239 sums_wsnrs_ws_l = 0.0 242 sums_wsqrs_ws_l = 0.0_wp 243 sums_wsnrs_ws_l = 0.0_wp 240 244 ENDIF 241 245 242 246 IF ( ocean ) THEN 243 247 ALLOCATE( sums_wssas_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 244 sums_wssas_ws_l = 0.0 248 sums_wssas_ws_l = 0.0_wp 245 249 ENDIF 246 250 … … 324 328 precipitation, ocean, ws_scheme_mom, ws_scheme_sca 325 329 330 USE kinds 331 326 332 USE statistics, & 327 333 ONLY: sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsnrs_ws_l,& … … 335 341 !-- beginning of prognostic_equations. 336 342 IF ( ws_scheme_mom ) THEN 337 sums_wsus_ws_l = 0.0 338 sums_wsvs_ws_l = 0.0 339 sums_us2_ws_l = 0.0 340 sums_vs2_ws_l = 0.0 341 sums_ws2_ws_l = 0.0 343 sums_wsus_ws_l = 0.0_wp 344 sums_wsvs_ws_l = 0.0_wp 345 sums_us2_ws_l = 0.0_wp 346 sums_vs2_ws_l = 0.0_wp 347 sums_ws2_ws_l = 0.0_wp 342 348 ENDIF 343 349 344 350 IF ( ws_scheme_sca ) THEN 345 sums_wspts_ws_l = 0.0 346 IF ( humidity .OR. passive_scalar ) sums_wsqs_ws_l = 0.0 351 sums_wspts_ws_l = 0.0_wp 352 IF ( humidity .OR. passive_scalar ) sums_wsqs_ws_l = 0.0_wp 347 353 IF ( cloud_physics .AND. icloud_scheme == 0 .AND. & 348 354 precipitation ) THEN 349 sums_wsqrs_ws_l = 0.0 350 sums_wsnrs_ws_l = 0.0 355 sums_wsqrs_ws_l = 0.0_wp 356 sums_wsnrs_ws_l = 0.0_wp 351 357 ENDIF 352 IF ( ocean ) sums_wssas_ws_l = 0.0 358 IF ( ocean ) sums_wssas_ws_l = 0.0_wp 353 359 354 360 ENDIF … … 446 452 447 453 v_comp = v(k,j,i) - v_gtrans 448 swap_flux_y_local(k,tn) = v_comp * (&449 ( 37.0* ibit5 * adv_sca_5 &450 + 7.0* ibit4 * adv_sca_3 &451 +ibit3 * adv_sca_1 &452 ) *&454 swap_flux_y_local(k,tn) = v_comp * ( & 455 ( 37.0_wp * ibit5 * adv_sca_5 & 456 + 7.0_wp * ibit4 * adv_sca_3 & 457 + ibit3 * adv_sca_1 & 458 ) * & 453 459 ( sk(k,j,i) + sk(k,j-1,i) ) & 454 - ( 8.0* ibit5 * adv_sca_5 &455 +ibit4 * adv_sca_3 &456 ) *&460 - ( 8.0_wp * ibit5 * adv_sca_5 & 461 + ibit4 * adv_sca_3 & 462 ) * & 457 463 ( sk(k,j+1,i) + sk(k,j-2,i) ) & 458 + (ibit5 * adv_sca_5 &459 ) *&464 + ( ibit5 * adv_sca_5 & 465 ) * & 460 466 ( sk(k,j+2,i) + sk(k,j-3,i) ) & 461 )467 ) 462 468 463 469 swap_diss_y_local(k,tn) = -ABS( v_comp ) * ( & 464 ( 10.0* ibit5 * adv_sca_5 &465 + 3.0* ibit4 * adv_sca_3 &466 +ibit3 * adv_sca_1 &467 ) *&468 ( sk(k,j,i) - sk(k,j-1,i) )&469 - ( 5.0* ibit5 * adv_sca_5 &470 +ibit4 * adv_sca_3 &470 ( 10.0_wp * ibit5 * adv_sca_5 & 471 + 3.0_wp * ibit4 * adv_sca_3 & 472 + ibit3 * adv_sca_1 & 473 ) * & 474 ( sk(k,j,i) - sk(k,j-1,i) ) & 475 - ( 5.0_wp * ibit5 * adv_sca_5 & 476 + ibit4 * adv_sca_3 & 471 477 ) * & 472 478 ( sk(k,j+1,i) - sk(k,j-2,i) ) & 473 + (ibit5 * adv_sca_5 &474 ) *&475 ( sk(k,j+2,i) - sk(k,j-3,i) )&479 + ( ibit5 * adv_sca_5 & 480 ) * & 481 ( sk(k,j+2,i) - sk(k,j-3,i) ) & 476 482 ) 477 483 … … 482 488 483 489 v_comp = v(k,j,i) - v_gtrans 484 swap_flux_y_local(k,tn) = v_comp * ( &485 37.0 * ( sk(k,j,i) + sk(k,j-1,i) )&486 - 8.0 * ( sk(k,j+1,i) + sk(k,j-2,i) )&487 + ( sk(k,j+2,i) + sk(k,j-3,i) )&488 ) * adv_sca_5489 swap_diss_y_local(k,tn) = -ABS( v_comp ) * ( &490 10.0 * ( sk(k,j,i) - sk(k,j-1,i) )&491 - 5.0 * ( sk(k,j+1,i) - sk(k,j-2,i) )&492 + sk(k,j+2,i) - sk(k,j-3,i)&493 ) * adv_sca_5490 swap_flux_y_local(k,tn) = v_comp * ( & 491 37.0_wp * ( sk(k,j,i) + sk(k,j-1,i) ) & 492 - 8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) ) & 493 + ( sk(k,j+2,i) + sk(k,j-3,i) ) & 494 ) * adv_sca_5 495 swap_diss_y_local(k,tn) = -ABS( v_comp ) * ( & 496 10.0_wp * ( sk(k,j,i) - sk(k,j-1,i) ) & 497 - 5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) ) & 498 + sk(k,j+2,i) - sk(k,j-3,i) & 499 ) * adv_sca_5 494 500 495 501 ENDDO … … 508 514 u_comp = u(k,j,i) - u_gtrans 509 515 swap_flux_x_local(k,j,tn) = u_comp * ( & 510 ( 37.0* ibit2 * adv_sca_5 &511 + 7.0* ibit1 * adv_sca_3 &512 +ibit0 * adv_sca_1 &513 ) *&516 ( 37.0_wp * ibit2 * adv_sca_5 & 517 + 7.0_wp * ibit1 * adv_sca_3 & 518 + ibit0 * adv_sca_1 & 519 ) * & 514 520 ( sk(k,j,i) + sk(k,j,i-1) ) & 515 - ( 8.0* ibit2 * adv_sca_5 &516 +ibit1 * adv_sca_3 &517 ) *&521 - ( 8.0_wp * ibit2 * adv_sca_5 & 522 + ibit1 * adv_sca_3 & 523 ) * & 518 524 ( sk(k,j,i+1) + sk(k,j,i-2) ) & 519 + (ibit2 * adv_sca_5 &520 ) *&525 + ( ibit2 * adv_sca_5 & 526 ) * & 521 527 ( sk(k,j,i+2) + sk(k,j,i-3) ) & 522 528 ) 523 529 524 530 swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * ( & 525 ( 10.0* ibit2 * adv_sca_5 &526 + 3.0* ibit1 * adv_sca_3 &527 +ibit0 * adv_sca_1 &528 ) *&531 ( 10.0_wp * ibit2 * adv_sca_5 & 532 + 3.0_wp * ibit1 * adv_sca_3 & 533 + ibit0 * adv_sca_1 & 534 ) * & 529 535 ( sk(k,j,i) - sk(k,j,i-1) ) & 530 - ( 5.0* ibit2 * adv_sca_5 &531 +ibit1 * adv_sca_3 &532 ) *&533 ( sk(k,j,i+1) - sk(k,j,i-2) )&534 + (ibit2 * adv_sca_5 &535 ) *&536 ( sk(k,j,i+2) - sk(k,j,i-3) )&536 - ( 5.0_wp * ibit2 * adv_sca_5 & 537 + ibit1 * adv_sca_3 & 538 ) * & 539 ( sk(k,j,i+1) - sk(k,j,i-2) ) & 540 + ( ibit2 * adv_sca_5 & 541 ) * & 542 ( sk(k,j,i+2) - sk(k,j,i-3) ) & 537 543 ) 538 544 … … 542 548 543 549 u_comp = u(k,j,i) - u_gtrans 544 swap_flux_x_local(k,j,tn) = u_comp * ( &545 37.0 * ( sk(k,j,i) + sk(k,j,i-1) )&546 - 8.0 * ( sk(k,j,i+1) + sk(k,j,i-2) )&547 + ( sk(k,j,i+2) + sk(k,j,i-3) )&550 swap_flux_x_local(k,j,tn) = u_comp * ( & 551 37.0_wp * ( sk(k,j,i) + sk(k,j,i-1) ) & 552 - 8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) & 553 + ( sk(k,j,i+2) + sk(k,j,i-3) ) & 548 554 ) * adv_sca_5 549 555 550 swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * ( &551 10.0 * ( sk(k,j,i) - sk(k,j,i-1) )&552 - 5.0 * ( sk(k,j,i+1) - sk(k,j,i-2) )&553 + ( sk(k,j,i+2) - sk(k,j,i-3) )&556 swap_diss_x_local(k,j,tn) = -ABS( u_comp ) * ( & 557 10.0_wp * ( sk(k,j,i) - sk(k,j,i-1) ) & 558 - 5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) & 559 + ( sk(k,j,i+2) - sk(k,j,i-3) ) & 554 560 ) * adv_sca_5 555 561 … … 558 564 ENDIF 559 565 560 flux_t(0) = 0.0 561 diss_t(0) = 0.0 562 flux_d = 0.0 563 diss_d = 0.0 566 flux_t(0) = 0.0_wp 567 diss_t(0) = 0.0_wp 568 flux_d = 0.0_wp 569 diss_d = 0.0_wp 564 570 ! 565 571 !-- Now compute the fluxes and tendency terms for the horizontal and … … 576 582 577 583 u_comp = u(k,j,i+1) - u_gtrans 578 flux_r(k) = u_comp * ( &579 ( 37.0 * ibit2 * adv_sca_5&580 + 7.0 * ibit1 * adv_sca_3&581 + ibit0 * adv_sca_1&582 ) * &583 ( sk(k,j,i+1) + sk(k,j,i) ) &584 - ( 8.0 * ibit2 * adv_sca_5&585 + ibit1 * adv_sca_3&586 ) * &587 ( sk(k,j,i+2) + sk(k,j,i-1) ) &588 + ( ibit2 * adv_sca_5&589 ) * &590 ( sk(k,j,i+3) + sk(k,j,i-2) ) &584 flux_r(k) = u_comp * ( & 585 ( 37.0_wp * ibit2 * adv_sca_5 & 586 + 7.0_wp * ibit1 * adv_sca_3 & 587 + ibit0 * adv_sca_1 & 588 ) * & 589 ( sk(k,j,i+1) + sk(k,j,i) ) & 590 - ( 8.0_wp * ibit2 * adv_sca_5 & 591 + ibit1 * adv_sca_3 & 592 ) * & 593 ( sk(k,j,i+2) + sk(k,j,i-1) ) & 594 + ( ibit2 * adv_sca_5 & 595 ) * & 596 ( sk(k,j,i+3) + sk(k,j,i-2) ) & 591 597 ) 592 598 593 diss_r(k) = -ABS( u_comp ) * ( &594 ( 10.0 * ibit2 * adv_sca_5&595 + 3.0 * ibit1 * adv_sca_3&596 + ibit0 * adv_sca_1&597 ) * &598 ( sk(k,j,i+1) - sk(k,j,i) ) &599 - ( 5.0 * ibit2 * adv_sca_5&600 + ibit1 * adv_sca_3&601 ) * &602 ( sk(k,j,i+2) - sk(k,j,i-1) ) &603 + ( ibit2 * adv_sca_5&604 ) * &605 ( sk(k,j,i+3) - sk(k,j,i-2) ) &599 diss_r(k) = -ABS( u_comp ) * ( & 600 ( 10.0_wp * ibit2 * adv_sca_5 & 601 + 3.0_wp * ibit1 * adv_sca_3 & 602 + ibit0 * adv_sca_1 & 603 ) * & 604 ( sk(k,j,i+1) - sk(k,j,i) ) & 605 - ( 5.0_wp * ibit2 * adv_sca_5 & 606 + ibit1 * adv_sca_3 & 607 ) * & 608 ( sk(k,j,i+2) - sk(k,j,i-1) ) & 609 + ( ibit2 * adv_sca_5 & 610 ) * & 611 ( sk(k,j,i+3) - sk(k,j,i-2) ) & 606 612 ) 607 613 … … 611 617 612 618 v_comp = v(k,j+1,i) - v_gtrans 613 flux_n(k) = v_comp * ( &614 ( 37.0 * ibit5 * adv_sca_5&615 + 7.0 * ibit4 * adv_sca_3&616 + ibit3 * adv_sca_1&617 ) * &618 ( sk(k,j+1,i) + sk(k,j,i) ) &619 - ( 8.0 * ibit5 * adv_sca_5&620 + ibit4 * adv_sca_3&621 ) * &622 ( sk(k,j+2,i) + sk(k,j-1,i) ) &623 + ( ibit5 * adv_sca_5&624 ) * &625 ( sk(k,j+3,i) + sk(k,j-2,i) ) &619 flux_n(k) = v_comp * ( & 620 ( 37.0_wp * ibit5 * adv_sca_5 & 621 + 7.0_wp * ibit4 * adv_sca_3 & 622 + ibit3 * adv_sca_1 & 623 ) * & 624 ( sk(k,j+1,i) + sk(k,j,i) ) & 625 - ( 8.0_wp * ibit5 * adv_sca_5 & 626 + ibit4 * adv_sca_3 & 627 ) * & 628 ( sk(k,j+2,i) + sk(k,j-1,i) ) & 629 + ( ibit5 * adv_sca_5 & 630 ) * & 631 ( sk(k,j+3,i) + sk(k,j-2,i) ) & 626 632 ) 627 633 628 diss_n(k) = -ABS( v_comp ) * ( &629 ( 10.0 * ibit5 * adv_sca_5&630 + 3.0 * ibit4 * adv_sca_3&631 + ibit3 * adv_sca_1&632 ) * &633 ( sk(k,j+1,i) - sk(k,j,i) )&634 - ( 5.0 * ibit5 * adv_sca_5&635 + ibit4 * adv_sca_3&636 ) * &637 ( sk(k,j+2,i) - sk(k,j-1,i) )&638 + ( ibit5 * adv_sca_5&639 ) * &640 ( sk(k,j+3,i) - sk(k,j-2,i) ) &634 diss_n(k) = -ABS( v_comp ) * ( & 635 ( 10.0_wp * ibit5 * adv_sca_5 & 636 + 3.0_wp * ibit4 * adv_sca_3 & 637 + ibit3 * adv_sca_1 & 638 ) * & 639 ( sk(k,j+1,i) - sk(k,j,i) ) & 640 - ( 5.0_wp * ibit5 * adv_sca_5 & 641 + ibit4 * adv_sca_3 & 642 ) * & 643 ( sk(k,j+2,i) - sk(k,j-1,i) ) & 644 + ( ibit5 * adv_sca_5 & 645 ) * & 646 ( sk(k,j+3,i) - sk(k,j-2,i) ) & 641 647 ) 642 648 ! … … 652 658 653 659 654 flux_t(k) = w(k,j,i) * ( &655 ( 37.0 * ibit8 * adv_sca_5&656 + 7.0 * ibit7 * adv_sca_3&657 + ibit6 * adv_sca_1&658 ) * &659 ( sk(k+1,j,i) + sk(k,j,i) )&660 - ( 8.0 * ibit8 * adv_sca_5&661 + ibit7 * adv_sca_3&662 ) * &663 ( sk(k_pp,j,i) + sk(k-1,j,i) )&664 + ( ibit8 * adv_sca_5&665 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) &660 flux_t(k) = w(k,j,i) * ( & 661 ( 37.0_wp * ibit8 * adv_sca_5 & 662 + 7.0_wp * ibit7 * adv_sca_3 & 663 + ibit6 * adv_sca_1 & 664 ) * & 665 ( sk(k+1,j,i) + sk(k,j,i) ) & 666 - ( 8.0_wp * ibit8 * adv_sca_5 & 667 + ibit7 * adv_sca_3 & 668 ) * & 669 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 670 + ( ibit8 * adv_sca_5 & 671 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 666 672 ) 667 673 668 diss_t(k) = -ABS( w(k,j,i) ) * ( &669 ( 10.0 * ibit8 * adv_sca_5&670 + 3.0 * ibit7 * adv_sca_3&671 + ibit6 * adv_sca_1&672 ) * &673 ( sk(k+1,j,i) - sk(k,j,i) ) &674 - ( 5.0 * ibit8 * adv_sca_5&675 + ibit7 * adv_sca_3&676 ) * &677 ( sk(k_pp,j,i) - sk(k-1,j,i) ) &678 + ( ibit8 * adv_sca_5&679 ) * &680 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) &674 diss_t(k) = -ABS( w(k,j,i) ) * ( & 675 ( 10.0_wp * ibit8 * adv_sca_5 & 676 + 3.0_wp * ibit7 * adv_sca_3 & 677 + ibit6 * adv_sca_1 & 678 ) * & 679 ( sk(k+1,j,i) - sk(k,j,i) ) & 680 - ( 5.0_wp * ibit8 * adv_sca_5 & 681 + ibit7 * adv_sca_3 & 682 ) * & 683 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 684 + ( ibit8 * adv_sca_5 & 685 ) * & 686 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & 681 687 ) 682 688 ! … … 712 718 713 719 u_comp = u(k,j,i+1) - u_gtrans 714 flux_r(k) = u_comp * ( &715 37.0 * ( sk(k,j,i+1) + sk(k,j,i) )&716 - 8.0 * ( sk(k,j,i+2) + sk(k,j,i-1) )&717 + ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5718 diss_r(k) = -ABS( u_comp ) * ( &719 10.0 * ( sk(k,j,i+1) - sk(k,j,i) )&720 - 5.0 * ( sk(k,j,i+2) - sk(k,j,i-1) )&721 + ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5720 flux_r(k) = u_comp * ( & 721 37.0_wp * ( sk(k,j,i+1) + sk(k,j,i) ) & 722 - 8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) ) & 723 + ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5 724 diss_r(k) = -ABS( u_comp ) * ( & 725 10.0_wp * ( sk(k,j,i+1) - sk(k,j,i) ) & 726 - 5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) ) & 727 + ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5 722 728 723 729 v_comp = v(k,j+1,i) - v_gtrans 724 flux_n(k) = v_comp * ( &725 37.0 * ( sk(k,j+1,i) + sk(k,j,i) )&726 - 8.0 * ( sk(k,j+2,i) + sk(k,j-1,i) )&727 + ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5728 diss_n(k) = -ABS( v_comp ) * ( &729 10.0 * ( sk(k,j+1,i) - sk(k,j,i) )&730 - 5.0 * ( sk(k,j+2,i) - sk(k,j-1,i) )&731 + ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5730 flux_n(k) = v_comp * ( & 731 37.0_wp * ( sk(k,j+1,i) + sk(k,j,i) ) & 732 - 8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) ) & 733 + ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5 734 diss_n(k) = -ABS( v_comp ) * ( & 735 10.0_wp * ( sk(k,j+1,i) - sk(k,j,i) ) & 736 - 5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) ) & 737 + ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5 732 738 ! 733 739 !-- k index has to be modified near bottom and top, else array … … 742 748 743 749 744 flux_t(k) = w(k,j,i) * ( &745 ( 37.0* ibit8 * adv_sca_5 &746 + 7.0* ibit7 * adv_sca_3 &747 +ibit6 * adv_sca_1 &748 ) *&749 ( sk(k+1,j,i) + sk(k,j,i) ) &750 - ( 8.0* ibit8 * adv_sca_5 &751 + ibit7 * adv_sca_3&752 ) *&753 ( sk(k_pp,j,i) + sk(k-1,j,i) ) &754 + (ibit8 * adv_sca_5 &755 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )&750 flux_t(k) = w(k,j,i) * ( & 751 ( 37.0_wp * ibit8 * adv_sca_5 & 752 + 7.0_wp * ibit7 * adv_sca_3 & 753 + ibit6 * adv_sca_1 & 754 ) * & 755 ( sk(k+1,j,i) + sk(k,j,i) ) & 756 - ( 8.0_wp * ibit8 * adv_sca_5 & 757 + ibit7 * adv_sca_3 & 758 ) * & 759 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 760 + ( ibit8 * adv_sca_5 & 761 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 756 762 ) 757 763 758 diss_t(k) = -ABS( w(k,j,i) ) * ( &759 ( 10.0* ibit8 * adv_sca_5 &760 + 3.0* ibit7 * adv_sca_3 &761 +ibit6 * adv_sca_1 &762 ) *&763 ( sk(k+1,j,i) - sk(k,j,i) ) &764 - ( 5.0* ibit8 * adv_sca_5 &765 +ibit7 * adv_sca_3 &766 ) *&767 ( sk(k_pp,j,i) - sk(k-1,j,i) ) &768 + (ibit8 * adv_sca_5 &769 ) *&770 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) &764 diss_t(k) = -ABS( w(k,j,i) ) * ( & 765 ( 10.0_wp * ibit8 * adv_sca_5 & 766 + 3.0_wp * ibit7 * adv_sca_3 & 767 + ibit6 * adv_sca_1 & 768 ) * & 769 ( sk(k+1,j,i) - sk(k,j,i) ) & 770 - ( 5.0_wp * ibit8 * adv_sca_5 & 771 + ibit7 * adv_sca_3 & 772 ) * & 773 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 774 + ( ibit8 * adv_sca_5 & 775 ) * & 776 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & 771 777 ) 772 778 ! … … 803 809 804 810 DO k = nzb, nzt 805 sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) + 806 ( flux_t(k) + diss_t(k) ) 811 sums_wspts_ws_l(k,tn) = sums_wspts_ws_l(k,tn) + & 812 ( flux_t(k) + diss_t(k) ) & 807 813 * weight_substep(intermediate_timestep_count) 808 814 ENDDO … … 811 817 812 818 DO k = nzb, nzt 813 sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) + 814 ( flux_t(k) + diss_t(k) ) 819 sums_wssas_ws_l(k,tn) = sums_wssas_ws_l(k,tn) + & 820 ( flux_t(k) + diss_t(k) ) & 815 821 * weight_substep(intermediate_timestep_count) 816 822 ENDDO … … 819 825 820 826 DO k = nzb, nzt 821 sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn) + 822 ( flux_t(k) + diss_t(k) ) 827 sums_wsqs_ws_l(k,tn) = sums_wsqs_ws_l(k,tn) + & 828 ( flux_t(k) + diss_t(k) ) & 823 829 * weight_substep(intermediate_timestep_count) 824 830 ENDDO … … 827 833 828 834 DO k = nzb, nzt 829 sums_wsqrs_ws_l(k,tn) = sums_wsqrs_ws_l(k,tn) + 830 ( flux_t(k) + diss_t(k) ) 835 sums_wsqrs_ws_l(k,tn) = sums_wsqrs_ws_l(k,tn) + & 836 ( flux_t(k) + diss_t(k) ) & 831 837 * weight_substep(intermediate_timestep_count) 832 838 ENDDO … … 835 841 836 842 DO k = nzb, nzt 837 sums_wsnrs_ws_l(k,tn) = sums_wsnrs_ws_l(k,tn) + 838 ( flux_t(k) + diss_t(k) ) 843 sums_wsnrs_ws_l(k,tn) = sums_wsnrs_ws_l(k,tn) + & 844 ( flux_t(k) + diss_t(k) ) & 839 845 * weight_substep(intermediate_timestep_count) 840 846 ENDDO … … 852 858 SUBROUTINE advec_u_ws_ij( i, j, i_omp, tn ) 853 859 854 USE arrays_3d, 860 USE arrays_3d, & 855 861 ONLY: ddzw, diss_l_u, diss_s_u, flux_l_u, flux_s_u, tend, u, v, w 856 862 857 USE constants, 863 USE constants, & 858 864 ONLY: adv_mom_1, adv_mom_3, adv_mom_5 859 865 860 USE control_parameters, 866 USE control_parameters, & 861 867 ONLY: intermediate_timestep_count, u_gtrans, v_gtrans 862 868 863 USE grid_variables, 869 USE grid_variables, & 864 870 ONLY: ddx, ddy 865 871 866 USE indices, 872 USE indices, & 867 873 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0 868 874 869 875 USE kinds 870 876 871 USE statistics, 877 USE statistics, & 872 878 ONLY: hom, sums_us2_ws_l, sums_wsus_ws_l, weight_substep 873 879 … … 909 915 REAL(wp), DIMENSION(nzb:nzt+1) :: u_comp !: 910 916 911 gu = 2.0 * u_gtrans912 gv = 2.0 * v_gtrans917 gu = 2.0_wp * u_gtrans 918 gv = 2.0_wp * v_gtrans 913 919 ! 914 920 !-- Compute southside fluxes for the respective boundary of PE … … 923 929 v_comp = v(k,j,i) + v(k,j,i-1) - gv 924 930 flux_s_u(k,tn) = v_comp * ( & 925 ( 37.0 * ibit14 * adv_mom_5&926 + 7.0 * ibit13 * adv_mom_3&927 + ibit12 * adv_mom_1&931 ( 37.0_wp * ibit14 * adv_mom_5 & 932 + 7.0_wp * ibit13 * adv_mom_3 & 933 + ibit12 * adv_mom_1 & 928 934 ) * & 929 ( u(k,j,i) + u(k,j-1,i) )&930 - ( 8.0 * ibit14 * adv_mom_5&931 + ibit13 * adv_mom_3&935 ( u(k,j,i) + u(k,j-1,i) ) & 936 - ( 8.0_wp * ibit14 * adv_mom_5 & 937 + ibit13 * adv_mom_3 & 932 938 ) * & 933 ( u(k,j+1,i) + u(k,j-2,i) )&934 + ( ibit14 * adv_mom_5&939 ( u(k,j+1,i) + u(k,j-2,i) ) & 940 + ( ibit14 * adv_mom_5 & 935 941 ) * & 936 ( u(k,j+2,i) + u(k,j-3,i) )&942 ( u(k,j+2,i) + u(k,j-3,i) ) & 937 943 ) 938 944 939 945 diss_s_u(k,tn) = - ABS ( v_comp ) * ( & 940 ( 10.0 * ibit14 * adv_mom_5&941 + 3.0 * ibit13 * adv_mom_3&942 + ibit12 * adv_mom_1&946 ( 10.0_wp * ibit14 * adv_mom_5 & 947 + 3.0_wp * ibit13 * adv_mom_3 & 948 + ibit12 * adv_mom_1 & 943 949 ) * & 944 ( u(k,j,i) - u(k,j-1,i) )&945 - ( 5.0 * ibit14 * adv_mom_5&946 + ibit13 * adv_mom_3&950 ( u(k,j,i) - u(k,j-1,i) ) & 951 - ( 5.0_wp * ibit14 * adv_mom_5 & 952 + ibit13 * adv_mom_3 & 947 953 ) * & 948 ( u(k,j+1,i) - u(k,j-2,i) )&949 + ( ibit14 * adv_mom_5&954 ( u(k,j+1,i) - u(k,j-2,i) ) & 955 + ( ibit14 * adv_mom_5 & 950 956 ) * & 951 ( u(k,j+2,i) - u(k,j-3,i) )&957 ( u(k,j+2,i) - u(k,j-3,i) ) & 952 958 ) 953 959 … … 958 964 v_comp = v(k,j,i) + v(k,j,i-1) - gv 959 965 flux_s_u(k,tn) = v_comp * ( & 960 37.0 * ( u(k,j,i) + u(k,j-1,i) )&961 - 8.0 * ( u(k,j+1,i) + u(k,j-2,i) )&962 + ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5966 37.0_wp * ( u(k,j,i) + u(k,j-1,i) ) & 967 - 8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) ) & 968 + ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5 963 969 diss_s_u(k,tn) = - ABS(v_comp) * ( & 964 10.0 * ( u(k,j,i) - u(k,j-1,i) )&965 - 5.0 * ( u(k,j+1,i) - u(k,j-2,i) )&966 + ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5970 10.0_wp * ( u(k,j,i) - u(k,j-1,i) ) & 971 - 5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) ) & 972 + ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5 967 973 968 974 ENDDO … … 980 986 981 987 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu 982 flux_l_u(k,j,tn) = u_comp_l * ( 983 ( 37.0 * ibit11 * adv_mom_5&984 + 7.0 * ibit10 * adv_mom_3&985 + ibit9 * adv_mom_1&986 ) * 987 ( u(k,j,i) + u(k,j,i-1) )&988 - ( 8.0 * ibit11 * adv_mom_5&989 + ibit10 * adv_mom_3&990 ) * 991 ( u(k,j,i+1) + u(k,j,i-2) )&992 + ( ibit11 * adv_mom_5&993 ) * 994 ( u(k,j,i+2) + u(k,j,i-3) )&988 flux_l_u(k,j,tn) = u_comp_l * ( & 989 ( 37.0_wp * ibit11 * adv_mom_5 & 990 + 7.0_wp * ibit10 * adv_mom_3 & 991 + ibit9 * adv_mom_1 & 992 ) * & 993 ( u(k,j,i) + u(k,j,i-1) ) & 994 - ( 8.0_wp * ibit11 * adv_mom_5 & 995 + ibit10 * adv_mom_3 & 996 ) * & 997 ( u(k,j,i+1) + u(k,j,i-2) ) & 998 + ( ibit11 * adv_mom_5 & 999 ) * & 1000 ( u(k,j,i+2) + u(k,j,i-3) ) & 995 1001 ) 996 1002 997 diss_l_u(k,j,tn) = - ABS( u_comp_l ) * ( 998 ( 10.0 * ibit11 * adv_mom_5&999 + 3.0 * ibit10 * adv_mom_3&1000 + ibit9 * adv_mom_1&1001 ) * 1002 ( u(k,j,i) - u(k,j,i-1) )&1003 - ( 5.0 * ibit11 * adv_mom_5&1004 + ibit10 * adv_mom_3&1005 ) * 1006 ( u(k,j,i+1) - u(k,j,i-2) )&1007 + ( ibit11 * adv_mom_5&1008 ) * 1009 ( u(k,j,i+2) - u(k,j,i-3) )&1003 diss_l_u(k,j,tn) = - ABS( u_comp_l ) * ( & 1004 ( 10.0_wp * ibit11 * adv_mom_5 & 1005 + 3.0_wp * ibit10 * adv_mom_3 & 1006 + ibit9 * adv_mom_1 & 1007 ) * & 1008 ( u(k,j,i) - u(k,j,i-1) ) & 1009 - ( 5.0_wp * ibit11 * adv_mom_5 & 1010 + ibit10 * adv_mom_3 & 1011 ) * & 1012 ( u(k,j,i+1) - u(k,j,i-2) ) & 1013 + ( ibit11 * adv_mom_5 & 1014 ) * & 1015 ( u(k,j,i+2) - u(k,j,i-3) ) & 1010 1016 ) 1011 1017 … … 1016 1022 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu 1017 1023 flux_l_u(k,j,tn) = u_comp_l * ( & 1018 37.0 * ( u(k,j,i) + u(k,j,i-1) )&1019 - 8.0 * ( u(k,j,i+1) + u(k,j,i-2) )&1020 + ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_51024 37.0_wp * ( u(k,j,i) + u(k,j,i-1) ) & 1025 - 8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) ) & 1026 + ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5 1021 1027 diss_l_u(k,j,tn) = - ABS(u_comp_l) * ( & 1022 10.0 * ( u(k,j,i) - u(k,j,i-1) )&1023 - 5.0 * ( u(k,j,i+1) - u(k,j,i-2) )&1024 + ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_51028 10.0_wp * ( u(k,j,i) - u(k,j,i-1) ) & 1029 - 5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) ) & 1030 + ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5 1025 1031 1026 1032 ENDDO … … 1028 1034 ENDIF 1029 1035 1030 flux_t(0) = 0.0 1031 diss_t(0) = 0.0 1032 flux_d = 0.0 1033 diss_d = 0.0 1036 flux_t(0) = 0.0_wp 1037 diss_t(0) = 0.0_wp 1038 flux_d = 0.0_wp 1039 diss_d = 0.0_wp 1034 1040 ! 1035 1041 !-- Now compute the fluxes tendency terms for the horizontal and … … 1042 1048 1043 1049 u_comp(k) = u(k,j,i+1) + u(k,j,i) 1044 flux_r(k) = ( u_comp(k) - gu ) * ( &1045 ( 37.0 * ibit11 * adv_mom_5&1046 + 7.0 * ibit10 * adv_mom_3&1047 + ibit9 * adv_mom_1&1048 ) * &1049 ( u(k,j,i+1) + u(k,j,i) )&1050 - ( 8.0 * ibit11 * adv_mom_5&1051 + ibit10 * adv_mom_3 &1052 ) * &1053 ( u(k,j,i+2) + u(k,j,i-1) )&1054 + ( ibit11 * adv_mom_5&1055 ) * &1056 ( u(k,j,i+3) + u(k,j,i-2) )&1050 flux_r(k) = ( u_comp(k) - gu ) * ( & 1051 ( 37.0_wp * ibit11 * adv_mom_5 & 1052 + 7.0_wp * ibit10 * adv_mom_3 & 1053 + ibit9 * adv_mom_1 & 1054 ) * & 1055 ( u(k,j,i+1) + u(k,j,i) ) & 1056 - ( 8.0_wp * ibit11 * adv_mom_5 & 1057 + ibit10 * adv_mom_3 & 1058 ) * & 1059 ( u(k,j,i+2) + u(k,j,i-1) ) & 1060 + ( ibit11 * adv_mom_5 & 1061 ) * & 1062 ( u(k,j,i+3) + u(k,j,i-2) ) & 1057 1063 ) 1058 1064 1059 diss_r(k) = - ABS( u_comp(k) - gu ) * ( &1060 ( 10.0 * ibit11 * adv_mom_5&1061 + 3.0 * ibit10 * adv_mom_3&1062 + ibit9 * adv_mom_1&1063 ) * &1064 ( u(k,j,i+1) - u(k,j,i) )&1065 - ( 5.0 * ibit11 * adv_mom_5&1066 + ibit10 * adv_mom_3&1067 ) * &1068 ( u(k,j,i+2) - u(k,j,i-1) )&1069 + ( ibit11 * adv_mom_5&1070 ) * &1071 ( u(k,j,i+3) - u(k,j,i-2) )&1065 diss_r(k) = - ABS( u_comp(k) - gu ) * ( & 1066 ( 10.0_wp * ibit11 * adv_mom_5 & 1067 + 3.0_wp * ibit10 * adv_mom_3 & 1068 + ibit9 * adv_mom_1 & 1069 ) * & 1070 ( u(k,j,i+1) - u(k,j,i) ) & 1071 - ( 5.0_wp * ibit11 * adv_mom_5 & 1072 + ibit10 * adv_mom_3 & 1073 ) * & 1074 ( u(k,j,i+2) - u(k,j,i-1) ) & 1075 + ( ibit11 * adv_mom_5 & 1076 ) * & 1077 ( u(k,j,i+3) - u(k,j,i-2) ) & 1072 1078 ) 1073 1079 … … 1077 1083 1078 1084 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 1079 flux_n(k) = v_comp * ( &1080 ( 37.0 * ibit14 * adv_mom_5&1081 + 7.0 * ibit13 * adv_mom_3&1082 + ibit12 * adv_mom_1&1083 ) * &1084 ( u(k,j+1,i) + u(k,j,i) )&1085 - ( 8.0 * ibit14 * adv_mom_5&1086 + ibit13 * adv_mom_3&1087 ) * &1088 ( u(k,j+2,i) + u(k,j-1,i) )&1089 + ( ibit14 * adv_mom_5&1090 ) * &1091 ( u(k,j+3,i) + u(k,j-2,i) )&1085 flux_n(k) = v_comp * ( & 1086 ( 37.0_wp * ibit14 * adv_mom_5 & 1087 + 7.0_wp * ibit13 * adv_mom_3 & 1088 + ibit12 * adv_mom_1 & 1089 ) * & 1090 ( u(k,j+1,i) + u(k,j,i) ) & 1091 - ( 8.0_wp * ibit14 * adv_mom_5 & 1092 + ibit13 * adv_mom_3 & 1093 ) * & 1094 ( u(k,j+2,i) + u(k,j-1,i) ) & 1095 + ( ibit14 * adv_mom_5 & 1096 ) * & 1097 ( u(k,j+3,i) + u(k,j-2,i) ) & 1092 1098 ) 1093 1099 1094 diss_n(k) = - ABS ( v_comp ) * ( &1095 ( 10.0 * ibit14 * adv_mom_5&1096 + 3.0 * ibit13 * adv_mom_3&1097 + ibit12 * adv_mom_1&1098 ) * &1099 ( u(k,j+1,i) - u(k,j,i) )&1100 - ( 5.0 * ibit14 * adv_mom_5&1101 + ibit13 * adv_mom_3&1102 ) * &1103 ( u(k,j+2,i) - u(k,j-1,i) )&1104 + ( ibit14 * adv_mom_5&1105 ) * &1106 ( u(k,j+3,i) - u(k,j-2,i) )&1100 diss_n(k) = - ABS ( v_comp ) * ( & 1101 ( 10.0_wp * ibit14 * adv_mom_5 & 1102 + 3.0_wp * ibit13 * adv_mom_3 & 1103 + ibit12 * adv_mom_1 & 1104 ) * & 1105 ( u(k,j+1,i) - u(k,j,i) ) & 1106 - ( 5.0_wp * ibit14 * adv_mom_5 & 1107 + ibit13 * adv_mom_3 & 1108 ) * & 1109 ( u(k,j+2,i) - u(k,j-1,i) ) & 1110 + ( ibit14 * adv_mom_5 & 1111 ) * & 1112 ( u(k,j+3,i) - u(k,j-2,i) ) & 1107 1113 ) 1108 1114 ! … … 1118 1124 1119 1125 w_comp = w(k,j,i) + w(k,j,i-1) 1120 flux_t(k) = w_comp * ( &1121 ( 37.0 * ibit17 * adv_mom_5&1122 + 7.0 * ibit16 * adv_mom_3&1123 + ibit15 * adv_mom_1&1124 ) * &1125 ( u(k+1,j,i) + u(k,j,i) )&1126 - ( 8.0 * ibit17 * adv_mom_5&1127 + ibit16 * adv_mom_3&1128 ) * &1129 ( u(k_pp,j,i) + u(k-1,j,i) )&1130 + ( ibit17 * adv_mom_5&1131 ) * &1132 ( u(k_ppp,j,i) + u(k_mm,j,i) )&1126 flux_t(k) = w_comp * ( & 1127 ( 37.0_wp * ibit17 * adv_mom_5 & 1128 + 7.0_wp * ibit16 * adv_mom_3 & 1129 + ibit15 * adv_mom_1 & 1130 ) * & 1131 ( u(k+1,j,i) + u(k,j,i) ) & 1132 - ( 8.0_wp * ibit17 * adv_mom_5 & 1133 + ibit16 * adv_mom_3 & 1134 ) * & 1135 ( u(k_pp,j,i) + u(k-1,j,i) ) & 1136 + ( ibit17 * adv_mom_5 & 1137 ) * & 1138 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & 1133 1139 ) 1134 1140 1135 diss_t(k) = - ABS( w_comp ) * ( &1136 ( 10.0 * ibit17 * adv_mom_5&1137 + 3.0 * ibit16 * adv_mom_3&1138 + ibit15 * adv_mom_1&1139 ) * &1140 ( u(k+1,j,i) - u(k,j,i) )&1141 - ( 5.0 * ibit17 * adv_mom_5&1142 + ibit16 * adv_mom_3&1143 ) * &1144 ( u(k_pp,j,i) - u(k-1,j,i) )&1145 + ( ibit17 * adv_mom_5&1146 ) * &1147 ( u(k_ppp,j,i) - u(k_mm,j,i) )&1141 diss_t(k) = - ABS( w_comp ) * ( & 1142 ( 10.0_wp * ibit17 * adv_mom_5 & 1143 + 3.0_wp * ibit16 * adv_mom_3 & 1144 + ibit15 * adv_mom_1 & 1145 ) * & 1146 ( u(k+1,j,i) - u(k,j,i) ) & 1147 - ( 5.0_wp * ibit17 * adv_mom_5 & 1148 + ibit16 * adv_mom_3 & 1149 ) * & 1150 ( u(k_pp,j,i) - u(k-1,j,i) ) & 1151 + ( ibit17 * adv_mom_5 & 1152 ) * & 1153 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & 1148 1154 ) 1149 1155 ! … … 1151 1157 !-- correction is needed to overcome numerical instabilities introduced 1152 1158 !-- by a not sufficient reduction of divergences near topography. 1153 div = ( ( u_comp(k) - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx &1154 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy &1155 + ( w_comp - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) * ddzw(k) &1156 ) * 0.5 1159 div = ( ( u_comp(k) - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx & 1160 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy & 1161 + ( w_comp - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) * ddzw(k) & 1162 ) * 0.5_wp 1157 1163 1158 1164 tend(k,j,i) = tend(k,j,i) - ( & … … 1176 1182 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 1177 1183 + ( flux_r(k) * & 1178 ( u_comp(k) - 2.0 * hom(k,1,1,0) )&1184 ( u_comp(k) - 2.0_wp * hom(k,1,1,0) ) & 1179 1185 / ( u_comp(k) - gu + 1.0E-20_wp ) & 1180 1186 + diss_r(k) * & 1181 ABS( u_comp(k) - 2.0 * hom(k,1,1,0) )&1187 ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) ) & 1182 1188 / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) ) & 1183 1189 * weight_substep(intermediate_timestep_count) … … 1193 1199 u_comp(k) = u(k,j,i+1) + u(k,j,i) 1194 1200 flux_r(k) = ( u_comp(k) - gu ) * ( & 1195 37.0 * ( u(k,j,i+1) + u(k,j,i) )&1196 - 8.0 * ( u(k,j,i+2) + u(k,j,i-1) )&1197 + ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_51201 37.0_wp * ( u(k,j,i+1) + u(k,j,i) ) & 1202 - 8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) ) & 1203 + ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5 1198 1204 diss_r(k) = - ABS( u_comp(k) - gu ) * ( & 1199 10.0 * ( u(k,j,i+1) - u(k,j,i) )&1200 - 5.0 * ( u(k,j,i+2) - u(k,j,i-1) )&1201 + ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_51205 10.0_wp * ( u(k,j,i+1) - u(k,j,i) ) & 1206 - 5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) ) & 1207 + ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5 1202 1208 1203 1209 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 1204 1210 flux_n(k) = v_comp * ( & 1205 37.0 * ( u(k,j+1,i) + u(k,j,i) )&1206 - 8.0 * ( u(k,j+2,i) + u(k,j-1,i) )&1207 + ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_51211 37.0_wp * ( u(k,j+1,i) + u(k,j,i) ) & 1212 - 8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) ) & 1213 + ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5 1208 1214 diss_n(k) = - ABS( v_comp ) * ( & 1209 10.0 * ( u(k,j+1,i) - u(k,j,i) )&1210 - 5.0 * ( u(k,j+2,i) - u(k,j-1,i) )&1211 + ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_51215 10.0_wp * ( u(k,j+1,i) - u(k,j,i) ) & 1216 - 5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) ) & 1217 + ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5 1212 1218 ! 1213 1219 !-- k index has to be modified near bottom and top, else array … … 1222 1228 1223 1229 w_comp = w(k,j,i) + w(k,j,i-1) 1224 flux_t(k) = w_comp * ( &1225 ( 37.0 * ibit17 * adv_mom_5&1226 + 7.0 * ibit16 * adv_mom_3&1227 + ibit15 * adv_mom_1&1228 ) * &1229 ( u(k+1,j,i) + u(k,j,i) )&1230 - ( 8.0 * ibit17 * adv_mom_5&1231 + ibit16 * adv_mom_3&1232 ) * &1233 ( u(k_pp,j,i) + u(k-1,j,i) )&1234 + ( ibit17 * adv_mom_5&1235 ) * &1236 ( u(k_ppp,j,i) + u(k_mm,j,i) )&1230 flux_t(k) = w_comp * ( & 1231 ( 37.0_wp * ibit17 * adv_mom_5 & 1232 + 7.0_wp * ibit16 * adv_mom_3 & 1233 + ibit15 * adv_mom_1 & 1234 ) * & 1235 ( u(k+1,j,i) + u(k,j,i) ) & 1236 - ( 8.0_wp * ibit17 * adv_mom_5 & 1237 + ibit16 * adv_mom_3 & 1238 ) * & 1239 ( u(k_pp,j,i) + u(k-1,j,i) ) & 1240 + ( ibit17 * adv_mom_5 & 1241 ) * & 1242 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & 1237 1243 ) 1238 1244 1239 diss_t(k) = - ABS( w_comp ) * ( &1240 ( 10.0 * ibit17 * adv_mom_5&1241 + 3.0 * ibit16 * adv_mom_3&1242 + ibit15 * adv_mom_1&1243 ) * &1244 ( u(k+1,j,i) - u(k,j,i) )&1245 - ( 5.0 * ibit17 * adv_mom_5&1246 + ibit16 * adv_mom_3&1247 ) * &1248 ( u(k_pp,j,i) - u(k-1,j,i) )&1249 + ( ibit17 * adv_mom_5&1250 ) * &1251 ( u(k_ppp,j,i) - u(k_mm,j,i) )&1245 diss_t(k) = - ABS( w_comp ) * ( & 1246 ( 10.0_wp * ibit17 * adv_mom_5 & 1247 + 3.0_wp * ibit16 * adv_mom_3 & 1248 + ibit15 * adv_mom_1 & 1249 ) * & 1250 ( u(k+1,j,i) - u(k,j,i) ) & 1251 - ( 5.0_wp * ibit17 * adv_mom_5 & 1252 + ibit16 * adv_mom_3 & 1253 ) * & 1254 ( u(k_pp,j,i) - u(k-1,j,i) ) & 1255 + ( ibit17 * adv_mom_5 & 1256 ) * & 1257 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & 1252 1258 ) 1253 1259 ! … … 1255 1261 !-- correction is needed to overcome numerical instabilities introduced 1256 1262 !-- by a not sufficient reduction of divergences near topography. 1257 div = ( ( u_comp(k) - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx &1258 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy &1259 + ( w_comp - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) * ddzw(k) &1260 ) * 0.5 1263 div = ( ( u_comp(k) - ( u(k,j,i) + u(k,j,i-1) ) ) * ddx & 1264 + ( v_comp + gv - ( v(k,j,i) + v(k,j,i-1 ) ) ) * ddy & 1265 + ( w_comp - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) * ddzw(k) & 1266 ) * 0.5_wp 1261 1267 1262 1268 tend(k,j,i) = tend(k,j,i) - ( & … … 1280 1286 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 1281 1287 + ( flux_r(k) * & 1282 ( u_comp(k) - 2.0 * hom(k,1,1,0) )&1283 / ( u_comp(k) - gu + 1.0E-20_wp )&1288 ( u_comp(k) - 2.0_wp * hom(k,1,1,0) ) & 1289 / ( u_comp(k) - gu + 1.0E-20_wp ) & 1284 1290 + diss_r(k) * & 1285 ABS( u_comp(k) - 2.0 * hom(k,1,1,0) )&1291 ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) ) & 1286 1292 / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) ) & 1287 1293 * weight_substep(intermediate_timestep_count) … … 1363 1369 REAL(wp), DIMENSION(nzb:nzt+1) :: v_comp !: 1364 1370 1365 gu = 2.0 * u_gtrans1366 gv = 2.0 * v_gtrans1371 gu = 2.0_wp * u_gtrans 1372 gv = 2.0_wp * v_gtrans 1367 1373 1368 1374 ! … … 1377 1383 1378 1384 u_comp = u(k,j-1,i) + u(k,j,i) - gu 1379 flux_l_v(k,j,tn) = u_comp * ( 1380 ( 37.0 * ibit20 * adv_mom_5&1381 + 7.0 * ibit19 * adv_mom_3&1382 + ibit18 * adv_mom_1&1383 ) * 1384 ( v(k,j,i) + v(k,j,i-1) )&1385 - ( 8.0 * ibit20 * adv_mom_5&1386 + ibit19 * adv_mom_3&1387 ) * 1388 ( v(k,j,i+1) + v(k,j,i-2) )&1389 + ( ibit20 * adv_mom_5&1390 ) * 1391 ( v(k,j,i+2) + v(k,j,i-3) )&1385 flux_l_v(k,j,tn) = u_comp * ( & 1386 ( 37.0_wp * ibit20 * adv_mom_5 & 1387 + 7.0_wp * ibit19 * adv_mom_3 & 1388 + ibit18 * adv_mom_1 & 1389 ) * & 1390 ( v(k,j,i) + v(k,j,i-1) ) & 1391 - ( 8.0_wp * ibit20 * adv_mom_5 & 1392 + ibit19 * adv_mom_3 & 1393 ) * & 1394 ( v(k,j,i+1) + v(k,j,i-2) ) & 1395 + ( ibit20 * adv_mom_5 & 1396 ) * & 1397 ( v(k,j,i+2) + v(k,j,i-3) ) & 1392 1398 ) 1393 1399 1394 diss_l_v(k,j,tn) = - ABS( u_comp ) * ( 1395 ( 10.0 * ibit20 * adv_mom_5&1396 + 3.0 * ibit19 * adv_mom_3&1397 + ibit18 * adv_mom_1&1398 ) * 1399 ( v(k,j,i) - v(k,j,i-1) )&1400 - ( 5.0 * ibit20 * adv_mom_5&1401 + ibit19 * adv_mom_3&1402 ) * 1403 ( v(k,j,i+1) - v(k,j,i-2) )&1404 + ( ibit20 * adv_mom_5&1405 ) * 1406 ( v(k,j,i+2) - v(k,j,i-3) )&1400 diss_l_v(k,j,tn) = - ABS( u_comp ) * ( & 1401 ( 10.0_wp * ibit20 * adv_mom_5 & 1402 + 3.0_wp * ibit19 * adv_mom_3 & 1403 + ibit18 * adv_mom_1 & 1404 ) * & 1405 ( v(k,j,i) - v(k,j,i-1) ) & 1406 - ( 5.0_wp * ibit20 * adv_mom_5 & 1407 + ibit19 * adv_mom_3 & 1408 ) * & 1409 ( v(k,j,i+1) - v(k,j,i-2) ) & 1410 + ( ibit20 * adv_mom_5 & 1411 ) * & 1412 ( v(k,j,i+2) - v(k,j,i-3) ) & 1407 1413 ) 1408 1414 … … 1413 1419 u_comp = u(k,j-1,i) + u(k,j,i) - gu 1414 1420 flux_l_v(k,j,tn) = u_comp * ( & 1415 37.0 * ( v(k,j,i) + v(k,j,i-1) )&1416 - 8.0 * ( v(k,j,i+1) + v(k,j,i-2) )&1417 + ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_51421 37.0_wp * ( v(k,j,i) + v(k,j,i-1) ) & 1422 - 8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) ) & 1423 + ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5 1418 1424 diss_l_v(k,j,tn) = - ABS( u_comp ) * ( & 1419 10.0 * ( v(k,j,i) - v(k,j,i-1) )&1420 - 5.0 * ( v(k,j,i+1) - v(k,j,i-2) )&1421 + ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_51425 10.0_wp * ( v(k,j,i) - v(k,j,i-1) ) & 1426 - 5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) ) & 1427 + ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5 1422 1428 1423 1429 ENDDO … … 1436 1442 v_comp_l = v(k,j,i) + v(k,j-1,i) - gv 1437 1443 flux_s_v(k,tn) = v_comp_l * ( & 1438 ( 37.0 * ibit23 * adv_mom_5&1439 + 7.0 * ibit22 * adv_mom_3&1440 + ibit21 * adv_mom_1&1444 ( 37.0_wp * ibit23 * adv_mom_5 & 1445 + 7.0_wp * ibit22 * adv_mom_3 & 1446 + ibit21 * adv_mom_1 & 1441 1447 ) * & 1442 ( v(k,j,i) + v(k,j-1,i) )&1443 - ( 8.0 * ibit23 * adv_mom_5&1444 + ibit22 * adv_mom_3&1448 ( v(k,j,i) + v(k,j-1,i) ) & 1449 - ( 8.0_wp * ibit23 * adv_mom_5 & 1450 + ibit22 * adv_mom_3 & 1445 1451 ) * & 1446 ( v(k,j+1,i) + v(k,j-2,i) )&1447 + ( ibit23 * adv_mom_5&1452 ( v(k,j+1,i) + v(k,j-2,i) ) & 1453 + ( ibit23 * adv_mom_5 & 1448 1454 ) * & 1449 ( v(k,j+2,i) + v(k,j-3,i) )&1455 ( v(k,j+2,i) + v(k,j-3,i) ) & 1450 1456 ) 1451 1457 1452 1458 diss_s_v(k,tn) = - ABS( v_comp_l ) * ( & 1453 ( 10.0 * ibit23 * adv_mom_5&1454 + 3.0 * ibit22 * adv_mom_3&1455 + ibit21 * adv_mom_1&1459 ( 10.0_wp * ibit23 * adv_mom_5 & 1460 + 3.0_wp * ibit22 * adv_mom_3 & 1461 + ibit21 * adv_mom_1 & 1456 1462 ) * & 1457 ( v(k,j,i) - v(k,j-1,i) )&1458 - ( 5.0 * ibit23 * adv_mom_5&1459 + ibit22 * adv_mom_3&1463 ( v(k,j,i) - v(k,j-1,i) ) & 1464 - ( 5.0_wp * ibit23 * adv_mom_5 & 1465 + ibit22 * adv_mom_3 & 1460 1466 ) * & 1461 ( v(k,j+1,i) - v(k,j-2,i) )&1462 + ( ibit23 * adv_mom_5&1467 ( v(k,j+1,i) - v(k,j-2,i) ) & 1468 + ( ibit23 * adv_mom_5 & 1463 1469 ) * & 1464 ( v(k,j+2,i) - v(k,j-3,i) )&1465 )1470 ( v(k,j+2,i) - v(k,j-3,i) ) & 1471 ) 1466 1472 1467 1473 ENDDO … … 1471 1477 v_comp_l = v(k,j,i) + v(k,j-1,i) - gv 1472 1478 flux_s_v(k,tn) = v_comp_l * ( & 1473 37.0 * ( v(k,j,i) + v(k,j-1,i) )&1474 - 8.0 * ( v(k,j+1,i) + v(k,j-2,i) )&1475 + ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_51479 37.0_wp * ( v(k,j,i) + v(k,j-1,i) ) & 1480 - 8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) ) & 1481 + ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5 1476 1482 diss_s_v(k,tn) = - ABS( v_comp_l ) * ( & 1477 10.0 * ( v(k,j,i) - v(k,j-1,i) )&1478 - 5.0 * ( v(k,j+1,i) - v(k,j-2,i) )&1479 + ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_51483 10.0_wp * ( v(k,j,i) - v(k,j-1,i) ) & 1484 - 5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) ) & 1485 + ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5 1480 1486 1481 1487 ENDDO … … 1483 1489 ENDIF 1484 1490 1485 flux_t(0) = 0.0 1486 diss_t(0) = 0.0 1487 flux_d = 0.0 1488 diss_d = 0.0 1491 flux_t(0) = 0.0_wp 1492 diss_t(0) = 0.0_wp 1493 flux_d = 0.0_wp 1494 diss_d = 0.0_wp 1489 1495 ! 1490 1496 !-- Now compute the fluxes and tendency terms for the horizontal and … … 1497 1503 1498 1504 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 1499 flux_r(k) = u_comp * ( &1500 ( 37.0 * ibit20 * adv_mom_5&1501 + 7.0 * ibit19 * adv_mom_3&1502 + ibit18 * adv_mom_1&1503 ) * &1504 ( v(k,j,i+1) + v(k,j,i) )&1505 - ( 8.0 * ibit20 * adv_mom_5&1506 + ibit19 * adv_mom_3&1507 ) * &1508 ( v(k,j,i+2) + v(k,j,i-1) )&1509 + ( ibit20 * adv_mom_5&1510 ) * &1511 ( v(k,j,i+3) + v(k,j,i-2) )&1505 flux_r(k) = u_comp * ( & 1506 ( 37.0_wp * ibit20 * adv_mom_5 & 1507 + 7.0_wp * ibit19 * adv_mom_3 & 1508 + ibit18 * adv_mom_1 & 1509 ) * & 1510 ( v(k,j,i+1) + v(k,j,i) ) & 1511 - ( 8.0_wp * ibit20 * adv_mom_5 & 1512 + ibit19 * adv_mom_3 & 1513 ) * & 1514 ( v(k,j,i+2) + v(k,j,i-1) ) & 1515 + ( ibit20 * adv_mom_5 & 1516 ) * & 1517 ( v(k,j,i+3) + v(k,j,i-2) ) & 1512 1518 ) 1513 1519 1514 diss_r(k) = - ABS( u_comp ) * ( &1515 ( 10.0 * ibit20 * adv_mom_5&1516 + 3.0 * ibit19 * adv_mom_3&1517 + ibit18 * adv_mom_1&1518 ) * &1519 ( v(k,j,i+1) - v(k,j,i) )&1520 - ( 5.0 * ibit20 * adv_mom_5&1521 + ibit19 * adv_mom_3&1522 ) * &1523 ( v(k,j,i+2) - v(k,j,i-1) )&1524 + ( ibit20 * adv_mom_5&1525 ) * &1526 ( v(k,j,i+3) - v(k,j,i-2) )&1520 diss_r(k) = - ABS( u_comp ) * ( & 1521 ( 10.0_wp * ibit20 * adv_mom_5 & 1522 + 3.0_wp * ibit19 * adv_mom_3 & 1523 + ibit18 * adv_mom_1 & 1524 ) * & 1525 ( v(k,j,i+1) - v(k,j,i) ) & 1526 - ( 5.0_wp * ibit20 * adv_mom_5 & 1527 + ibit19 * adv_mom_3 & 1528 ) * & 1529 ( v(k,j,i+2) - v(k,j,i-1) ) & 1530 + ( ibit20 * adv_mom_5 & 1531 ) * & 1532 ( v(k,j,i+3) - v(k,j,i-2) ) & 1527 1533 ) 1528 1534 … … 1533 1539 1534 1540 v_comp(k) = v(k,j+1,i) + v(k,j,i) 1535 flux_n(k) = ( v_comp(k) - gv ) * ( &1536 ( 37.0 * ibit23 * adv_mom_5&1537 + 7.0 * ibit22 * adv_mom_3&1538 + ibit21 * adv_mom_1&1539 ) * &1540 ( v(k,j+1,i) + v(k,j,i) )&1541 - ( 8.0 * ibit23 * adv_mom_5&1542 + ibit22 * adv_mom_3&1543 ) * &1544 ( v(k,j+2,i) + v(k,j-1,i) )&1545 + ( ibit23 * adv_mom_5&1546 ) * &1547 ( v(k,j+3,i) + v(k,j-2,i) )&1548 )1549 1550 diss_n(k) = - ABS( v_comp(k) - gv ) * ( &1551 ( 10.0 * ibit23 * adv_mom_5&1552 + 3.0 * ibit22 * adv_mom_3&1553 + ibit21 * adv_mom_1&1554 ) * &1555 ( v(k,j+1,i) - v(k,j,i) )&1556 - ( 5.0 * ibit23 * adv_mom_5&1557 + ibit22 * adv_mom_3&1558 ) * &1559 ( v(k,j+2,i) - v(k,j-1,i) )&1560 + ( ibit23 * adv_mom_5&1561 ) * &1562 ( v(k,j+3,i) - v(k,j-2,i) )&1563 )1541 flux_n(k) = ( v_comp(k) - gv ) * ( & 1542 ( 37.0_wp * ibit23 * adv_mom_5 & 1543 + 7.0_wp * ibit22 * adv_mom_3 & 1544 + ibit21 * adv_mom_1 & 1545 ) * & 1546 ( v(k,j+1,i) + v(k,j,i) ) & 1547 - ( 8.0_wp * ibit23 * adv_mom_5 & 1548 + ibit22 * adv_mom_3 & 1549 ) * & 1550 ( v(k,j+2,i) + v(k,j-1,i) ) & 1551 + ( ibit23 * adv_mom_5 & 1552 ) * & 1553 ( v(k,j+3,i) + v(k,j-2,i) ) & 1554 ) 1555 1556 diss_n(k) = - ABS( v_comp(k) - gv ) * ( & 1557 ( 10.0_wp * ibit23 * adv_mom_5 & 1558 + 3.0_wp * ibit22 * adv_mom_3 & 1559 + ibit21 * adv_mom_1 & 1560 ) * & 1561 ( v(k,j+1,i) - v(k,j,i) ) & 1562 - ( 5.0_wp * ibit23 * adv_mom_5 & 1563 + ibit22 * adv_mom_3 & 1564 ) * & 1565 ( v(k,j+2,i) - v(k,j-1,i) ) & 1566 + ( ibit23 * adv_mom_5 & 1567 ) * & 1568 ( v(k,j+3,i) - v(k,j-2,i) ) & 1569 ) 1564 1570 ! 1565 1571 !-- k index has to be modified near bottom and top, else array … … 1574 1580 1575 1581 w_comp = w(k,j-1,i) + w(k,j,i) 1576 flux_t(k) = w_comp * ( &1577 ( 37.0 * ibit26 * adv_mom_5&1578 + 7.0 * ibit25 * adv_mom_3&1579 + ibit24 * adv_mom_1&1580 ) * &1581 ( v(k+1,j,i) + v(k,j,i) )&1582 - ( 8.0 * ibit26 * adv_mom_5&1583 + ibit25 * adv_mom_3&1584 ) * &1585 ( v(k_pp,j,i) + v(k-1,j,i) )&1586 + ( ibit26 * adv_mom_5&1587 ) * &1588 ( v(k_ppp,j,i) + v(k_mm,j,i) )&1582 flux_t(k) = w_comp * ( & 1583 ( 37.0_wp * ibit26 * adv_mom_5 & 1584 + 7.0_wp * ibit25 * adv_mom_3 & 1585 + ibit24 * adv_mom_1 & 1586 ) * & 1587 ( v(k+1,j,i) + v(k,j,i) ) & 1588 - ( 8.0_wp * ibit26 * adv_mom_5 & 1589 + ibit25 * adv_mom_3 & 1590 ) * & 1591 ( v(k_pp,j,i) + v(k-1,j,i) ) & 1592 + ( ibit26 * adv_mom_5 & 1593 ) * & 1594 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & 1589 1595 ) 1590 1596 1591 diss_t(k) = - ABS( w_comp ) * ( &1592 ( 10.0 * ibit26 * adv_mom_5&1593 + 3.0 * ibit25 * adv_mom_3&1594 + ibit24 * adv_mom_1&1595 ) * &1596 ( v(k+1,j,i) - v(k,j,i) )&1597 - ( 5.0 * ibit26 * adv_mom_5&1598 + ibit25 * adv_mom_3&1599 ) * &1600 ( v(k_pp,j,i) - v(k-1,j,i) )&1601 + ( ibit26 * adv_mom_5&1602 ) * &1603 ( v(k_ppp,j,i) - v(k_mm,j,i) )&1597 diss_t(k) = - ABS( w_comp ) * ( & 1598 ( 10.0_wp * ibit26 * adv_mom_5 & 1599 + 3.0_wp * ibit25 * adv_mom_3 & 1600 + ibit24 * adv_mom_1 & 1601 ) * & 1602 ( v(k+1,j,i) - v(k,j,i) ) & 1603 - ( 5.0_wp * ibit26 * adv_mom_5 & 1604 + ibit25 * adv_mom_3 & 1605 ) * & 1606 ( v(k_pp,j,i) - v(k-1,j,i) ) & 1607 + ( ibit26 * adv_mom_5 & 1608 ) * & 1609 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & 1604 1610 ) 1605 1611 ! … … 1607 1613 !-- correction is needed to overcome numerical instabilities introduced 1608 1614 !-- by a not sufficient reduction of divergences near topography. 1609 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx &1610 + ( v_comp(k) - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy &1611 + ( w_comp - ( w(k-1,j-1,i) + w(k-1,j,i) ) ) * ddzw(k) &1612 ) * 0.5 1615 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx & 1616 + ( v_comp(k) - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy & 1617 + ( w_comp - ( w(k-1,j-1,i) + w(k-1,j,i) ) ) * ddzw(k) & 1618 ) * 0.5_wp 1613 1619 1614 1620 tend(k,j,i) = tend(k,j,i) - ( & … … 1633 1639 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 1634 1640 + ( flux_n(k) & 1635 * ( v_comp(k) - 2.0 * hom(k,1,2,0) )&1636 / ( v_comp(k) - gv + 1.0E-20_wp )&1641 * ( v_comp(k) - 2.0_wp * hom(k,1,2,0) ) & 1642 / ( v_comp(k) - gv + 1.0E-20_wp ) & 1637 1643 + diss_n(k) & 1638 * ABS( v_comp(k) - 2.0 * hom(k,1,2,0) )&1644 * ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) ) & 1639 1645 / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) ) & 1640 1646 * weight_substep(intermediate_timestep_count) … … 1650 1656 1651 1657 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 1652 flux_r(k) = u_comp * ( &1653 37.0 * ( v(k,j,i+1) + v(k,j,i) ) &1654 - 8.0 * ( v(k,j,i+2) + v(k,j,i-1) ) &1655 + ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_51656 1657 diss_r(k) = - ABS( u_comp ) * ( &1658 10.0 * ( v(k,j,i+1) - v(k,j,i) ) &1659 - 5.0 * ( v(k,j,i+2) - v(k,j,i-1) ) &1660 + ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_51658 flux_r(k) = u_comp * ( & 1659 37.0_wp * ( v(k,j,i+1) + v(k,j,i) ) & 1660 - 8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) ) & 1661 + ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5 1662 1663 diss_r(k) = - ABS( u_comp ) * ( & 1664 10.0_wp * ( v(k,j,i+1) - v(k,j,i) ) & 1665 - 5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) ) & 1666 + ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5 1661 1667 1662 1668 1663 1669 v_comp(k) = v(k,j+1,i) + v(k,j,i) 1664 flux_n(k) = ( v_comp(k) - gv ) * ( &1665 37.0 * ( v(k,j+1,i) + v(k,j,i) ) &1666 - 8.0 * ( v(k,j+2,i) + v(k,j-1,i) ) &1667 + ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_51668 1669 diss_n(k) = - ABS( v_comp(k) - gv ) * ( &1670 10.0 * ( v(k,j+1,i) - v(k,j,i) ) &1671 - 5.0 * ( v(k,j+2,i) - v(k,j-1,i) ) &1672 + ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_51670 flux_n(k) = ( v_comp(k) - gv ) * ( & 1671 37.0_wp * ( v(k,j+1,i) + v(k,j,i) ) & 1672 - 8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) ) & 1673 + ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5 1674 1675 diss_n(k) = - ABS( v_comp(k) - gv ) * ( & 1676 10.0_wp * ( v(k,j+1,i) - v(k,j,i) ) & 1677 - 5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) ) & 1678 + ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5 1673 1679 ! 1674 1680 !-- k index has to be modified near bottom and top, else array … … 1683 1689 1684 1690 w_comp = w(k,j-1,i) + w(k,j,i) 1685 flux_t(k) = w_comp * ( &1686 ( 37.0 * ibit26 * adv_mom_5&1687 + 7.0 * ibit25 * adv_mom_3&1688 + ibit24 * adv_mom_1&1689 ) * &1690 ( v(k+1,j,i) + v(k,j,i) )&1691 - ( 8.0 * ibit26 * adv_mom_5&1692 + ibit25 * adv_mom_3&1693 ) * &1694 ( v(k_pp,j,i) + v(k-1,j,i) )&1695 + ( ibit26 * adv_mom_5&1696 ) * &1697 ( v(k_ppp,j,i) + v(k_mm,j,i) )&1691 flux_t(k) = w_comp * ( & 1692 ( 37.0_wp * ibit26 * adv_mom_5 & 1693 + 7.0_wp * ibit25 * adv_mom_3 & 1694 + ibit24 * adv_mom_1 & 1695 ) * & 1696 ( v(k+1,j,i) + v(k,j,i) ) & 1697 - ( 8.0_wp * ibit26 * adv_mom_5 & 1698 + ibit25 * adv_mom_3 & 1699 ) * & 1700 ( v(k_pp,j,i) + v(k-1,j,i) ) & 1701 + ( ibit26 * adv_mom_5 & 1702 ) * & 1703 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & 1698 1704 ) 1699 1705 1700 diss_t(k) = - ABS( w_comp ) * ( &1701 ( 10.0 * ibit26 * adv_mom_5&1702 + 3.0 * ibit25 * adv_mom_3&1703 + ibit24 * adv_mom_1&1704 ) * &1705 ( v(k+1,j,i) - v(k,j,i) )&1706 - ( 5.0 * ibit26 * adv_mom_5&1707 + ibit25 * adv_mom_3&1708 ) * &1709 ( v(k_pp,j,i) - v(k-1,j,i) )&1710 + ( ibit26 * adv_mom_5&1711 ) * &1712 ( v(k_ppp,j,i) - v(k_mm,j,i) )&1706 diss_t(k) = - ABS( w_comp ) * ( & 1707 ( 10.0_wp * ibit26 * adv_mom_5 & 1708 + 3.0_wp * ibit25 * adv_mom_3 & 1709 + ibit24 * adv_mom_1 & 1710 ) * & 1711 ( v(k+1,j,i) - v(k,j,i) ) & 1712 - ( 5.0_wp * ibit26 * adv_mom_5 & 1713 + ibit25 * adv_mom_3 & 1714 ) * & 1715 ( v(k_pp,j,i) - v(k-1,j,i) ) & 1716 + ( ibit26 * adv_mom_5 & 1717 ) * & 1718 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & 1713 1719 ) 1714 1720 ! … … 1716 1722 !-- correction is needed to overcome numerical instabilities introduced 1717 1723 !-- by a not sufficient reduction of divergences near topography. 1718 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx &1719 + ( v_comp(k) - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy &1720 + ( w_comp - ( w(k-1,j-1,i) + w(k-1,j,i) ) ) * ddzw(k) &1721 ) * 0.5 1724 div = ( ( u_comp + gu - ( u(k,j-1,i) + u(k,j,i) ) ) * ddx & 1725 + ( v_comp(k) - ( v(k,j,i) + v(k,j-1,i) ) ) * ddy & 1726 + ( w_comp - ( w(k-1,j-1,i) + w(k-1,j,i) ) ) * ddzw(k) & 1727 ) * 0.5_wp 1722 1728 1723 1729 tend(k,j,i) = tend(k,j,i) - ( & … … 1742 1748 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 1743 1749 + ( flux_n(k) & 1744 * ( v_comp(k) - 2.0 * hom(k,1,2,0) )&1745 / ( v_comp(k) - gv + 1.0E-20_wp )&1750 * ( v_comp(k) - 2.0_wp * hom(k,1,2,0) ) & 1751 / ( v_comp(k) - gv + 1.0E-20_wp ) & 1746 1752 + diss_n(k) & 1747 * ABS( v_comp(k) - 2.0 * hom(k,1,2,0) )&1753 * ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) ) & 1748 1754 / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) ) & 1749 1755 * weight_substep(intermediate_timestep_count) 1750 1756 ! 1751 1757 !-- Statistical Evaluation of w'v'. 1752 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) 1753 + ( flux_t(k) + diss_t(k) ) 1758 sums_wsvs_ws_l(k,tn) = sums_wsvs_ws_l(k,tn) & 1759 + ( flux_t(k) + diss_t(k) ) & 1754 1760 * weight_substep(intermediate_timestep_count) 1755 1761 … … 1767 1773 SUBROUTINE advec_w_ws_ij( i, j, i_omp, tn ) 1768 1774 1769 USE arrays_3d, 1775 USE arrays_3d, & 1770 1776 ONLY: ddzu, diss_l_w, diss_s_w, flux_l_w, flux_s_w, tend, u, v, w 1771 1777 1772 USE constants, 1778 USE constants, & 1773 1779 ONLY: adv_mom_1, adv_mom_3, adv_mom_5 1774 1780 1775 USE control_parameters, 1781 USE control_parameters, & 1776 1782 ONLY: intermediate_timestep_count, u_gtrans, v_gtrans 1777 1783 1778 USE grid_variables, 1784 USE grid_variables, & 1779 1785 ONLY: ddx, ddy 1780 1786 1781 USE indices, 1782 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0, 1787 USE indices, & 1788 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0, & 1783 1789 wall_flags_00 1784 1790 1785 1791 USE kinds 1786 1792 1787 USE statistics, 1793 USE statistics, & 1788 1794 ONLY: hom, sums_ws2_ws_l, weight_substep 1789 1795 … … 1824 1830 REAL(wp), DIMENSION(nzb:nzt+1) :: flux_t !: 1825 1831 1826 gu = 2.0 * u_gtrans1827 gv = 2.0 * v_gtrans1832 gu = 2.0_wp * u_gtrans 1833 gv = 2.0_wp * v_gtrans 1828 1834 1829 1835 ! … … 1838 1844 v_comp = v(k+1,j,i) + v(k,j,i) - gv 1839 1845 flux_s_w(k,tn) = v_comp * ( & 1840 ( 37.0 * ibit32 * adv_mom_5&1841 + 7.0 * ibit31 * adv_mom_3&1842 + ibit30 * adv_mom_1&1846 ( 37.0_wp * ibit32 * adv_mom_5 & 1847 + 7.0_wp * ibit31 * adv_mom_3 & 1848 + ibit30 * adv_mom_1 & 1843 1849 ) * & 1844 ( w(k,j,i) + w(k,j-1,i) )&1845 - ( 8.0 * ibit32 * adv_mom_5&1846 + ibit31 * adv_mom_3&1850 ( w(k,j,i) + w(k,j-1,i) ) & 1851 - ( 8.0_wp * ibit32 * adv_mom_5 & 1852 + ibit31 * adv_mom_3 & 1847 1853 ) * & 1848 ( w(k,j+1,i) + w(k,j-2,i) )&1849 + ( ibit32 * adv_mom_5&1854 ( w(k,j+1,i) + w(k,j-2,i) ) & 1855 + ( ibit32 * adv_mom_5 & 1850 1856 ) * & 1851 ( w(k,j+2,i) + w(k,j-3,i) )&1852 1857 ( w(k,j+2,i) + w(k,j-3,i) ) & 1858 ) 1853 1859 1854 1860 diss_s_w(k,tn) = - ABS( v_comp ) * ( & 1855 ( 10.0 * ibit32 * adv_mom_5&1856 + 3.0 * ibit31 * adv_mom_3&1857 + ibit30 * adv_mom_1&1861 ( 10.0_wp * ibit32 * adv_mom_5 & 1862 + 3.0_wp * ibit31 * adv_mom_3 & 1863 + ibit30 * adv_mom_1 & 1858 1864 ) * & 1859 ( w(k,j,i) - w(k,j-1,i) )&1860 - ( 5.0 * ibit32 * adv_mom_5&1861 + ibit31 * adv_mom_3&1865 ( w(k,j,i) - w(k,j-1,i) ) & 1866 - ( 5.0_wp * ibit32 * adv_mom_5 & 1867 + ibit31 * adv_mom_3 & 1862 1868 ) * & 1863 ( w(k,j+1,i) - w(k,j-2,i) )&1864 + ( ibit32 * adv_mom_5&1869 ( w(k,j+1,i) - w(k,j-2,i) ) & 1870 + ( ibit32 * adv_mom_5 & 1865 1871 ) * & 1866 ( w(k,j+2,i) - w(k,j-3,i) )&1867 1872 ( w(k,j+2,i) - w(k,j-3,i) ) & 1873 ) 1868 1874 1869 1875 ENDDO … … 1873 1879 v_comp = v(k+1,j,i) + v(k,j,i) - gv 1874 1880 flux_s_w(k,tn) = v_comp * ( & 1875 37.0 * ( w(k,j,i) + w(k,j-1,i) )&1876 - 8.0 * ( w(k,j+1,i) +w(k,j-2,i) )&1877 + ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_51881 37.0_wp * ( w(k,j,i) + w(k,j-1,i) ) & 1882 - 8.0_wp * ( w(k,j+1,i) +w(k,j-2,i) ) & 1883 + ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5 1878 1884 diss_s_w(k,tn) = - ABS( v_comp ) * ( & 1879 10.0 * ( w(k,j,i) - w(k,j-1,i) )&1880 - 5.0 * ( w(k,j+1,i) - w(k,j-2,i) )&1881 + ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_51885 10.0_wp * ( w(k,j,i) - w(k,j-1,i) ) & 1886 - 5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) ) & 1887 + ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5 1882 1888 1883 1889 ENDDO … … 1895 1901 1896 1902 u_comp = u(k+1,j,i) + u(k,j,i) - gu 1897 flux_l_w(k,j,tn) = u_comp * ( 1898 ( 37.0 * ibit29 * adv_mom_5&1899 + 7.0 * ibit28 * adv_mom_3&1900 + ibit27 * adv_mom_1&1901 ) * 1902 ( w(k,j,i) + w(k,j,i-1) )&1903 - ( 8.0 * ibit29 * adv_mom_5&1904 + ibit28 * adv_mom_3&1905 ) * 1906 ( w(k,j,i+1) + w(k,j,i-2) )&1907 + ( ibit29 * adv_mom_5&1908 ) * 1909 ( w(k,j,i+2) + w(k,j,i-3) )&1903 flux_l_w(k,j,tn) = u_comp * ( & 1904 ( 37.0_wp * ibit29 * adv_mom_5 & 1905 + 7.0_wp * ibit28 * adv_mom_3 & 1906 + ibit27 * adv_mom_1 & 1907 ) * & 1908 ( w(k,j,i) + w(k,j,i-1) ) & 1909 - ( 8.0_wp * ibit29 * adv_mom_5 & 1910 + ibit28 * adv_mom_3 & 1911 ) * & 1912 ( w(k,j,i+1) + w(k,j,i-2) ) & 1913 + ( ibit29 * adv_mom_5 & 1914 ) * & 1915 ( w(k,j,i+2) + w(k,j,i-3) ) & 1910 1916 ) 1911 1917 1912 diss_l_w(k,j,tn) = - ABS( u_comp ) * ( 1913 ( 10.0 * ibit29 * adv_mom_5&1914 + 3.0 * ibit28 * adv_mom_3&1915 + ibit27 * adv_mom_1&1916 ) * 1917 ( w(k,j,i) - w(k,j,i-1) )&1918 - ( 5.0 * ibit29 * adv_mom_5&1919 + ibit28 * adv_mom_3&1920 ) * 1921 ( w(k,j,i+1) - w(k,j,i-2) )&1922 + ( ibit29 * adv_mom_5&1923 ) * 1924 ( w(k,j,i+2) - w(k,j,i-3) )&1918 diss_l_w(k,j,tn) = - ABS( u_comp ) * ( & 1919 ( 10.0_wp * ibit29 * adv_mom_5 & 1920 + 3.0_wp * ibit28 * adv_mom_3 & 1921 + ibit27 * adv_mom_1 & 1922 ) * & 1923 ( w(k,j,i) - w(k,j,i-1) ) & 1924 - ( 5.0_wp * ibit29 * adv_mom_5 & 1925 + ibit28 * adv_mom_3 & 1926 ) * & 1927 ( w(k,j,i+1) - w(k,j,i-2) ) & 1928 + ( ibit29 * adv_mom_5 & 1929 ) * & 1930 ( w(k,j,i+2) - w(k,j,i-3) ) & 1925 1931 ) 1926 1932 … … 1931 1937 u_comp = u(k+1,j,i) + u(k,j,i) - gu 1932 1938 flux_l_w(k,j,tn) = u_comp * ( & 1933 37.0 * ( w(k,j,i) + w(k,j,i-1) )&1934 - 8.0 * ( w(k,j,i+1) + w(k,j,i-2) )&1935 + ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_51939 37.0_wp * ( w(k,j,i) + w(k,j,i-1) ) & 1940 - 8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) ) & 1941 + ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5 1936 1942 diss_l_w(k,j,tn) = - ABS( u_comp ) * ( & 1937 10.0 * ( w(k,j,i) - w(k,j,i-1) )&1938 - 5.0 * ( w(k,j,i+1) - w(k,j,i-2) )&1939 + ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_51943 10.0_wp * ( w(k,j,i) - w(k,j,i-1) ) & 1944 - 5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) ) & 1945 + ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5 1940 1946 1941 1947 ENDDO … … 1962 1968 1963 1969 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 1964 flux_r(k) = u_comp * ( &1965 ( 37.0 * ibit29 * adv_mom_5&1966 + 7.0 * ibit28 * adv_mom_3&1967 + ibit27 * adv_mom_1&1968 ) * &1969 ( w(k,j,i+1) + w(k,j,i) )&1970 - ( 8.0 * ibit29 * adv_mom_5&1971 + ibit28 * adv_mom_3&1972 ) * &1973 ( w(k,j,i+2) + w(k,j,i-1) )&1974 + ( ibit29 * adv_mom_5&1975 ) * &1976 ( w(k,j,i+3) + w(k,j,i-2) )&1977 1978 1979 diss_r(k) = - ABS( u_comp ) * ( &1980 ( 10.0 * ibit29 * adv_mom_5&1981 + 3.0 * ibit28 * adv_mom_3&1982 + ibit27 * adv_mom_1&1983 ) * &1984 ( w(k,j,i+1) - w(k,j,i) )&1985 - ( 5.0 * ibit29 * adv_mom_5&1986 + ibit28 * adv_mom_3&1987 ) * &1988 ( w(k,j,i+2) - w(k,j,i-1) )&1989 + ( ibit29 * adv_mom_5&1990 ) * &1991 ( w(k,j,i+3) - w(k,j,i-2) )&1970 flux_r(k) = u_comp * ( & 1971 ( 37.0_wp * ibit29 * adv_mom_5 & 1972 + 7.0_wp * ibit28 * adv_mom_3 & 1973 + ibit27 * adv_mom_1 & 1974 ) * & 1975 ( w(k,j,i+1) + w(k,j,i) ) & 1976 - ( 8.0_wp * ibit29 * adv_mom_5 & 1977 + ibit28 * adv_mom_3 & 1978 ) * & 1979 ( w(k,j,i+2) + w(k,j,i-1) ) & 1980 + ( ibit29 * adv_mom_5 & 1981 ) * & 1982 ( w(k,j,i+3) + w(k,j,i-2) ) & 1983 ) 1984 1985 diss_r(k) = - ABS( u_comp ) * ( & 1986 ( 10.0_wp * ibit29 * adv_mom_5 & 1987 + 3.0_wp * ibit28 * adv_mom_3 & 1988 + ibit27 * adv_mom_1 & 1989 ) * & 1990 ( w(k,j,i+1) - w(k,j,i) ) & 1991 - ( 5.0_wp * ibit29 * adv_mom_5 & 1992 + ibit28 * adv_mom_3 & 1993 ) * & 1994 ( w(k,j,i+2) - w(k,j,i-1) ) & 1995 + ( ibit29 * adv_mom_5 & 1996 ) * & 1997 ( w(k,j,i+3) - w(k,j,i-2) ) & 1992 1998 ) 1993 1999 … … 1997 2003 1998 2004 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 1999 flux_n(k) = v_comp * ( &2000 ( 37.0 * ibit32 * adv_mom_5&2001 + 7.0 * ibit31 * adv_mom_3&2002 + ibit30 * adv_mom_1&2003 ) * &2004 ( w(k,j+1,i) + w(k,j,i) )&2005 - ( 8.0 * ibit32 * adv_mom_5&2006 + ibit31 * adv_mom_3&2007 ) * &2008 ( w(k,j+2,i) + w(k,j-1,i) )&2009 + ( ibit32 * adv_mom_5&2010 ) * &2011 ( w(k,j+3,i) + w(k,j-2,i) )&2005 flux_n(k) = v_comp * ( & 2006 ( 37.0_wp * ibit32 * adv_mom_5 & 2007 + 7.0_wp * ibit31 * adv_mom_3 & 2008 + ibit30 * adv_mom_1 & 2009 ) * & 2010 ( w(k,j+1,i) + w(k,j,i) ) & 2011 - ( 8.0_wp * ibit32 * adv_mom_5 & 2012 + ibit31 * adv_mom_3 & 2013 ) * & 2014 ( w(k,j+2,i) + w(k,j-1,i) ) & 2015 + ( ibit32 * adv_mom_5 & 2016 ) * & 2017 ( w(k,j+3,i) + w(k,j-2,i) ) & 2012 2018 ) 2013 2019 2014 diss_n(k) = - ABS( v_comp ) * ( &2015 ( 10.0 * ibit32 * adv_mom_5&2016 + 3.0 * ibit31 * adv_mom_3&2017 + ibit30 * adv_mom_1&2018 ) * &2019 ( w(k,j+1,i) - w(k,j,i) )&2020 - ( 5.0 * ibit32 * adv_mom_5&2021 + ibit31 * adv_mom_3&2022 ) * &2023 ( w(k,j+2,i) - w(k,j-1,i) )&2024 + ( ibit32 * adv_mom_5&2025 ) * &2026 ( w(k,j+3,i) - w(k,j-2,i) )&2020 diss_n(k) = - ABS( v_comp ) * ( & 2021 ( 10.0_wp * ibit32 * adv_mom_5 & 2022 + 3.0_wp * ibit31 * adv_mom_3 & 2023 + ibit30 * adv_mom_1 & 2024 ) * & 2025 ( w(k,j+1,i) - w(k,j,i) ) & 2026 - ( 5.0_wp * ibit32 * adv_mom_5 & 2027 + ibit31 * adv_mom_3 & 2028 ) * & 2029 ( w(k,j+2,i) - w(k,j-1,i) ) & 2030 + ( ibit32 * adv_mom_5 & 2031 ) * & 2032 ( w(k,j+3,i) - w(k,j-2,i) ) & 2027 2033 ) 2028 2034 ! … … 2038 2044 2039 2045 w_comp = w(k+1,j,i) + w(k,j,i) 2040 flux_t(k) = w_comp * ( &2041 ( 37.0 * ibit35 * adv_mom_5&2042 + 7.0 * ibit34 * adv_mom_3&2043 + ibit33 * adv_mom_1&2044 ) * &2045 ( w(k+1,j,i) + w(k,j,i) )&2046 - ( 8.0 * ibit35 * adv_mom_5&2047 + ibit34 * adv_mom_3&2048 ) * &2049 ( w(k_pp,j,i) + w(k-1,j,i) )&2050 + ( ibit35 * adv_mom_5&2051 ) * &2052 ( w(k_ppp,j,i) + w(k_mm,j,i) )&2053 2054 2055 diss_t(k) = - ABS( w_comp ) * ( &2056 ( 10.0 * ibit35 * adv_mom_5&2057 + 3.0 * ibit34 * adv_mom_3&2058 + ibit33 * adv_mom_1&2059 ) * &2060 ( w(k+1,j,i) - w(k,j,i) )&2061 - ( 5.0 * ibit35 * adv_mom_5&2062 + ibit34 * adv_mom_3&2063 ) * &2064 ( w(k_pp,j,i) - w(k-1,j,i) )&2065 + ( ibit35 * adv_mom_5&2066 ) * &2067 ( w(k_ppp,j,i) - w(k_mm,j,i) )&2068 2046 flux_t(k) = w_comp * ( & 2047 ( 37.0_wp * ibit35 * adv_mom_5 & 2048 + 7.0_wp * ibit34 * adv_mom_3 & 2049 + ibit33 * adv_mom_1 & 2050 ) * & 2051 ( w(k+1,j,i) + w(k,j,i) ) & 2052 - ( 8.0_wp * ibit35 * adv_mom_5 & 2053 + ibit34 * adv_mom_3 & 2054 ) * & 2055 ( w(k_pp,j,i) + w(k-1,j,i) ) & 2056 + ( ibit35 * adv_mom_5 & 2057 ) * & 2058 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & 2059 ) 2060 2061 diss_t(k) = - ABS( w_comp ) * ( & 2062 ( 10.0_wp * ibit35 * adv_mom_5 & 2063 + 3.0_wp * ibit34 * adv_mom_3 & 2064 + ibit33 * adv_mom_1 & 2065 ) * & 2066 ( w(k+1,j,i) - w(k,j,i) ) & 2067 - ( 5.0_wp * ibit35 * adv_mom_5 & 2068 + ibit34 * adv_mom_3 & 2069 ) * & 2070 ( w(k_pp,j,i) - w(k-1,j,i) ) & 2071 + ( ibit35 * adv_mom_5 & 2072 ) * & 2073 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & 2074 ) 2069 2075 2070 2076 ! … … 2075 2081 + ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i) ) ) * ddy & 2076 2082 + ( w_comp - ( w(k,j,i) + w(k-1,j,i) ) ) * ddzu(k+1) & 2077 ) * 0.5 2083 ) * 0.5_wp 2078 2084 2079 2085 tend(k,j,i) = tend(k,j,i) - ( & … … 2094 2100 ! 2095 2101 !-- Statistical Evaluation of w'w'. 2096 sums_ws2_ws_l(k,tn) = sums_ws2_ws_l(k,tn) &2097 + ( flux_t(k) + diss_t(k) ) &2102 sums_ws2_ws_l(k,tn) = sums_ws2_ws_l(k,tn) & 2103 + ( flux_t(k) + diss_t(k) ) & 2098 2104 * weight_substep(intermediate_timestep_count) 2099 2105 … … 2103 2109 2104 2110 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 2105 flux_r(k) = u_comp * ( &2106 37.0 * ( w(k,j,i+1) + w(k,j,i) )&2107 - 8.0 * ( w(k,j,i+2) + w(k,j,i-1) )&2108 + ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_52109 2110 diss_r(k) = - ABS( u_comp ) * ( &2111 10.0 * ( w(k,j,i+1) - w(k,j,i) )&2112 - 5.0 * ( w(k,j,i+2) - w(k,j,i-1) )&2113 + ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_52111 flux_r(k) = u_comp * ( & 2112 37.0_wp * ( w(k,j,i+1) + w(k,j,i) ) & 2113 - 8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) ) & 2114 + ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5 2115 2116 diss_r(k) = - ABS( u_comp ) * ( & 2117 10.0_wp * ( w(k,j,i+1) - w(k,j,i) ) & 2118 - 5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) ) & 2119 + ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5 2114 2120 2115 2121 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 2116 flux_n(k) = v_comp * ( &2117 37.0 * ( w(k,j+1,i) + w(k,j,i) )&2118 - 8.0 * ( w(k,j+2,i) + w(k,j-1,i) )&2119 + ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_52120 2121 diss_n(k) = - ABS( v_comp ) * ( &2122 10.0 * ( w(k,j+1,i) - w(k,j,i) )&2123 - 5.0 * ( w(k,j+2,i) - w(k,j-1,i) )&2124 + ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_52122 flux_n(k) = v_comp * ( & 2123 37.0_wp * ( w(k,j+1,i) + w(k,j,i) ) & 2124 - 8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) ) & 2125 + ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5 2126 2127 diss_n(k) = - ABS( v_comp ) * ( & 2128 10.0_wp * ( w(k,j+1,i) - w(k,j,i) ) & 2129 - 5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) ) & 2130 + ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5 2125 2131 ! 2126 2132 !-- k index has to be modified near bottom and top, else array … … 2135 2141 2136 2142 w_comp = w(k+1,j,i) + w(k,j,i) 2137 flux_t(k) = w_comp * ( &2138 ( 37.0 * ibit35 * adv_mom_5&2139 + 7.0 * ibit34 * adv_mom_3&2140 + ibit33 * adv_mom_1&2141 ) * &2142 ( w(k+1,j,i) + w(k,j,i) )&2143 - ( 8.0 * ibit35 * adv_mom_5&2144 + ibit34 * adv_mom_3&2145 ) * &2146 ( w(k_pp,j,i) + w(k-1,j,i) )&2147 + ( ibit35 * adv_mom_5&2148 ) * &2149 ( w(k_ppp,j,i) + w(k_mm,j,i) )&2150 2151 2152 diss_t(k) = - ABS( w_comp ) * ( &2153 ( 10.0 * ibit35 * adv_mom_5&2154 + 3.0 * ibit34 * adv_mom_3&2155 + ibit33 * adv_mom_1&2156 ) * &2157 ( w(k+1,j,i) - w(k,j,i) )&2158 - ( 5.0 * ibit35 * adv_mom_5&2159 + ibit34 * adv_mom_3&2160 ) * &2161 ( w(k_pp,j,i) - w(k-1,j,i) )&2162 + ( ibit35 * adv_mom_5&2163 ) * &2164 ( w(k_ppp,j,i) - w(k_mm,j,i) )&2165 2143 flux_t(k) = w_comp * ( & 2144 ( 37.0_wp * ibit35 * adv_mom_5 & 2145 + 7.0_wp * ibit34 * adv_mom_3 & 2146 + ibit33 * adv_mom_1 & 2147 ) * & 2148 ( w(k+1,j,i) + w(k,j,i) ) & 2149 - ( 8.0_wp * ibit35 * adv_mom_5 & 2150 + ibit34 * adv_mom_3 & 2151 ) * & 2152 ( w(k_pp,j,i) + w(k-1,j,i) ) & 2153 + ( ibit35 * adv_mom_5 & 2154 ) * & 2155 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & 2156 ) 2157 2158 diss_t(k) = - ABS( w_comp ) * ( & 2159 ( 10.0_wp * ibit35 * adv_mom_5 & 2160 + 3.0_wp * ibit34 * adv_mom_3 & 2161 + ibit33 * adv_mom_1 & 2162 ) * & 2163 ( w(k+1,j,i) - w(k,j,i) ) & 2164 - ( 5.0_wp * ibit35 * adv_mom_5 & 2165 + ibit34 * adv_mom_3 & 2166 ) * & 2167 ( w(k_pp,j,i) - w(k-1,j,i) ) & 2168 + ( ibit35 * adv_mom_5 & 2169 ) * & 2170 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & 2171 ) 2166 2172 ! 2167 2173 !-- Calculate the divergence of the velocity field. A respective … … 2171 2177 + ( v_comp + gv - ( v(k+1,j,i) + v(k,j,i) ) ) * ddy & 2172 2178 + ( w_comp - ( w(k,j,i) + w(k-1,j,i) ) ) * ddzu(k+1) & 2173 ) * 0.5 2179 ) * 0.5_wp 2174 2180 2175 2181 tend(k,j,i) = tend(k,j,i) - ( & … … 2190 2196 ! 2191 2197 !-- Statistical Evaluation of w'w'. 2192 sums_ws2_ws_l(k,tn) = sums_ws2_ws_l(k,tn) &2193 + ( flux_t(k) + diss_t(k) ) &2198 sums_ws2_ws_l(k,tn) = sums_ws2_ws_l(k,tn) & 2199 + ( flux_t(k) + diss_t(k) ) & 2194 2200 * weight_substep(intermediate_timestep_count) 2195 2201 … … 2205 2211 SUBROUTINE advec_s_ws( sk, sk_char ) 2206 2212 2207 USE arrays_3d, 2213 USE arrays_3d, & 2208 2214 ONLY: ddzw, tend, u, v, w 2209 2215 2210 USE constants, 2216 USE constants, & 2211 2217 ONLY: adv_sca_1, adv_sca_3, adv_sca_5 2212 2218 2213 USE control_parameters, 2219 USE control_parameters, & 2214 2220 ONLY: intermediate_timestep_count, u_gtrans, v_gtrans 2215 2221 2216 USE grid_variables, 2222 USE grid_variables, & 2217 2223 ONLY: ddx, ddy 2218 2224 2219 USE indices, 2225 USE indices, & 2220 2226 ONLY: nxl, nxr, nyn, nys, nzb, nzb_max, nzt, wall_flags_0 2221 2227 2222 2228 USE kinds 2223 2229 2224 USE statistics, 2225 ONLY: sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l, 2230 USE statistics, & 2231 ONLY: sums_wspts_ws_l, sums_wsqs_ws_l, sums_wssas_ws_l, & 2226 2232 weight_substep 2227 2233 … … 2286 2292 u_comp = u(k,j,i) - u_gtrans 2287 2293 swap_flux_x_local(k,j) = u_comp * ( & 2288 ( 37.0 * ibit2 * adv_sca_5&2289 + 7.0 * ibit1 * adv_sca_3&2290 + ibit0 * adv_sca_1&2291 ) *&2292 ( sk(k,j,i) + sk(k,j,i-1) )&2293 - ( 8.0 * ibit2 * adv_sca_5&2294 + ibit1 * adv_sca_3&2295 ) *&2296 ( sk(k,j,i+1) + sk(k,j,i-2) )&2297 + ( ibit2 * adv_sca_5 &2298 ) *&2299 ( sk(k,j,i+2) + sk(k,j,i-3) )&2294 ( 37.0_wp * ibit2 * adv_sca_5 & 2295 + 7.0_wp * ibit1 * adv_sca_3 & 2296 + ibit0 * adv_sca_1 & 2297 ) * & 2298 ( sk(k,j,i) + sk(k,j,i-1) ) & 2299 - ( 8.0_wp * ibit2 * adv_sca_5 & 2300 + ibit1 * adv_sca_3 & 2301 ) * & 2302 ( sk(k,j,i+1) + sk(k,j,i-2) ) & 2303 + ( ibit2 * adv_sca_5 & 2304 ) * & 2305 ( sk(k,j,i+2) + sk(k,j,i-3) ) & 2300 2306 ) 2301 2307 2302 2308 swap_diss_x_local(k,j) = -ABS( u_comp ) * ( & 2303 ( 10.0 * ibit2 * adv_sca_5&2304 + 3.0 * ibit1 * adv_sca_3&2305 + ibit0 * adv_sca_1&2306 ) *&2307 ( sk(k,j,i) - sk(k,j,i-1) )&2308 - ( 5.0 * ibit2 * adv_sca_5&2309 + ibit1 * adv_sca_3&2310 ) *&2311 ( sk(k,j,i+1) - sk(k,j,i-2) )&2312 + ( ibit2 * adv_sca_5&2313 ) *&2314 ( sk(k,j,i+2) - sk(k,j,i-3) )&2309 ( 10.0_wp * ibit2 * adv_sca_5 & 2310 + 3.0_wp * ibit1 * adv_sca_3 & 2311 + ibit0 * adv_sca_1 & 2312 ) * & 2313 ( sk(k,j,i) - sk(k,j,i-1) ) & 2314 - ( 5.0_wp * ibit2 * adv_sca_5 & 2315 + ibit1 * adv_sca_3 & 2316 ) * & 2317 ( sk(k,j,i+1) - sk(k,j,i-2) ) & 2318 + ( ibit2 * adv_sca_5 & 2319 ) * & 2320 ( sk(k,j,i+2) - sk(k,j,i-3) ) & 2315 2321 ) 2316 2322 … … 2320 2326 2321 2327 u_comp = u(k,j,i) - u_gtrans 2322 swap_flux_x_local(k,j) = u_comp * ( &2323 37.0 * ( sk(k,j,i) + sk(k,j,i-1) )&2324 - 8.0 * ( sk(k,j,i+1) + sk(k,j,i-2) )&2325 + ( sk(k,j,i+2) + sk(k,j,i-3) )&2328 swap_flux_x_local(k,j) = u_comp * ( & 2329 37.0_wp * ( sk(k,j,i) + sk(k,j,i-1) ) & 2330 - 8.0_wp * ( sk(k,j,i+1) + sk(k,j,i-2) ) & 2331 + ( sk(k,j,i+2) + sk(k,j,i-3) ) & 2326 2332 ) * adv_sca_5 2327 2333 2328 swap_diss_x_local(k,j) = -ABS( u_comp ) * ( &2329 10.0 * ( sk(k,j,i) - sk(k,j,i-1) )&2330 - 5.0 * ( sk(k,j,i+1) - sk(k,j,i-2) )&2331 + ( sk(k,j,i+2) - sk(k,j,i-3) )&2334 swap_diss_x_local(k,j) = -ABS( u_comp ) * ( & 2335 10.0_wp * ( sk(k,j,i) - sk(k,j,i-1) ) & 2336 - 5.0_wp * ( sk(k,j,i+1) - sk(k,j,i-2) ) & 2337 + ( sk(k,j,i+2) - sk(k,j,i-3) ) & 2332 2338 ) * adv_sca_5 2333 2339 … … 2347 2353 v_comp = v(k,j,i) - v_gtrans 2348 2354 swap_flux_y_local(k) = v_comp * ( & 2349 ( 37.0 * ibit5 * adv_sca_5&2350 + 7.0 * ibit4 * adv_sca_3&2351 + ibit3 * adv_sca_1&2352 ) *&2353 ( sk(k,j,i) + sk(k,j-1,i) )&2354 - ( 8.0 * ibit5 * adv_sca_5&2355 + ibit4 * adv_sca_3&2356 ) *&2357 ( sk(k,j+1,i) + sk(k,j-2,i) )&2358 + ( ibit5 * adv_sca_5&2359 ) *&2360 ( sk(k,j+2,i) + sk(k,j-3,i) )&2355 ( 37.0_wp * ibit5 * adv_sca_5 & 2356 + 7.0_wp * ibit4 * adv_sca_3 & 2357 + ibit3 * adv_sca_1 & 2358 ) * & 2359 ( sk(k,j,i) + sk(k,j-1,i) ) & 2360 - ( 8.0_wp * ibit5 * adv_sca_5 & 2361 + ibit4 * adv_sca_3 & 2362 ) * & 2363 ( sk(k,j+1,i) + sk(k,j-2,i) ) & 2364 + ( ibit5 * adv_sca_5 & 2365 ) * & 2366 ( sk(k,j+2,i) + sk(k,j-3,i) ) & 2361 2367 ) 2362 2368 2363 2369 swap_diss_y_local(k) = -ABS( v_comp ) * ( & 2364 ( 10.0 * ibit5 * adv_sca_5&2365 + 3.0 * ibit4 * adv_sca_3&2366 + ibit3 * adv_sca_1&2367 ) *&2368 ( sk(k,j,i) - sk(k,j-1,i) )&2369 - ( 5.0 * ibit5 * adv_sca_5&2370 + ibit4 * adv_sca_3&2371 ) *&2372 ( sk(k,j+1,i) - sk(k,j-2,i)) &2373 + ( ibit5 * adv_sca_5&2374 ) *&2375 ( sk(k,j+2,i) - sk(k,j-3,i) )&2370 ( 10.0_wp * ibit5 * adv_sca_5 & 2371 + 3.0_wp * ibit4 * adv_sca_3 & 2372 + ibit3 * adv_sca_1 & 2373 ) * & 2374 ( sk(k,j,i) - sk(k,j-1,i) ) & 2375 - ( 5.0_wp * ibit5 * adv_sca_5 & 2376 + ibit4 * adv_sca_3 & 2377 ) * & 2378 ( sk(k,j+1,i) - sk(k,j-2,i) ) & 2379 + ( ibit5 * adv_sca_5 & 2380 ) * & 2381 ( sk(k,j+2,i) - sk(k,j-3,i) ) & 2376 2382 ) 2377 2383 … … 2383 2389 v_comp = v(k,j,i) - v_gtrans 2384 2390 swap_flux_y_local(k) = v_comp * ( & 2385 37.0 * ( sk(k,j,i) + sk(k,j-1,i) )&2386 - 8.0 * ( sk(k,j+1,i) + sk(k,j-2,i) )&2387 + ( sk(k,j+2,i) + sk(k,j-3,i) )&2391 37.0_wp * ( sk(k,j,i) + sk(k,j-1,i) ) & 2392 - 8.0_wp * ( sk(k,j+1,i) + sk(k,j-2,i) ) & 2393 + ( sk(k,j+2,i) + sk(k,j-3,i) ) & 2388 2394 ) * adv_sca_5 2389 2395 swap_diss_y_local(k) = -ABS( v_comp ) * ( & 2390 10.0 * ( sk(k,j,i) - sk(k,j-1,i) )&2391 - 5.0 * ( sk(k,j+1,i) - sk(k,j-2,i) )&2392 + sk(k,j+2,i) - sk(k,j-3,i)&2396 10.0_wp * ( sk(k,j,i) - sk(k,j-1,i) ) & 2397 - 5.0_wp * ( sk(k,j+1,i) - sk(k,j-2,i) ) & 2398 + sk(k,j+2,i) - sk(k,j-3,i) & 2393 2399 ) * adv_sca_5 2394 2400 … … 2397 2403 DO j = nys, nyn 2398 2404 2399 flux_t(0) = 0.0 2400 diss_t(0) = 0.0 2401 flux_d = 0.0 2402 diss_d = 0.0 2405 flux_t(0) = 0.0_wp 2406 diss_t(0) = 0.0_wp 2407 flux_d = 0.0_wp 2408 diss_d = 0.0_wp 2403 2409 2404 2410 DO k = nzb+1, nzb_max … … 2409 2415 2410 2416 u_comp = u(k,j,i+1) - u_gtrans 2411 flux_r(k) = u_comp * ( &2412 ( 37.0 * ibit2 * adv_sca_5&2413 + 7.0 * ibit1 * adv_sca_3&2414 + ibit0 * adv_sca_1&2415 ) * &2416 ( sk(k,j,i+1) + sk(k,j,i) ) &2417 - ( 8.0 * ibit2 * adv_sca_5&2418 + ibit1 * adv_sca_3&2419 ) * &2420 ( sk(k,j,i+2) + sk(k,j,i-1) ) &2421 + ( ibit2 * adv_sca_5&2422 ) * &2423 ( sk(k,j,i+3) + sk(k,j,i-2) ) &2417 flux_r(k) = u_comp * ( & 2418 ( 37.0_wp * ibit2 * adv_sca_5 & 2419 + 7.0_wp * ibit1 * adv_sca_3 & 2420 + ibit0 * adv_sca_1 & 2421 ) * & 2422 ( sk(k,j,i+1) + sk(k,j,i) ) & 2423 - ( 8.0_wp * ibit2 * adv_sca_5 & 2424 + ibit1 * adv_sca_3 & 2425 ) * & 2426 ( sk(k,j,i+2) + sk(k,j,i-1) ) & 2427 + ( ibit2 * adv_sca_5 & 2428 ) * & 2429 ( sk(k,j,i+3) + sk(k,j,i-2) ) & 2424 2430 ) 2425 2431 2426 diss_r(k) = -ABS( u_comp ) * ( &2427 ( 10.0 * ibit2 * adv_sca_5&2428 + 3.0 * ibit1 * adv_sca_3&2429 + ibit0 * adv_sca_1&2430 ) * &2431 ( sk(k,j,i+1) - sk(k,j,i) )&2432 - ( 5.0 * ibit2 * adv_sca_5&2433 + ibit1 * adv_sca_3&2434 ) * &2435 ( sk(k,j,i+2) - sk(k,j,i-1) ) &2436 + ( ibit2 * adv_sca_5&2437 ) * &2438 ( sk(k,j,i+3) - sk(k,j,i-2) ) &2432 diss_r(k) = -ABS( u_comp ) * ( & 2433 ( 10.0_wp * ibit2 * adv_sca_5 & 2434 + 3.0_wp * ibit1 * adv_sca_3 & 2435 + ibit0 * adv_sca_1 & 2436 ) * & 2437 ( sk(k,j,i+1) - sk(k,j,i) ) & 2438 - ( 5.0_wp * ibit2 * adv_sca_5 & 2439 + ibit1 * adv_sca_3 & 2440 ) * & 2441 ( sk(k,j,i+2) - sk(k,j,i-1) ) & 2442 + ( ibit2 * adv_sca_5 & 2443 ) * & 2444 ( sk(k,j,i+3) - sk(k,j,i-2) ) & 2439 2445 ) 2440 2446 … … 2444 2450 2445 2451 v_comp = v(k,j+1,i) - v_gtrans 2446 flux_n(k) = v_comp * ( &2447 ( 37.0 * ibit5 * adv_sca_5&2448 + 7.0 * ibit4 * adv_sca_3&2449 + ibit3 * adv_sca_1&2450 ) * &2451 ( sk(k,j+1,i) + sk(k,j,i) ) &2452 - ( 8.0 * ibit5 * adv_sca_5&2453 + ibit4 * adv_sca_3&2454 ) * &2455 ( sk(k,j+2,i) + sk(k,j-1,i) ) &2456 + ( ibit5 * adv_sca_5&2457 ) * &2458 ( sk(k,j+3,i) + sk(k,j-2,i) ) &2452 flux_n(k) = v_comp * ( & 2453 ( 37.0_wp * ibit5 * adv_sca_5 & 2454 + 7.0_wp * ibit4 * adv_sca_3 & 2455 + ibit3 * adv_sca_1 & 2456 ) * & 2457 ( sk(k,j+1,i) + sk(k,j,i) ) & 2458 - ( 8.0_wp * ibit5 * adv_sca_5 & 2459 + ibit4 * adv_sca_3 & 2460 ) * & 2461 ( sk(k,j+2,i) + sk(k,j-1,i) ) & 2462 + ( ibit5 * adv_sca_5 & 2463 ) * & 2464 ( sk(k,j+3,i) + sk(k,j-2,i) ) & 2459 2465 ) 2460 2466 2461 diss_n(k) = -ABS( v_comp ) * ( &2462 ( 10.0 * ibit5 * adv_sca_5&2463 + 3.0 * ibit4 * adv_sca_3&2464 + ibit3 * adv_sca_1&2465 ) * &2466 ( sk(k,j+1,i) - sk(k,j,i) ) &2467 - ( 5.0 * ibit5 * adv_sca_5&2468 + ibit4 * adv_sca_3&2469 ) * &2470 ( sk(k,j+2,i) - sk(k,j-1,i) ) &2471 + ( ibit5 * adv_sca_5&2472 ) * &2473 ( sk(k,j+3,i) - sk(k,j-2,i) ) &2467 diss_n(k) = -ABS( v_comp ) * ( & 2468 ( 10.0_wp * ibit5 * adv_sca_5 & 2469 + 3.0_wp * ibit4 * adv_sca_3 & 2470 + ibit3 * adv_sca_1 & 2471 ) * & 2472 ( sk(k,j+1,i) - sk(k,j,i) ) & 2473 - ( 5.0_wp * ibit5 * adv_sca_5 & 2474 + ibit4 * adv_sca_3 & 2475 ) * & 2476 ( sk(k,j+2,i) - sk(k,j-1,i) ) & 2477 + ( ibit5 * adv_sca_5 & 2478 ) * & 2479 ( sk(k,j+3,i) - sk(k,j-2,i) ) & 2474 2480 ) 2475 2481 ! … … 2486 2492 2487 2493 flux_t(k) = w(k,j,i) * ( & 2488 ( 37.0 * ibit8 * adv_sca_5&2489 + 7.0 * ibit7 * adv_sca_3&2494 ( 37.0_wp * ibit8 * adv_sca_5 & 2495 + 7.0_wp * ibit7 * adv_sca_3 & 2490 2496 + ibit6 * adv_sca_1 & 2491 2497 ) * & 2492 ( sk(k+1,j,i) + sk(k,j,i) )&2493 - ( 8.0 * ibit8 * adv_sca_5&2494 + ibit7 * adv_sca_3&2498 ( sk(k+1,j,i) + sk(k,j,i) ) & 2499 - ( 8.0_wp * ibit8 * adv_sca_5 & 2500 + ibit7 * adv_sca_3 & 2495 2501 ) * & 2496 ( sk(k_pp,j,i) + sk(k-1,j,i) )&2497 + ( ibit8 * adv_sca_5&2502 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 2503 + ( ibit8 * adv_sca_5 & 2498 2504 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 2499 2505 ) 2500 2506 2501 2507 diss_t(k) = -ABS( w(k,j,i) ) * ( & 2502 ( 10.0 * ibit8 * adv_sca_5&2503 + 3.0 * ibit7 * adv_sca_3&2504 + ibit6 * adv_sca_1&2508 ( 10.0_wp * ibit8 * adv_sca_5 & 2509 + 3.0_wp * ibit7 * adv_sca_3 & 2510 + ibit6 * adv_sca_1 & 2505 2511 ) * & 2506 2512 ( sk(k+1,j,i) - sk(k,j,i) ) & 2507 - ( 5.0 * ibit8 * adv_sca_5&2508 + ibit7 * adv_sca_3&2513 - ( 5.0_wp * ibit8 * adv_sca_5 & 2514 + ibit7 * adv_sca_3 & 2509 2515 ) * & 2510 2516 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 2511 + ( ibit8 * adv_sca_5&2517 + ( ibit8 * adv_sca_5 & 2512 2518 ) * & 2513 2519 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & 2514 )2520 ) 2515 2521 ! 2516 2522 !-- Calculate the divergence of the velocity field. A respective … … 2542 2548 2543 2549 u_comp = u(k,j,i+1) - u_gtrans 2544 flux_r(k) = u_comp * ( &2545 37.0 * ( sk(k,j,i+1) + sk(k,j,i) )&2546 - 8.0 * ( sk(k,j,i+2) + sk(k,j,i-1) )&2547 + ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_52548 diss_r(k) = -ABS( u_comp ) * ( &2549 10.0 * ( sk(k,j,i+1) - sk(k,j,i) )&2550 - 5.0 * ( sk(k,j,i+2) - sk(k,j,i-1) )&2551 + ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_52550 flux_r(k) = u_comp * ( & 2551 37.0_wp * ( sk(k,j,i+1) + sk(k,j,i) ) & 2552 - 8.0_wp * ( sk(k,j,i+2) + sk(k,j,i-1) ) & 2553 + ( sk(k,j,i+3) + sk(k,j,i-2) ) ) * adv_sca_5 2554 diss_r(k) = -ABS( u_comp ) * ( & 2555 10.0_wp * ( sk(k,j,i+1) - sk(k,j,i) ) & 2556 - 5.0_wp * ( sk(k,j,i+2) - sk(k,j,i-1) ) & 2557 + ( sk(k,j,i+3) - sk(k,j,i-2) ) ) * adv_sca_5 2552 2558 2553 2559 v_comp = v(k,j+1,i) - v_gtrans 2554 flux_n(k) = v_comp * ( &2555 37.0 * ( sk(k,j+1,i) + sk(k,j,i) )&2556 - 8.0 * ( sk(k,j+2,i) + sk(k,j-1,i) )&2557 + ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_52558 diss_n(k) = -ABS( v_comp ) * ( &2559 10.0 * ( sk(k,j+1,i) - sk(k,j,i) )&2560 - 5.0 * ( sk(k,j+2,i) - sk(k,j-1,i) )&2561 + ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_52560 flux_n(k) = v_comp * ( & 2561 37.0_wp * ( sk(k,j+1,i) + sk(k,j,i) ) & 2562 - 8.0_wp * ( sk(k,j+2,i) + sk(k,j-1,i) ) & 2563 + ( sk(k,j+3,i) + sk(k,j-2,i) ) ) * adv_sca_5 2564 diss_n(k) = -ABS( v_comp ) * ( & 2565 10.0_wp * ( sk(k,j+1,i) - sk(k,j,i) ) & 2566 - 5.0_wp * ( sk(k,j+2,i) - sk(k,j-1,i) ) & 2567 + ( sk(k,j+3,i) - sk(k,j-2,i) ) ) * adv_sca_5 2562 2568 ! 2563 2569 !-- k index has to be modified near bottom and top, else array … … 2573 2579 2574 2580 flux_t(k) = w(k,j,i) * ( & 2575 ( 37.0 * ibit8 * adv_sca_5&2576 + 7.0 * ibit7 * adv_sca_3&2577 + ibit6 * adv_sca_1&2581 ( 37.0_wp * ibit8 * adv_sca_5 & 2582 + 7.0_wp * ibit7 * adv_sca_3 & 2583 + ibit6 * adv_sca_1 & 2578 2584 ) * & 2579 ( sk(k+1,j,i) + sk(k,j,i) )&2580 - ( 8.0 * ibit8 * adv_sca_5&2581 + ibit7 * adv_sca_3&2585 ( sk(k+1,j,i) + sk(k,j,i) ) & 2586 - ( 8.0_wp * ibit8 * adv_sca_5 & 2587 + ibit7 * adv_sca_3 & 2582 2588 ) * & 2583 ( sk(k_pp,j,i) + sk(k-1,j,i) )&2584 + ( ibit8 * adv_sca_5&2585 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) )&2589 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 2590 + ( ibit8 * adv_sca_5 & 2591 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 2586 2592 ) 2587 2593 2588 2594 diss_t(k) = -ABS( w(k,j,i) ) * ( & 2589 ( 10.0 * ibit8 * adv_sca_5&2590 + 3.0 * ibit7 * adv_sca_3&2591 + ibit6 * adv_sca_1&2595 ( 10.0_wp * ibit8 * adv_sca_5 & 2596 + 3.0_wp * ibit7 * adv_sca_3 & 2597 + ibit6 * adv_sca_1 & 2592 2598 ) * & 2593 2599 ( sk(k+1,j,i) - sk(k,j,i) ) & 2594 - ( 5.0 * ibit8 * adv_sca_5&2595 + ibit7 * adv_sca_3&2600 - ( 5.0_wp * ibit8 * adv_sca_5 & 2601 + ibit7 * adv_sca_3 & 2596 2602 ) * & 2597 2603 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 2598 + ( ibit8 * adv_sca_5&2604 + ( ibit8 * adv_sca_5 & 2599 2605 ) * & 2600 2606 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & 2601 )2607 ) 2602 2608 ! 2603 2609 !-- Calculate the divergence of the velocity field. A respective … … 2661 2667 SUBROUTINE advec_s_ws_acc ( sk, sk_char ) 2662 2668 2663 USE arrays_3d, 2669 USE arrays_3d, & 2664 2670 ONLY: ddzw, tend, u, v, w 2665 2671 2666 USE constants, 2672 USE constants, & 2667 2673 ONLY: adv_sca_1, adv_sca_3, adv_sca_5 2668 2674 2669 USE control_parameters, 2675 USE control_parameters, & 2670 2676 ONLY: intermediate_timestep_count, u_gtrans, v_gtrans 2671 2677 2672 USE grid_variables, 2678 USE grid_variables, & 2673 2679 ONLY: ddx, ddy 2674 2680 2675 USE indices, 2676 ONLY: i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg, 2681 USE indices, & 2682 ONLY: i_left, i_right, j_north, j_south, nxlg, nxrg, nyng, nysg, & 2677 2683 nzb, nzb_max, nzt, wall_flags_0 2678 2684 … … 2735 2741 2736 2742 u_comp = u(k,j,i) - u_gtrans 2737 flux_l = u_comp * ( &2738 ( 37.0 * ibit2 * adv_sca_5 &2739 + 7.0 * ibit1 * adv_sca_3 &2740 + ibit0 * adv_sca_1 &2741 ) * &2742 ( sk(k,j,i) + sk(k,j,i-1) ) &2743 - ( 8.0 * ibit2 * adv_sca_5 &2744 + ibit1 * adv_sca_3 &2745 ) * &2746 ( sk(k,j,i+1) + sk(k,j,i-2) ) &2747 + ( ibit2 * adv_sca_5 &2748 ) * &2749 ( sk(k,j,i+2) + sk(k,j,i-3) ) &2750 )2751 2752 diss_l = -ABS( u_comp ) * ( &2753 ( 10.0 * ibit2 * adv_sca_5 &2754 + 3.0 * ibit1 * adv_sca_3 &2755 + ibit0 * adv_sca_1 &2756 ) * &2757 ( sk(k,j,i) - sk(k,j,i-1) ) &2758 - ( 5.0 * ibit2 * adv_sca_5 &2759 + ibit1 * adv_sca_3 &2760 ) * &2761 ( sk(k,j,i+1) - sk(k,j,i-2) )&2762 + ( ibit2 * adv_sca_5 &2763 ) * &2764 ( sk(k,j,i+2) - sk(k,j,i-3) ) &2765 )2743 flux_l = u_comp * ( & 2744 ( 37.0_wp * ibit2 * adv_sca_5 & 2745 + 7.0_wp * ibit1 * adv_sca_3 & 2746 + ibit0 * adv_sca_1 & 2747 ) * & 2748 ( sk(k,j,i) + sk(k,j,i-1) ) & 2749 - ( 8.0_wp * ibit2 * adv_sca_5 & 2750 + ibit1 * adv_sca_3 & 2751 ) * & 2752 ( sk(k,j,i+1) + sk(k,j,i-2) ) & 2753 + ( ibit2 * adv_sca_5 & 2754 ) * & 2755 ( sk(k,j,i+2) + sk(k,j,i-3) ) & 2756 ) 2757 2758 diss_l = -ABS( u_comp ) * ( & 2759 ( 10.0_wp * ibit2 * adv_sca_5 & 2760 + 3.0_wp * ibit1 * adv_sca_3 & 2761 + ibit0 * adv_sca_1 & 2762 ) * & 2763 ( sk(k,j,i) - sk(k,j,i-1) ) & 2764 - ( 5.0_wp * ibit2 * adv_sca_5 & 2765 + ibit1 * adv_sca_3 & 2766 ) * & 2767 ( sk(k,j,i+1) - sk(k,j,i-2) ) & 2768 + ( ibit2 * adv_sca_5 & 2769 ) * & 2770 ( sk(k,j,i+2) - sk(k,j,i-3) ) & 2771 ) 2766 2772 2767 2773 u_comp = u(k,j,i+1) - u_gtrans 2768 flux_r = u_comp * ( &2769 ( 37.0 * ibit2 * adv_sca_5&2770 + 7.0 * ibit1 * adv_sca_3&2771 + ibit0 * adv_sca_1&2772 ) * &2773 ( sk(k,j,i+1) + sk(k,j,i) ) &2774 - ( 8.0 * ibit2 * adv_sca_5&2775 + ibit1 * adv_sca_3&2776 ) * &2777 ( sk(k,j,i+2) + sk(k,j,i-1) ) &2778 + ( ibit2 * adv_sca_5&2779 ) * &2780 ( sk(k,j,i+3) + sk(k,j,i-2) ) &2774 flux_r = u_comp * ( & 2775 ( 37.0_wp * ibit2 * adv_sca_5 & 2776 + 7.0_wp * ibit1 * adv_sca_3 & 2777 + ibit0 * adv_sca_1 & 2778 ) * & 2779 ( sk(k,j,i+1) + sk(k,j,i) ) & 2780 - ( 8.0_wp * ibit2 * adv_sca_5 & 2781 + ibit1 * adv_sca_3 & 2782 ) * & 2783 ( sk(k,j,i+2) + sk(k,j,i-1) ) & 2784 + ( ibit2 * adv_sca_5 & 2785 ) * & 2786 ( sk(k,j,i+3) + sk(k,j,i-2) ) & 2781 2787 ) 2782 2788 2783 diss_r = -ABS( u_comp ) * ( &2784 ( 10.0 * ibit2 * adv_sca_5&2785 + 3.0 * ibit1 * adv_sca_3&2786 + ibit0 * adv_sca_1&2787 ) * &2788 ( sk(k,j,i+1) - sk(k,j,i) )&2789 - ( 5.0 * ibit2 * adv_sca_5&2790 + ibit1 * adv_sca_3&2791 ) * &2792 ( sk(k,j,i+2) - sk(k,j,i-1) ) &2793 + ( ibit2 * adv_sca_5&2794 ) * &2795 ( sk(k,j,i+3) - sk(k,j,i-2) ) &2789 diss_r = -ABS( u_comp ) * ( & 2790 ( 10.0_wp * ibit2 * adv_sca_5 & 2791 + 3.0_wp * ibit1 * adv_sca_3 & 2792 + ibit0 * adv_sca_1 & 2793 ) * & 2794 ( sk(k,j,i+1) - sk(k,j,i) ) & 2795 - ( 5.0_wp * ibit2 * adv_sca_5 & 2796 + ibit1 * adv_sca_3 & 2797 ) * & 2798 ( sk(k,j,i+2) - sk(k,j,i-1) ) & 2799 + ( ibit2 * adv_sca_5 & 2800 ) * & 2801 ( sk(k,j,i+3) - sk(k,j,i-2) ) & 2796 2802 ) 2797 2803 … … 2800 2806 ibit3 = IBITS(wall_flags_0(k,j,i),3,1) 2801 2807 2802 v_comp = v(k,j,i) - v_gtrans 2803 flux_s = v_comp * ( & 2804 ( 37.0 * ibit5 * adv_sca_5 & 2805 + 7.0 * ibit4 * adv_sca_3 & 2806 + ibit3 * adv_sca_1 & 2807 ) * & 2808 ( sk(k,j,i) + sk(k,j-1,i) ) & 2809 - ( 8.0 * ibit5 * adv_sca_5 & 2810 + ibit4 * adv_sca_3 & 2811 ) * & 2812 ( sk(k,j+1,i) + sk(k,j-2,i) ) & 2813 + ( ibit5 * adv_sca_5 & 2814 ) * & 2815 ( sk(k,j+2,i) + sk(k,j-3,i) ) & 2808 v_comp = v(k,j,i) - v_gtrans 2809 flux_s = v_comp * ( & 2810 ( 37.0_wp * ibit5 * adv_sca_5 & 2811 + 7.0_wp * ibit4 * adv_sca_3 & 2812 + ibit3 * adv_sca_1 & 2813 ) * & 2814 ( sk(k,j,i) + sk(k,j-1,i) ) & 2815 - ( 8.0_wp * ibit5 * adv_sca_5 & 2816 + ibit4 * adv_sca_3 & 2817 ) * & 2818 ( sk(k,j+1,i) + sk(k,j-2,i) ) & 2819 + ( ibit5 * adv_sca_5 & 2820 ) * & 2821 ( sk(k,j+2,i) + sk(k,j-3,i) ) & 2822 ) 2823 2824 diss_s = -ABS( v_comp ) * ( & 2825 ( 10.0_wp * ibit5 * adv_sca_5 & 2826 + 3.0_wp * ibit4 * adv_sca_3 & 2827 + ibit3 * adv_sca_1 & 2828 ) * & 2829 ( sk(k,j,i) - sk(k,j-1,i) ) & 2830 - ( 5.0_wp * ibit5 * adv_sca_5 & 2831 + ibit4 * adv_sca_3 & 2832 ) * & 2833 ( sk(k,j+1,i) - sk(k,j-2,i) ) & 2834 + ( ibit5 * adv_sca_5 & 2835 ) * & 2836 ( sk(k,j+2,i) - sk(k,j-3,i) ) & 2816 2837 ) 2817 2838 2818 diss_s = -ABS( v_comp ) * ( &2819 ( 10.0 * ibit5 * adv_sca_5 &2820 + 3.0 * ibit4 * adv_sca_3 &2821 + ibit3 * adv_sca_1 &2822 ) * &2823 ( sk(k,j,i) - sk(k,j-1,i) ) &2824 - ( 5.0 * ibit5 * adv_sca_5 &2825 + ibit4 * adv_sca_3 &2826 ) * &2827 ( sk(k,j+1,i) - sk(k,j-2,i) ) &2828 + ( ibit5 * adv_sca_5 &2829 ) * &2830 ( sk(k,j+2,i) - sk(k,j-3,i) ) &2831 )2832 2833 2839 2834 2840 v_comp = v(k,j+1,i) - v_gtrans 2835 flux_n = v_comp * ( &2836 ( 37.0 * ibit5 * adv_sca_5&2837 + 7.0 * ibit4 * adv_sca_3&2838 + ibit3 * adv_sca_1&2839 ) * &2840 ( sk(k,j+1,i) + sk(k,j,i) ) &2841 - ( 8.0 * ibit5 * adv_sca_5&2842 + ibit4 * adv_sca_3&2843 ) * &2844 ( sk(k,j+2,i) + sk(k,j-1,i) ) &2845 + ( ibit5 * adv_sca_5&2846 ) * &2847 ( sk(k,j+3,i) + sk(k,j-2,i) ) &2841 flux_n = v_comp * ( & 2842 ( 37.0_wp * ibit5 * adv_sca_5 & 2843 + 7.0_wp * ibit4 * adv_sca_3 & 2844 + ibit3 * adv_sca_1 & 2845 ) * & 2846 ( sk(k,j+1,i) + sk(k,j,i) ) & 2847 - ( 8.0_wp * ibit5 * adv_sca_5 & 2848 + ibit4 * adv_sca_3 & 2849 ) * & 2850 ( sk(k,j+2,i) + sk(k,j-1,i) ) & 2851 + ( ibit5 * adv_sca_5 & 2852 ) * & 2853 ( sk(k,j+3,i) + sk(k,j-2,i) ) & 2848 2854 ) 2849 2855 2850 diss_n = -ABS( v_comp ) * ( &2851 ( 10.0 * ibit5 * adv_sca_5&2852 + 3.0 * ibit4 * adv_sca_3&2853 + ibit3 * adv_sca_1&2854 ) * &2855 ( sk(k,j+1,i) - sk(k,j,i) ) &2856 - ( 5.0 * ibit5 * adv_sca_5&2857 + ibit4 * adv_sca_3&2858 ) * &2859 ( sk(k,j+2,i) - sk(k,j-1,i) ) &2860 + ( ibit5 * adv_sca_5&2861 ) * &2862 ( sk(k,j+3,i) - sk(k,j-2,i) )&2856 diss_n = -ABS( v_comp ) * ( & 2857 ( 10.0_wp * ibit5 * adv_sca_5 & 2858 + 3.0_wp * ibit4 * adv_sca_3 & 2859 + ibit3 * adv_sca_1 & 2860 ) * & 2861 ( sk(k,j+1,i) - sk(k,j,i) ) & 2862 - ( 5.0_wp * ibit5 * adv_sca_5 & 2863 + ibit4 * adv_sca_3 & 2864 ) * & 2865 ( sk(k,j+2,i) - sk(k,j-1,i) ) & 2866 + ( ibit5 * adv_sca_5 & 2867 ) * & 2868 ( sk(k,j+3,i) - sk(k,j-2,i) ) & 2863 2869 ) 2864 2870 … … 2874 2880 2875 2881 flux_d = w(k-1,j,i) * ( & 2876 ( 37.0 * ibit8 * adv_sca_5&2877 + 7.0 * ibit7 * adv_sca_3&2878 + ibit6 * adv_sca_1&2882 ( 37.0_wp * ibit8 * adv_sca_5 & 2883 + 7.0_wp * ibit7 * adv_sca_3 & 2884 + ibit6 * adv_sca_1 & 2879 2885 ) * & 2880 ( sk(k,j,i) + sk(k-1,j,i) )&2881 - ( 8.0 * ibit8 * adv_sca_5&2882 + ibit7 * adv_sca_3&2886 ( sk(k,j,i) + sk(k-1,j,i) ) & 2887 - ( 8.0_wp * ibit8 * adv_sca_5 & 2888 + ibit7 * adv_sca_3 & 2883 2889 ) * & 2884 ( sk(k+1,j,i) + sk(k_mm,j,i) )&2885 + ( ibit8 * adv_sca_5&2890 ( sk(k+1,j,i) + sk(k_mm,j,i) ) & 2891 + ( ibit8 * adv_sca_5 & 2886 2892 ) * ( sk(k_pp,j,i)+ sk(k_mmm,j,i) ) & 2887 )2893 ) 2888 2894 2889 2895 diss_d = -ABS( w(k-1,j,i) ) * ( & 2890 ( 10.0 * ibit8 * adv_sca_5&2891 + 3.0 * ibit7 * adv_sca_3&2892 + ibit6 * adv_sca_1&2896 ( 10.0_wp * ibit8 * adv_sca_5 & 2897 + 3.0_wp * ibit7 * adv_sca_3 & 2898 + ibit6 * adv_sca_1 & 2893 2899 ) * & 2894 2900 ( sk(k,j,i) - sk(k-1,j,i) ) & 2895 - ( 5.0 * ibit8 * adv_sca_5&2896 + ibit7 * adv_sca_3&2901 - ( 5.0_wp * ibit8 * adv_sca_5 & 2902 + ibit7 * adv_sca_3 & 2897 2903 ) * & 2898 2904 ( sk(k+1,j,i) - sk(k_mm,j,i) ) & 2899 + ( ibit8 * adv_sca_5&2905 + ( ibit8 * adv_sca_5 & 2900 2906 ) * & 2901 2907 ( sk(k_pp,j,i) - sk(k_mmm,j,i) ) & 2902 )2908 ) 2903 2909 2904 2910 ibit8 = IBITS(wall_flags_0(k,j,i),8,1) … … 2911 2917 2912 2918 flux_t = w(k,j,i) * ( & 2913 ( 37.0 * ibit8 * adv_sca_5&2914 + 7.0 * ibit7 * adv_sca_3&2915 + ibit6 * adv_sca_1&2919 ( 37.0_wp * ibit8 * adv_sca_5 & 2920 + 7.0_wp * ibit7 * adv_sca_3 & 2921 + ibit6 * adv_sca_1 & 2916 2922 ) * & 2917 ( sk(k+1,j,i) + sk(k,j,i) )&2918 - ( 8.0 * ibit8 * adv_sca_5&2919 + ibit7 * adv_sca_3&2923 ( sk(k+1,j,i) + sk(k,j,i) ) & 2924 - ( 8.0_wp * ibit8 * adv_sca_5 & 2925 + ibit7 * adv_sca_3 & 2920 2926 ) * & 2921 ( sk(k_pp,j,i) + sk(k-1,j,i) )&2922 + ( ibit8 * adv_sca_5&2927 ( sk(k_pp,j,i) + sk(k-1,j,i) ) & 2928 + ( ibit8 * adv_sca_5 & 2923 2929 ) * ( sk(k_ppp,j,i)+ sk(k_mm,j,i) ) & 2924 2930 ) 2925 2931 2926 2932 diss_t = -ABS( w(k,j,i) ) * ( & 2927 ( 10.0 * ibit8 * adv_sca_5&2928 + 3.0 * ibit7 * adv_sca_3&2929 + ibit6 * adv_sca_1&2933 ( 10.0_wp * ibit8 * adv_sca_5 & 2934 + 3.0_wp * ibit7 * adv_sca_3 & 2935 + ibit6 * adv_sca_1 & 2930 2936 ) * & 2931 2937 ( sk(k+1,j,i) - sk(k,j,i) ) & 2932 - ( 5.0 * ibit8 * adv_sca_5&2933 + ibit7 * adv_sca_3&2938 - ( 5.0_wp * ibit8 * adv_sca_5 & 2939 + ibit7 * adv_sca_3 & 2934 2940 ) * & 2935 2941 ( sk(k_pp,j,i) - sk(k-1,j,i) ) & 2936 + ( ibit8 * adv_sca_5&2942 + ( ibit8 * adv_sca_5 & 2937 2943 ) * & 2938 2944 ( sk(k_ppp,j,i) - sk(k_mm,j,i) ) & … … 3045 3051 REAL(wp), DIMENSION(nzb:nzt) :: u_comp !: 3046 3052 3047 gu = 2.0 * u_gtrans3048 gv = 2.0 * v_gtrans3053 gu = 2.0_wp * u_gtrans 3054 gv = 2.0_wp * v_gtrans 3049 3055 3050 3056 ! … … 3060 3066 u_comp(k) = u(k,j,i) + u(k,j,i-1) - gu 3061 3067 swap_flux_x_local_u(k,j) = u_comp(k) * ( & 3062 ( 37.0 * ibit11 * adv_mom_5 &3063 + 7.0 * ibit10 * adv_mom_3 &3064 + ibit9 * adv_mom_1 &3068 ( 37.0_wp * ibit11 * adv_mom_5 & 3069 + 7.0_wp * ibit10 * adv_mom_3 & 3070 + ibit9 * adv_mom_1 & 3065 3071 ) * & 3066 3072 ( u(k,j,i) + u(k,j,i-1) ) & 3067 - ( 8.0 * ibit11 * adv_mom_5 &3068 + ibit10 * adv_mom_3 &3073 - ( 8.0_wp * ibit11 * adv_mom_5 & 3074 + ibit10 * adv_mom_3 & 3069 3075 ) * & 3070 3076 ( u(k,j,i+1) + u(k,j,i-2) ) & 3071 + ( ibit11 * adv_mom_5 &3077 + ( ibit11 * adv_mom_5 & 3072 3078 ) * & 3073 3079 ( u(k,j,i+2) + u(k,j,i-3) ) & … … 3075 3081 3076 3082 swap_diss_x_local_u(k,j) = - ABS( u_comp(k) ) * ( & 3077 ( 10.0 * ibit11 * adv_mom_5 &3078 + 3.0 * ibit10 * adv_mom_3 &3079 + ibit9 * adv_mom_1 &3083 ( 10.0_wp * ibit11 * adv_mom_5 & 3084 + 3.0_wp * ibit10 * adv_mom_3 & 3085 + ibit9 * adv_mom_1 & 3080 3086 ) * & 3081 3087 ( u(k,j,i) - u(k,j,i-1) ) & 3082 - ( 5.0 * ibit11 * adv_mom_5 &3083 + ibit10 * adv_mom_3 &3088 - ( 5.0_wp * ibit11 * adv_mom_5 & 3089 + ibit10 * adv_mom_3 & 3084 3090 ) * & 3085 3091 ( u(k,j,i+1) - u(k,j,i-2) ) & 3086 + ( ibit11 * adv_mom_5 &3092 + ( ibit11 * adv_mom_5 & 3087 3093 ) * & 3088 3094 ( u(k,j,i+2) - u(k,j,i-3) ) & … … 3095 3101 u_comp(k) = u(k,j,i) + u(k,j,i-1) - gu 3096 3102 swap_flux_x_local_u(k,j) = u_comp(k) * ( & 3097 37.0 * ( u(k,j,i) + u(k,j,i-1) ) &3098 - 8.0 * ( u(k,j,i+1) + u(k,j,i-2) ) &3099 + ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_53103 37.0_wp * ( u(k,j,i) + u(k,j,i-1) ) & 3104 - 8.0_wp * ( u(k,j,i+1) + u(k,j,i-2) ) & 3105 + ( u(k,j,i+2) + u(k,j,i-3) ) ) * adv_mom_5 3100 3106 swap_diss_x_local_u(k,j) = - ABS(u_comp(k)) * ( & 3101 10.0 * ( u(k,j,i) - u(k,j,i-1) ) &3102 - 5.0 * ( u(k,j,i+1) - u(k,j,i-2) ) &3103 + ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_53107 10.0_wp * ( u(k,j,i) - u(k,j,i-1) ) & 3108 - 5.0_wp * ( u(k,j,i+1) - u(k,j,i-2) ) & 3109 + ( u(k,j,i+2) - u(k,j,i-3) ) ) * adv_mom_5 3104 3110 3105 3111 ENDDO … … 3118 3124 v_comp = v(k,j,i) + v(k,j,i-1) - gv 3119 3125 swap_flux_y_local_u(k) = v_comp * ( & 3120 ( 37.0 * ibit14 * adv_mom_5 &3121 + 7.0 * ibit13 * adv_mom_3 &3122 + ibit12 * adv_mom_1 &3126 ( 37.0_wp * ibit14 * adv_mom_5 & 3127 + 7.0_wp * ibit13 * adv_mom_3 & 3128 + ibit12 * adv_mom_1 & 3123 3129 ) * & 3124 3130 ( u(k,j,i) + u(k,j-1,i) ) & 3125 - ( 8.0 * ibit14 * adv_mom_5 &3126 + ibit13 * adv_mom_3 &3131 - ( 8.0_wp * ibit14 * adv_mom_5 & 3132 + ibit13 * adv_mom_3 & 3127 3133 ) * & 3128 3134 ( u(k,j+1,i) + u(k,j-2,i) ) & 3129 + ( ibit14 * adv_mom_5 &3135 + ( ibit14 * adv_mom_5 & 3130 3136 ) * & 3131 3137 ( u(k,j+2,i) + u(k,j-3,i) ) & … … 3133 3139 3134 3140 swap_diss_y_local_u(k) = - ABS ( v_comp ) * ( & 3135 ( 10.0 * ibit14 * adv_mom_5 &3136 + 3.0 * ibit13 * adv_mom_3 &3137 + ibit12 * adv_mom_1 &3141 ( 10.0_wp * ibit14 * adv_mom_5 & 3142 + 3.0_wp * ibit13 * adv_mom_3 & 3143 + ibit12 * adv_mom_1 & 3138 3144 ) * & 3139 3145 ( u(k,j,i) - u(k,j-1,i) ) & 3140 - ( 5.0 * ibit14 * adv_mom_5 &3141 + ibit13 * adv_mom_3 &3146 - ( 5.0_wp * ibit14 * adv_mom_5 & 3147 + ibit13 * adv_mom_3 & 3142 3148 ) * & 3143 3149 ( u(k,j+1,i) - u(k,j-2,i) ) & 3144 + ( ibit14 * adv_mom_5 &3150 + ( ibit14 * adv_mom_5 & 3145 3151 ) * & 3146 3152 ( u(k,j+2,i) - u(k,j-3,i) ) & … … 3153 3159 v_comp = v(k,j,i) + v(k,j,i-1) - gv 3154 3160 swap_flux_y_local_u(k) = v_comp * ( & 3155 37.0 * ( u(k,j,i) + u(k,j-1,i) ) &3156 - 8.0 * ( u(k,j+1,i) + u(k,j-2,i) ) &3157 + ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_53161 37.0_wp * ( u(k,j,i) + u(k,j-1,i) ) & 3162 - 8.0_wp * ( u(k,j+1,i) + u(k,j-2,i) ) & 3163 + ( u(k,j+2,i) + u(k,j-3,i) ) ) * adv_mom_5 3158 3164 swap_diss_y_local_u(k) = - ABS(v_comp) * ( & 3159 10.0 * ( u(k,j,i) - u(k,j-1,i) ) &3160 - 5.0 * ( u(k,j+1,i) - u(k,j-2,i) ) &3161 + ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_53165 10.0_wp * ( u(k,j,i) - u(k,j-1,i) ) & 3166 - 5.0_wp * ( u(k,j+1,i) - u(k,j-2,i) ) & 3167 + ( u(k,j+2,i) - u(k,j-3,i) ) ) * adv_mom_5 3162 3168 3163 3169 ENDDO … … 3166 3172 DO j = nys, nyn 3167 3173 3168 flux_t(0) = 0.0 3169 diss_t(0) = 0.0 3170 flux_d = 0.0 3171 diss_d = 0.0 3174 flux_t(0) = 0.0_wp 3175 diss_t(0) = 0.0_wp 3176 flux_d = 0.0_wp 3177 diss_d = 0.0_wp 3172 3178 3173 3179 DO k = nzb+1, nzb_max … … 3179 3185 u_comp(k) = u(k,j,i+1) + u(k,j,i) 3180 3186 flux_r(k) = ( u_comp(k) - gu ) * ( & 3181 ( 37.0 * ibit11 * adv_mom_5 &3182 + 7.0 * ibit10 * adv_mom_3 &3183 + ibit9 * adv_mom_1 &3187 ( 37.0_wp * ibit11 * adv_mom_5 & 3188 + 7.0_wp * ibit10 * adv_mom_3 & 3189 + ibit9 * adv_mom_1 & 3184 3190 ) * & 3185 3191 ( u(k,j,i+1) + u(k,j,i) ) & 3186 - ( 8.0 * ibit11 * adv_mom_5 &3187 + ibit10 * adv_mom_3 &3192 - ( 8.0_wp * ibit11 * adv_mom_5 & 3193 + ibit10 * adv_mom_3 & 3188 3194 ) * & 3189 3195 ( u(k,j,i+2) + u(k,j,i-1) ) & 3190 + ( ibit11 * adv_mom_5 &3196 + ( ibit11 * adv_mom_5 & 3191 3197 ) * & 3192 3198 ( u(k,j,i+3) + u(k,j,i-2) ) & … … 3194 3200 3195 3201 diss_r(k) = - ABS( u_comp(k) - gu ) * ( & 3196 ( 10.0 * ibit11 * adv_mom_5 &3197 + 3.0 * ibit10 * adv_mom_3 &3198 + ibit9 * adv_mom_1 &3202 ( 10.0_wp * ibit11 * adv_mom_5 & 3203 + 3.0_wp * ibit10 * adv_mom_3 & 3204 + ibit9 * adv_mom_1 & 3199 3205 ) * & 3200 3206 ( u(k,j,i+1) - u(k,j,i) ) & 3201 - ( 5.0 * ibit11 * adv_mom_5 &3202 + ibit10 * adv_mom_3 &3207 - ( 5.0_wp * ibit11 * adv_mom_5 & 3208 + ibit10 * adv_mom_3 & 3203 3209 ) * & 3204 3210 ( u(k,j,i+2) - u(k,j,i-1) ) & 3205 + ( ibit11 * adv_mom_5 &3211 + ( ibit11 * adv_mom_5 & 3206 3212 ) * & 3207 3213 ( u(k,j,i+3) - u(k,j,i-2) ) & … … 3214 3220 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 3215 3221 flux_n(k) = v_comp * ( & 3216 ( 37.0 * ibit14 * adv_mom_5 &3217 + 7.0 * ibit13 * adv_mom_3 &3218 + ibit12 * adv_mom_1 &3222 ( 37.0_wp * ibit14 * adv_mom_5 & 3223 + 7.0_wp * ibit13 * adv_mom_3 & 3224 + ibit12 * adv_mom_1 & 3219 3225 ) * & 3220 3226 ( u(k,j+1,i) + u(k,j,i) ) & 3221 - ( 8.0 * ibit14 * adv_mom_5 &3222 + ibit13 * adv_mom_3 &3227 - ( 8.0_wp * ibit14 * adv_mom_5 & 3228 + ibit13 * adv_mom_3 & 3223 3229 ) * & 3224 3230 ( u(k,j+2,i) + u(k,j-1,i) ) & 3225 + ( ibit14 * adv_mom_5 &3231 + ( ibit14 * adv_mom_5 & 3226 3232 ) * & 3227 3233 ( u(k,j+3,i) + u(k,j-2,i) ) & … … 3229 3235 3230 3236 diss_n(k) = - ABS ( v_comp ) * ( & 3231 ( 10.0 * ibit14 * adv_mom_5 &3232 + 3.0 * ibit13 * adv_mom_3 &3233 + ibit12 * adv_mom_1 &3237 ( 10.0_wp * ibit14 * adv_mom_5 & 3238 + 3.0_wp * ibit13 * adv_mom_3 & 3239 + ibit12 * adv_mom_1 & 3234 3240 ) * & 3235 3241 ( u(k,j+1,i) - u(k,j,i) ) & 3236 - ( 5.0 * ibit14 * adv_mom_5 &3237 + ibit13 * adv_mom_3 &3242 - ( 5.0_wp * ibit14 * adv_mom_5 & 3243 + ibit13 * adv_mom_3 & 3238 3244 ) * & 3239 3245 ( u(k,j+2,i) - u(k,j-1,i) ) & 3240 + ( ibit14 * adv_mom_5 &3246 + ( ibit14 * adv_mom_5 & 3241 3247 ) * & 3242 3248 ( u(k,j+3,i) - u(k,j-2,i) ) & … … 3255 3261 w_comp = w(k,j,i) + w(k,j,i-1) 3256 3262 flux_t(k) = w_comp * ( & 3257 ( 37.0 * ibit17 * adv_mom_5 &3258 + 7.0 * ibit16 * adv_mom_3 &3259 + ibit15 * adv_mom_1 &3263 ( 37.0_wp * ibit17 * adv_mom_5 & 3264 + 7.0_wp * ibit16 * adv_mom_3 & 3265 + ibit15 * adv_mom_1 & 3260 3266 ) * & 3261 3267 ( u(k+1,j,i) + u(k,j,i) ) & 3262 - ( 8.0 * ibit17 * adv_mom_5 &3263 + ibit16 * adv_mom_3 &3268 - ( 8.0_wp * ibit17 * adv_mom_5 & 3269 + ibit16 * adv_mom_3 & 3264 3270 ) * & 3265 3271 ( u(k_pp,j,i) + u(k-1,j,i) ) & 3266 + ( ibit17 * adv_mom_5 &3272 + ( ibit17 * adv_mom_5 & 3267 3273 ) * & 3268 3274 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & … … 3270 3276 3271 3277 diss_t(k) = - ABS( w_comp ) * ( & 3272 ( 10.0 * ibit17 * adv_mom_5 &3273 + 3.0 * ibit16 * adv_mom_3 &3274 + ibit15 * adv_mom_1 &3278 ( 10.0_wp * ibit17 * adv_mom_5 & 3279 + 3.0_wp * ibit16 * adv_mom_3 & 3280 + ibit15 * adv_mom_1 & 3275 3281 ) * & 3276 3282 ( u(k+1,j,i) - u(k,j,i) ) & 3277 - ( 5.0 * ibit17 * adv_mom_5 &3278 + ibit16 * adv_mom_3 &3283 - ( 5.0_wp * ibit17 * adv_mom_5 & 3284 + ibit16 * adv_mom_3 & 3279 3285 ) * & 3280 3286 ( u(k_pp,j,i) - u(k-1,j,i) ) & 3281 + ( ibit17 * adv_mom_5 &3287 + ( ibit17 * adv_mom_5 & 3282 3288 ) * & 3283 3289 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & … … 3291 3297 + ( w_comp - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) & 3292 3298 * ddzw(k) & 3293 ) * 0.5 3299 ) * 0.5_wp 3294 3300 3295 3301 tend(k,j,i) = tend(k,j,i) - ( & … … 3314 3320 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 3315 3321 + ( flux_r(k) * & 3316 ( u_comp(k) - 2.0 * hom(k,1,1,0) ) &3322 ( u_comp(k) - 2.0_wp * hom(k,1,1,0) ) & 3317 3323 / ( u_comp(k) - gu + 1.0E-20_wp ) & 3318 3324 + diss_r(k) * & 3319 ABS( u_comp(k) - 2.0 * hom(k,1,1,0) ) &3325 ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) ) & 3320 3326 / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) ) & 3321 3327 * weight_substep(intermediate_timestep_count) … … 3331 3337 u_comp(k) = u(k,j,i+1) + u(k,j,i) 3332 3338 flux_r(k) = ( u_comp(k) - gu ) * ( & 3333 37.0 * ( u(k,j,i+1) + u(k,j,i) ) &3334 - 8.0 * ( u(k,j,i+2) + u(k,j,i-1) ) &3335 + ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_53339 37.0_wp * ( u(k,j,i+1) + u(k,j,i) ) & 3340 - 8.0_wp * ( u(k,j,i+2) + u(k,j,i-1) ) & 3341 + ( u(k,j,i+3) + u(k,j,i-2) ) ) * adv_mom_5 3336 3342 diss_r(k) = - ABS( u_comp(k) - gu ) * ( & 3337 10.0 * ( u(k,j,i+1) - u(k,j,i) ) &3338 - 5.0 * ( u(k,j,i+2) - u(k,j,i-1) ) &3339 + ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_53343 10.0_wp * ( u(k,j,i+1) - u(k,j,i) ) & 3344 - 5.0_wp * ( u(k,j,i+2) - u(k,j,i-1) ) & 3345 + ( u(k,j,i+3) - u(k,j,i-2) ) ) * adv_mom_5 3340 3346 3341 3347 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 3342 3348 flux_n(k) = v_comp * ( & 3343 37.0 * ( u(k,j+1,i) + u(k,j,i) ) &3344 - 8.0 * ( u(k,j+2,i) + u(k,j-1,i) ) &3345 + ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_53349 37.0_wp * ( u(k,j+1,i) + u(k,j,i) ) & 3350 - 8.0_wp * ( u(k,j+2,i) + u(k,j-1,i) ) & 3351 + ( u(k,j+3,i) + u(k,j-2,i) ) ) * adv_mom_5 3346 3352 diss_n(k) = - ABS( v_comp ) * ( & 3347 10.0 * ( u(k,j+1,i) - u(k,j,i) ) &3348 - 5.0 * ( u(k,j+2,i) - u(k,j-1,i) ) &3349 + ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_53353 10.0_wp * ( u(k,j+1,i) - u(k,j,i) ) & 3354 - 5.0_wp * ( u(k,j+2,i) - u(k,j-1,i) ) & 3355 + ( u(k,j+3,i) - u(k,j-2,i) ) ) * adv_mom_5 3350 3356 ! 3351 3357 !-- k index has to be modified near bottom and top, else array … … 3361 3367 w_comp = w(k,j,i) + w(k,j,i-1) 3362 3368 flux_t(k) = w_comp * ( & 3363 ( 37.0 * ibit17 * adv_mom_5 &3364 + 7.0 * ibit16 * adv_mom_3 &3365 + ibit15 * adv_mom_1 &3369 ( 37.0_wp * ibit17 * adv_mom_5 & 3370 + 7.0_wp * ibit16 * adv_mom_3 & 3371 + ibit15 * adv_mom_1 & 3366 3372 ) * & 3367 3373 ( u(k+1,j,i) + u(k,j,i) ) & 3368 - ( 8.0 * ibit17 * adv_mom_5 &3369 + ibit16 * adv_mom_3 &3374 - ( 8.0_wp * ibit17 * adv_mom_5 & 3375 + ibit16 * adv_mom_3 & 3370 3376 ) * & 3371 3377 ( u(k_pp,j,i) + u(k-1,j,i) ) & 3372 + ( ibit17 * adv_mom_5 &3378 + ( ibit17 * adv_mom_5 & 3373 3379 ) * & 3374 3380 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & … … 3376 3382 3377 3383 diss_t(k) = - ABS( w_comp ) * ( & 3378 ( 10.0 * ibit17 * adv_mom_5 &3379 + 3.0 * ibit16 * adv_mom_3 &3380 + ibit15 * adv_mom_1 &3384 ( 10.0_wp * ibit17 * adv_mom_5 & 3385 + 3.0_wp * ibit16 * adv_mom_3 & 3386 + ibit15 * adv_mom_1 & 3381 3387 ) * & 3382 3388 ( u(k+1,j,i) - u(k,j,i) ) & 3383 - ( 5.0 * ibit17 * adv_mom_5 &3384 + ibit16 * adv_mom_3 &3389 - ( 5.0_wp * ibit17 * adv_mom_5 & 3390 + ibit16 * adv_mom_3 & 3385 3391 ) * & 3386 3392 ( u(k_pp,j,i) - u(k-1,j,i) ) & 3387 + ( ibit17 * adv_mom_5 &3393 + ( ibit17 * adv_mom_5 & 3388 3394 ) * & 3389 3395 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & … … 3397 3403 + ( w_comp - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) & 3398 3404 * ddzw(k) & 3399 ) * 0.5 3405 ) * 0.5_wp 3400 3406 3401 3407 tend(k,j,i) = tend(k,j,i) - ( & … … 3420 3426 sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 3421 3427 + ( flux_r(k) * & 3422 ( u_comp(k) - 2.0 * hom(k,1,1,0) ) &3428 ( u_comp(k) - 2.0_wp * hom(k,1,1,0) ) & 3423 3429 / ( u_comp(k) - gu + 1.0E-20_wp ) & 3424 3430 + diss_r(k) * & 3425 ABS( u_comp(k) - 2.0 * hom(k,1,1,0) ) &3431 ABS( u_comp(k) - 2.0_wp * hom(k,1,1,0) ) & 3426 3432 / ( ABS( u_comp(k) - gu ) + 1.0E-20_wp ) ) & 3427 3433 * weight_substep(intermediate_timestep_count) … … 3508 3514 3509 3515 3510 gu = 2.0 * u_gtrans3511 gv = 2.0 * v_gtrans3516 gu = 2.0_wp * u_gtrans 3517 gv = 2.0_wp * v_gtrans 3512 3518 3513 3519 ! … … 3524 3530 u_comp_l = u(k,j,i) + u(k,j,i-1) - gu 3525 3531 flux_l = u_comp_l * ( & 3526 ( 37.0 * ibit11 * adv_mom_5 &3527 + 7.0 * ibit10 * adv_mom_3 &3528 + ibit9 * adv_mom_1 &3532 ( 37.0_wp * ibit11 * adv_mom_5 & 3533 + 7.0_wp * ibit10 * adv_mom_3 & 3534 + ibit9 * adv_mom_1 & 3529 3535 ) * & 3530 3536 ( u(k,j,i) + u(k,j,i-1) ) & 3531 - ( 8.0 * ibit11 * adv_mom_5 &3532 + ibit10 * adv_mom_3 &3537 - ( 8.0_wp * ibit11 * adv_mom_5 & 3538 + ibit10 * adv_mom_3 & 3533 3539 ) * & 3534 3540 ( u(k,j,i+1) + u(k,j,i-2) ) & 3535 + ( ibit11 * adv_mom_5 &3541 + ( ibit11 * adv_mom_5 & 3536 3542 ) * & 3537 3543 ( u(k,j,i+2) + u(k,j,i-3) ) & … … 3539 3545 3540 3546 diss_l = - ABS( u_comp_l ) * ( & 3541 ( 10.0 * ibit11 * adv_mom_5 &3542 + 3.0 * ibit10 * adv_mom_3 &3543 + ibit9 * adv_mom_1 &3547 ( 10.0_wp * ibit11 * adv_mom_5 & 3548 + 3.0_wp * ibit10 * adv_mom_3 & 3549 + ibit9 * adv_mom_1 & 3544 3550 ) * & 3545 3551 ( u(k,j,i) - u(k,j,i-1) ) & 3546 - ( 5.0 * ibit11 * adv_mom_5 &3547 + ibit10 * adv_mom_3 &3552 - ( 5.0_wp * ibit11 * adv_mom_5 & 3553 + ibit10 * adv_mom_3 & 3548 3554 ) * & 3549 3555 ( u(k,j,i+1) - u(k,j,i-2) ) & 3550 + ( ibit11 * adv_mom_5 &3556 + ( ibit11 * adv_mom_5 & 3551 3557 ) * & 3552 3558 ( u(k,j,i+2) - u(k,j,i-3) ) & … … 3555 3561 u_comp = u(k,j,i+1) + u(k,j,i) 3556 3562 flux_r = ( u_comp - gu ) * ( & 3557 ( 37.0 * ibit11 * adv_mom_5 &3558 + 7.0 * ibit10 * adv_mom_3 &3559 + ibit9 * adv_mom_1 &3563 ( 37.0_wp * ibit11 * adv_mom_5 & 3564 + 7.0_wp * ibit10 * adv_mom_3 & 3565 + ibit9 * adv_mom_1 & 3560 3566 ) * & 3561 3567 ( u(k,j,i+1) + u(k,j,i) ) & 3562 - ( 8.0 * ibit11 * adv_mom_5 &3563 + ibit10 * adv_mom_3 &3568 - ( 8.0_wp * ibit11 * adv_mom_5 & 3569 + ibit10 * adv_mom_3 & 3564 3570 ) * & 3565 3571 ( u(k,j,i+2) + u(k,j,i-1) ) & 3566 + ( ibit11 * adv_mom_5 &3572 + ( ibit11 * adv_mom_5 & 3567 3573 ) * & 3568 3574 ( u(k,j,i+3) + u(k,j,i-2) ) & … … 3570 3576 3571 3577 diss_r = - ABS( u_comp - gu ) * ( & 3572 ( 10.0 * ibit11 * adv_mom_5 &3573 + 3.0 * ibit10 * adv_mom_3 &3574 + ibit9 * adv_mom_1 &3578 ( 10.0_wp * ibit11 * adv_mom_5 & 3579 + 3.0_wp * ibit10 * adv_mom_3 & 3580 + ibit9 * adv_mom_1 & 3575 3581 ) * & 3576 3582 ( u(k,j,i+1) - u(k,j,i) ) & 3577 - ( 5.0 * ibit11 * adv_mom_5 &3578 + ibit10 * adv_mom_3 &3583 - ( 5.0_wp * ibit11 * adv_mom_5 & 3584 + ibit10 * adv_mom_3 & 3579 3585 ) * & 3580 3586 ( u(k,j,i+2) - u(k,j,i-1) ) & 3581 + ( ibit11 * adv_mom_5 &3587 + ( ibit11 * adv_mom_5 & 3582 3588 ) * & 3583 3589 ( u(k,j,i+3) - u(k,j,i-2) ) & … … 3590 3596 v_comp_s = v(k,j,i) + v(k,j,i-1) - gv 3591 3597 flux_s = v_comp_s * ( & 3592 ( 37.0 * ibit14 * adv_mom_5 &3593 + 7.0 * ibit13 * adv_mom_3 &3594 + ibit12 * adv_mom_1 &3595 ) * &3598 ( 37.0_wp * ibit14 * adv_mom_5 & 3599 + 7.0_wp * ibit13 * adv_mom_3 & 3600 + ibit12 * adv_mom_1 & 3601 ) * & 3596 3602 ( u(k,j,i) + u(k,j-1,i) ) & 3597 - ( 8.0 * ibit14 * adv_mom_5 &3598 + ibit13 * adv_mom_3 &3603 - ( 8.0_wp * ibit14 * adv_mom_5 & 3604 + ibit13 * adv_mom_3 & 3599 3605 ) * & 3600 3606 ( u(k,j+1,i) + u(k,j-2,i) ) & 3601 + ( ibit14 * adv_mom_5 &3607 + ( ibit14 * adv_mom_5 & 3602 3608 ) * & 3603 3609 ( u(k,j+2,i) + u(k,j-3,i) ) & … … 3605 3611 3606 3612 diss_s = - ABS ( v_comp_s ) * ( & 3607 ( 10.0 * ibit14 * adv_mom_5 &3608 + 3.0 * ibit13 * adv_mom_3 &3609 + ibit12 * adv_mom_1 &3613 ( 10.0_wp * ibit14 * adv_mom_5 & 3614 + 3.0_wp * ibit13 * adv_mom_3 & 3615 + ibit12 * adv_mom_1 & 3610 3616 ) * & 3611 3617 ( u(k,j,i) - u(k,j-1,i) ) & 3612 - ( 5.0 * ibit14 * adv_mom_5 &3613 + ibit13 * adv_mom_3 &3618 - ( 5.0_wp * ibit14 * adv_mom_5 & 3619 + ibit13 * adv_mom_3 & 3614 3620 ) * & 3615 3621 ( u(k,j+1,i) - u(k,j-2,i) ) & 3616 + ( ibit14 * adv_mom_5 &3622 + ( ibit14 * adv_mom_5 & 3617 3623 ) * & 3618 3624 ( u(k,j+2,i) - u(k,j-3,i) ) & … … 3622 3628 v_comp = v(k,j+1,i) + v(k,j+1,i-1) - gv 3623 3629 flux_n = v_comp * ( & 3624 ( 37.0 * ibit14 * adv_mom_5 &3625 + 7.0 * ibit13 * adv_mom_3 &3626 + ibit12 * adv_mom_1 &3630 ( 37.0_wp * ibit14 * adv_mom_5 & 3631 + 7.0_wp * ibit13 * adv_mom_3 & 3632 + ibit12 * adv_mom_1 & 3627 3633 ) * & 3628 3634 ( u(k,j+1,i) + u(k,j,i) ) & 3629 - ( 8.0 * ibit14 * adv_mom_5 &3630 + ibit13 * adv_mom_3 &3635 - ( 8.0_wp * ibit14 * adv_mom_5 & 3636 + ibit13 * adv_mom_3 & 3631 3637 ) * & 3632 3638 ( u(k,j+2,i) + u(k,j-1,i) ) & 3633 + ( ibit14 * adv_mom_5 &3639 + ( ibit14 * adv_mom_5 & 3634 3640 ) * & 3635 3641 ( u(k,j+3,i) + u(k,j-2,i) ) & … … 3637 3643 3638 3644 diss_n = - ABS ( v_comp ) * ( & 3639 ( 10.0 * ibit14 * adv_mom_5 &3640 + 3.0 * ibit13 * adv_mom_3 &3641 + ibit12 * adv_mom_1 &3645 ( 10.0_wp * ibit14 * adv_mom_5 & 3646 + 3.0_wp * ibit13 * adv_mom_3 & 3647 + ibit12 * adv_mom_1 & 3642 3648 ) * & 3643 3649 ( u(k,j+1,i) - u(k,j,i) ) & 3644 - ( 5.0 * ibit14 * adv_mom_5 &3645 + ibit13 * adv_mom_3 &3650 - ( 5.0_wp * ibit14 * adv_mom_5 & 3651 + ibit13 * adv_mom_3 & 3646 3652 ) * & 3647 3653 ( u(k,j+2,i) - u(k,j-1,i) ) & 3648 + ( ibit14 * adv_mom_5 &3654 + ( ibit14 * adv_mom_5 & 3649 3655 ) * & 3650 3656 ( u(k,j+3,i) - u(k,j-2,i) ) & … … 3661 3667 w_comp = w(k-1,j,i) + w(k-1,j,i-1) 3662 3668 flux_d = w_comp * ( & 3663 ( 37.0 * ibit17 * adv_mom_5 &3664 + 7.0 * ibit16 * adv_mom_3 &3665 + ibit15 * adv_mom_1 &3669 ( 37.0_wp * ibit17 * adv_mom_5 & 3670 + 7.0_wp * ibit16 * adv_mom_3 & 3671 + ibit15 * adv_mom_1 & 3666 3672 ) * & 3667 3673 ( u(k,j,i) + u(k-1,j,i) ) & 3668 - ( 8.0 * ibit17 * adv_mom_5 &3669 + ibit16 * adv_mom_3 &3674 - ( 8.0_wp * ibit17 * adv_mom_5 & 3675 + ibit16 * adv_mom_3 & 3670 3676 ) * & 3671 3677 ( u(k+1,j,i) + u(k_mm,j,i) ) & 3672 + ( ibit17 * adv_mom_5 &3673 ) * &3678 + ( ibit17 * adv_mom_5 & 3679 ) * & 3674 3680 ( u(k_pp,j,i) + u(k_mmm,j,i) ) & 3675 3681 ) 3676 3682 3677 3683 diss_d = - ABS( w_comp ) * ( & 3678 ( 10.0 * ibit17 * adv_mom_5 &3679 + 3.0 * ibit16 * adv_mom_3 &3680 + ibit15 * adv_mom_1 &3684 ( 10.0_wp * ibit17 * adv_mom_5 & 3685 + 3.0_wp * ibit16 * adv_mom_3 & 3686 + ibit15 * adv_mom_1 & 3681 3687 ) * & 3682 3688 ( u(k,j,i) - u(k-1,j,i) ) & 3683 - ( 5.0 * ibit17 * adv_mom_5 &3684 + ibit16 * adv_mom_3 &3689 - ( 5.0_wp * ibit17 * adv_mom_5 & 3690 + ibit16 * adv_mom_3 & 3685 3691 ) * & 3686 3692 ( u(k+1,j,i) - u(k_mm,j,i) ) & 3687 + ( ibit17 * adv_mom_5 &3693 + ( ibit17 * adv_mom_5 & 3688 3694 ) * & 3689 3695 ( u(k_pp,j,i) - u(k_mmm,j,i) ) & … … 3702 3708 w_comp = w(k,j,i) + w(k,j,i-1) 3703 3709 flux_t = w_comp * ( & 3704 ( 37.0 * ibit17 * adv_mom_5 &3705 + 7.0 * ibit16 * adv_mom_3 &3706 + ibit15 * adv_mom_1 &3710 ( 37.0_wp * ibit17 * adv_mom_5 & 3711 + 7.0_wp * ibit16 * adv_mom_3 & 3712 + ibit15 * adv_mom_1 & 3707 3713 ) * & 3708 3714 ( u(k+1,j,i) + u(k,j,i) ) & 3709 - ( 8.0 * ibit17 * adv_mom_5 &3710 + ibit16 * adv_mom_3 &3715 - ( 8.0_wp * ibit17 * adv_mom_5 & 3716 + ibit16 * adv_mom_3 & 3711 3717 ) * & 3712 3718 ( u(k_pp,j,i) + u(k-1,j,i) ) & 3713 + ( ibit17 * adv_mom_5 &3719 + ( ibit17 * adv_mom_5 & 3714 3720 ) * & 3715 3721 ( u(k_ppp,j,i) + u(k_mm,j,i) ) & … … 3717 3723 3718 3724 diss_t = - ABS( w_comp ) * ( & 3719 ( 10.0 * ibit17 * adv_mom_5 &3720 + 3.0 * ibit16 * adv_mom_3 &3721 + ibit15 * adv_mom_1 &3725 ( 10.0_wp * ibit17 * adv_mom_5 & 3726 + 3.0_wp * ibit16 * adv_mom_3 & 3727 + ibit15 * adv_mom_1 & 3722 3728 ) * & 3723 3729 ( u(k+1,j,i) - u(k,j,i) ) & 3724 - ( 5.0 * ibit17 * adv_mom_5 &3725 + ibit16 * adv_mom_3 &3730 - ( 5.0_wp * ibit17 * adv_mom_5 & 3731 + ibit16 * adv_mom_3 & 3726 3732 ) * & 3727 3733 ( u(k_pp,j,i) - u(k-1,j,i) ) & 3728 + ( ibit17 * adv_mom_5 &3734 + ( ibit17 * adv_mom_5 & 3729 3735 ) * & 3730 3736 ( u(k_ppp,j,i) - u(k_mm,j,i) ) & … … 3738 3744 + ( w_comp - ( w(k-1,j,i) + w(k-1,j,i-1) ) ) & 3739 3745 * ddzw(k) & 3740 ) * 0.5 3746 ) * 0.5_wp 3741 3747 3742 3748 tend(k,j,i) = - ( & … … 3751 3757 ! sums_us2_ws_l(k,tn) = sums_us2_ws_l(k,tn) & 3752 3758 ! + ( flux_r * & 3753 ! ( u_comp - 2.0 * hom(k,1,1,0) ) &3759 ! ( u_comp - 2.0_wp * hom(k,1,1,0) ) & 3754 3760 ! / ( u_comp - gu + 1.0E-20_wp ) & 3755 3761 ! + diss_r * & 3756 ! ABS( u_comp - 2.0 * hom(k,1,1,0) ) &3762 ! ABS( u_comp - 2.0_wp * hom(k,1,1,0) ) & 3757 3763 ! / ( ABS( u_comp - gu ) + 1.0E-20_wp ) ) & 3758 3764 ! * weight_substep(intermediate_timestep_count) … … 3840 3846 REAL(wp), DIMENSION(nzb:nzt) :: v_comp !: 3841 3847 3842 gu = 2.0 * u_gtrans3843 gv = 2.0 * v_gtrans3848 gu = 2.0_wp * u_gtrans 3849 gv = 2.0_wp * v_gtrans 3844 3850 ! 3845 3851 !-- First compute the whole left boundary of the processor domain … … 3854 3860 u_comp = u(k,j-1,i) + u(k,j,i) - gu 3855 3861 swap_flux_x_local_v(k,j) = u_comp * ( & 3856 ( 37.0 * ibit20 * adv_mom_5 &3857 + 7.0 * ibit19 * adv_mom_3 &3858 + ibit18 * adv_mom_1 &3862 ( 37.0_wp * ibit20 * adv_mom_5 & 3863 + 7.0_wp * ibit19 * adv_mom_3 & 3864 + ibit18 * adv_mom_1 & 3859 3865 ) * & 3860 3866 ( v(k,j,i) + v(k,j,i-1) ) & 3861 - ( 8.0 * ibit20 * adv_mom_5 &3862 + ibit19 * adv_mom_3 &3867 - ( 8.0_wp * ibit20 * adv_mom_5 & 3868 + ibit19 * adv_mom_3 & 3863 3869 ) * & 3864 3870 ( v(k,j,i+1) + v(k,j,i-2) ) & 3865 + ( ibit20 * adv_mom_5 &3871 + ( ibit20 * adv_mom_5 & 3866 3872 ) * & 3867 3873 ( v(k,j,i+2) + v(k,j,i-3) ) & … … 3869 3875 3870 3876 swap_diss_x_local_v(k,j) = - ABS( u_comp ) * ( & 3871 ( 10.0 * ibit20 * adv_mom_5 &3872 + 3.0 * ibit19 * adv_mom_3 &3873 + ibit18 * adv_mom_1 &3877 ( 10.0_wp * ibit20 * adv_mom_5 & 3878 + 3.0_wp * ibit19 * adv_mom_3 & 3879 + ibit18 * adv_mom_1 & 3874 3880 ) * & 3875 3881 ( v(k,j,i) - v(k,j,i-1) ) & 3876 - ( 5.0 * ibit20 * adv_mom_5 &3877 + ibit19 * adv_mom_3 &3882 - ( 5.0_wp * ibit20 * adv_mom_5 & 3883 + ibit19 * adv_mom_3 & 3878 3884 ) * & 3879 3885 ( v(k,j,i+1) - v(k,j,i-2) ) & 3880 + ( ibit20 * adv_mom_5 &3886 + ( ibit20 * adv_mom_5 & 3881 3887 ) * & 3882 3888 ( v(k,j,i+2) - v(k,j,i-3) ) & … … 3889 3895 u_comp = u(k,j-1,i) + u(k,j,i) - gu 3890 3896 swap_flux_x_local_v(k,j) = u_comp * ( & 3891 37.0 * ( v(k,j,i) + v(k,j,i-1) ) &3892 - 8.0 * ( v(k,j,i+1) + v(k,j,i-2) ) &3893 + ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_53897 37.0_wp * ( v(k,j,i) + v(k,j,i-1) ) & 3898 - 8.0_wp * ( v(k,j,i+1) + v(k,j,i-2) ) & 3899 + ( v(k,j,i+2) + v(k,j,i-3) ) ) * adv_mom_5 3894 3900 swap_diss_x_local_v(k,j) = - ABS( u_comp ) * ( & 3895 10.0 * ( v(k,j,i) - v(k,j,i-1) ) &3896 - 5.0 * ( v(k,j,i+1) - v(k,j,i-2) ) &3897 + ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_53901 10.0_wp * ( v(k,j,i) - v(k,j,i-1) ) & 3902 - 5.0_wp * ( v(k,j,i+1) - v(k,j,i-2) ) & 3903 + ( v(k,j,i+2) - v(k,j,i-3) ) ) * adv_mom_5 3898 3904 3899 3905 ENDDO … … 3912 3918 v_comp(k) = v(k,j,i) + v(k,j-1,i) - gv 3913 3919 swap_flux_y_local_v(k) = v_comp(k) * ( & 3914 ( 37.0 * ibit23 * adv_mom_5 &3915 + 7.0 * ibit22 * adv_mom_3 &3916 + ibit21 * adv_mom_1 &3920 ( 37.0_wp * ibit23 * adv_mom_5 & 3921 + 7.0_wp * ibit22 * adv_mom_3 & 3922 + ibit21 * adv_mom_1 & 3917 3923 ) * & 3918 3924 ( v(k,j,i) + v(k,j-1,i) ) & 3919 - ( 8.0 * ibit23 * adv_mom_5 &3920 + ibit22 * adv_mom_3 &3925 - ( 8.0_wp * ibit23 * adv_mom_5 & 3926 + ibit22 * adv_mom_3 & 3921 3927 ) * & 3922 3928 ( v(k,j+1,i) + v(k,j-2,i) ) & 3923 + ( ibit23 * adv_mom_5 &3929 + ( ibit23 * adv_mom_5 & 3924 3930 ) * & 3925 3931 ( v(k,j+2,i) + v(k,j-3,i) ) & … … 3927 3933 3928 3934 swap_diss_y_local_v(k) = - ABS( v_comp(k) ) * ( & 3929 ( 10.0 * ibit23 * adv_mom_5 &3930 + 3.0 * ibit22 * adv_mom_3 &3931 + ibit21 * adv_mom_1 &3935 ( 10.0_wp * ibit23 * adv_mom_5 & 3936 + 3.0_wp * ibit22 * adv_mom_3 & 3937 + ibit21 * adv_mom_1 & 3932 3938 ) * & 3933 3939 ( v(k,j,i) - v(k,j-1,i) ) & 3934 - ( 5.0 * ibit23 * adv_mom_5 &3935 + ibit22 * adv_mom_3 &3940 - ( 5.0_wp * ibit23 * adv_mom_5 & 3941 + ibit22 * adv_mom_3 & 3936 3942 ) * & 3937 3943 ( v(k,j+1,i) - v(k,j-2,i) ) & 3938 + ( ibit23 * adv_mom_5 &3944 + ( ibit23 * adv_mom_5 & 3939 3945 ) * & 3940 3946 ( v(k,j+2,i) - v(k,j-3,i) ) & … … 3947 3953 v_comp(k) = v(k,j,i) + v(k,j-1,i) - gv 3948 3954 swap_flux_y_local_v(k) = v_comp(k) * ( & 3949 37.0 * ( v(k,j,i) + v(k,j-1,i) ) &3950 - 8.0 * ( v(k,j+1,i) + v(k,j-2,i) ) &3951 + ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_53955 37.0_wp * ( v(k,j,i) + v(k,j-1,i) ) & 3956 - 8.0_wp * ( v(k,j+1,i) + v(k,j-2,i) ) & 3957 + ( v(k,j+2,i) + v(k,j-3,i) ) ) * adv_mom_5 3952 3958 swap_diss_y_local_v(k) = - ABS( v_comp(k) ) * ( & 3953 10.0 * ( v(k,j,i) - v(k,j-1,i) ) &3954 - 5.0 * ( v(k,j+1,i) - v(k,j-2,i) ) &3955 + ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_53959 10.0_wp * ( v(k,j,i) - v(k,j-1,i) ) & 3960 - 5.0_wp * ( v(k,j+1,i) - v(k,j-2,i) ) & 3961 + ( v(k,j+2,i) - v(k,j-3,i) ) ) * adv_mom_5 3956 3962 3957 3963 ENDDO … … 3959 3965 DO j = nysv, nyn 3960 3966 3961 flux_t(0) = 0.0 3962 diss_t(0) = 0.0 3963 flux_d = 0.0 3964 diss_d = 0.0 3967 flux_t(0) = 0.0_wp 3968 diss_t(0) = 0.0_wp 3969 flux_d = 0.0_wp 3970 diss_d = 0.0_wp 3965 3971 3966 3972 DO k = nzb+1, nzb_max … … 3972 3978 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 3973 3979 flux_r(k) = u_comp * ( & 3974 ( 37.0 * ibit20 * adv_mom_5 &3975 + 7.0 * ibit19 * adv_mom_3 &3976 + ibit18 * adv_mom_1 &3980 ( 37.0_wp * ibit20 * adv_mom_5 & 3981 + 7.0_wp * ibit19 * adv_mom_3 & 3982 + ibit18 * adv_mom_1 & 3977 3983 ) * & 3978 3984 ( v(k,j,i+1) + v(k,j,i) ) & 3979 - ( 8.0 * ibit20 * adv_mom_5 &3980 + ibit19 * adv_mom_3 &3985 - ( 8.0_wp * ibit20 * adv_mom_5 & 3986 + ibit19 * adv_mom_3 & 3981 3987 ) * & 3982 3988 ( v(k,j,i+2) + v(k,j,i-1) ) & 3983 + ( ibit20 * adv_mom_5 &3989 + ( ibit20 * adv_mom_5 & 3984 3990 ) * & 3985 3991 ( v(k,j,i+3) + v(k,j,i-2) ) & … … 3987 3993 3988 3994 diss_r(k) = - ABS( u_comp ) * ( & 3989 ( 10.0 * ibit20 * adv_mom_5 &3990 + 3.0 * ibit19 * adv_mom_3 &3991 + ibit18 * adv_mom_1 &3995 ( 10.0_wp * ibit20 * adv_mom_5 & 3996 + 3.0_wp * ibit19 * adv_mom_3 & 3997 + ibit18 * adv_mom_1 & 3992 3998 ) * & 3993 3999 ( v(k,j,i+1) - v(k,j,i) ) & 3994 - ( 5.0 * ibit20 * adv_mom_5 &3995 + ibit19 * adv_mom_3 &4000 - ( 5.0_wp * ibit20 * adv_mom_5 & 4001 + ibit19 * adv_mom_3 & 3996 4002 ) * & 3997 4003 ( v(k,j,i+2) - v(k,j,i-1) ) & 3998 + ( ibit20 * adv_mom_5 &4004 + ( ibit20 * adv_mom_5 & 3999 4005 ) * & 4000 4006 ( v(k,j,i+3) - v(k,j,i-2) ) & … … 4007 4013 v_comp(k) = v(k,j+1,i) + v(k,j,i) 4008 4014 flux_n(k) = ( v_comp(k) - gv ) * ( & 4009 ( 37.0 * ibit23 * adv_mom_5 &4010 + 7.0 * ibit22 * adv_mom_3 &4011 + ibit21 * adv_mom_1 &4015 ( 37.0_wp * ibit23 * adv_mom_5 & 4016 + 7.0_wp * ibit22 * adv_mom_3 & 4017 + ibit21 * adv_mom_1 & 4012 4018 ) * & 4013 4019 ( v(k,j+1,i) + v(k,j,i) ) & 4014 - ( 8.0 * ibit23 * adv_mom_5 &4015 + ibit22 * adv_mom_3 &4020 - ( 8.0_wp * ibit23 * adv_mom_5 & 4021 + ibit22 * adv_mom_3 & 4016 4022 ) * & 4017 4023 ( v(k,j+2,i) + v(k,j-1,i) ) & 4018 + ( ibit23 * adv_mom_5 &4024 + ( ibit23 * adv_mom_5 & 4019 4025 ) * & 4020 4026 ( v(k,j+3,i) + v(k,j-2,i) ) & … … 4022 4028 4023 4029 diss_n(k) = - ABS( v_comp(k) - gv ) * ( & 4024 ( 10.0 * ibit23 * adv_mom_5 &4025 + 3.0 * ibit22 * adv_mom_3 &4026 + ibit21 * adv_mom_1 &4030 ( 10.0_wp * ibit23 * adv_mom_5 & 4031 + 3.0_wp * ibit22 * adv_mom_3 & 4032 + ibit21 * adv_mom_1 & 4027 4033 ) * & 4028 4034 ( v(k,j+1,i) - v(k,j,i) ) & 4029 - ( 5.0 * ibit23 * adv_mom_5 &4030 + ibit22 * adv_mom_3 &4035 - ( 5.0_wp * ibit23 * adv_mom_5 & 4036 + ibit22 * adv_mom_3 & 4031 4037 ) * & 4032 4038 ( v(k,j+2,i) - v(k,j-1,i) ) & 4033 + ( ibit23 * adv_mom_5 &4039 + ( ibit23 * adv_mom_5 & 4034 4040 ) * & 4035 4041 ( v(k,j+3,i) - v(k,j-2,i) ) & … … 4048 4054 w_comp = w(k,j-1,i) + w(k,j,i) 4049 4055 flux_t(k) = w_comp * ( & 4050 ( 37.0 * ibit26 * adv_mom_5 &4051 + 7.0 * ibit25 * adv_mom_3 &4052 + ibit24 * adv_mom_1 &4056 ( 37.0_wp * ibit26 * adv_mom_5 & 4057 + 7.0_wp * ibit25 * adv_mom_3 & 4058 + ibit24 * adv_mom_1 & 4053 4059 ) * & 4054 4060 ( v(k+1,j,i) + v(k,j,i) ) & 4055 - ( 8.0 * ibit26 * adv_mom_5 &4056 + ibit25 * adv_mom_3 &4061 - ( 8.0_wp * ibit26 * adv_mom_5 & 4062 + ibit25 * adv_mom_3 & 4057 4063 ) * & 4058 4064 ( v(k_pp,j,i) + v(k-1,j,i) ) & 4059 + ( ibit26 * adv_mom_5 &4065 + ( ibit26 * adv_mom_5 & 4060 4066 ) * & 4061 4067 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & … … 4063 4069 4064 4070 diss_t(k) = - ABS( w_comp ) * ( & 4065 ( 10.0 * ibit26 * adv_mom_5 &4066 + 3.0 * ibit25 * adv_mom_3 &4067 + ibit24 * adv_mom_1 &4071 ( 10.0_wp * ibit26 * adv_mom_5 & 4072 + 3.0_wp * ibit25 * adv_mom_3 & 4073 + ibit24 * adv_mom_1 & 4068 4074 ) * & 4069 4075 ( v(k+1,j,i) - v(k,j,i) ) & 4070 - ( 5.0 * ibit26 * adv_mom_5 &4071 + ibit25 * adv_mom_3 &4076 - ( 5.0_wp * ibit26 * adv_mom_5 & 4077 + ibit25 * adv_mom_3 & 4072 4078 ) * & 4073 4079 ( v(k_pp,j,i) - v(k-1,j,i) ) & 4074 + ( ibit26 * adv_mom_5 &4080 + ( ibit26 * adv_mom_5 & 4075 4081 ) * & 4076 4082 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & … … 4084 4090 + ( w_comp - ( w(k-1,j-1,i) + w(k-1,j,i) ) & 4085 4091 ) * ddzw(k) & 4086 ) * 0.5 4092 ) * 0.5_wp 4087 4093 4088 4094 tend(k,j,i) = tend(k,j,i) - ( & … … 4110 4116 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 4111 4117 + ( flux_n(k) & 4112 * ( v_comp(k) - 2.0 * hom(k,1,2,0) ) &4118 * ( v_comp(k) - 2.0_wp * hom(k,1,2,0) ) & 4113 4119 / ( v_comp(k) - gv + 1.0E-20_wp ) & 4114 4120 + diss_n(k) & 4115 * ABS( v_comp(k) - 2.0 * hom(k,1,2,0) ) &4121 * ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) ) & 4116 4122 / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) ) & 4117 4123 * weight_substep(intermediate_timestep_count) … … 4128 4134 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 4129 4135 flux_r(k) = u_comp * ( & 4130 37.0 * ( v(k,j,i+1) + v(k,j,i) ) &4131 - 8.0 * ( v(k,j,i+2) + v(k,j,i-1) ) &4132 + ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_54136 37.0_wp * ( v(k,j,i+1) + v(k,j,i) ) & 4137 - 8.0_wp * ( v(k,j,i+2) + v(k,j,i-1) ) & 4138 + ( v(k,j,i+3) + v(k,j,i-2) ) ) * adv_mom_5 4133 4139 4134 4140 diss_r(k) = - ABS( u_comp ) * ( & 4135 10.0 * ( v(k,j,i+1) - v(k,j,i) ) &4136 - 5.0 * ( v(k,j,i+2) - v(k,j,i-1) ) &4137 + ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_54141 10.0_wp * ( v(k,j,i+1) - v(k,j,i) ) & 4142 - 5.0_wp * ( v(k,j,i+2) - v(k,j,i-1) ) & 4143 + ( v(k,j,i+3) - v(k,j,i-2) ) ) * adv_mom_5 4138 4144 4139 4145 4140 4146 v_comp(k) = v(k,j+1,i) + v(k,j,i) 4141 4147 flux_n(k) = ( v_comp(k) - gv ) * ( & 4142 37.0 * ( v(k,j+1,i) + v(k,j,i) ) &4143 - 8.0 * ( v(k,j+2,i) + v(k,j-1,i) ) &4144 + ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_54148 37.0_wp * ( v(k,j+1,i) + v(k,j,i) ) & 4149 - 8.0_wp * ( v(k,j+2,i) + v(k,j-1,i) ) & 4150 + ( v(k,j+3,i) + v(k,j-2,i) ) ) * adv_mom_5 4145 4151 4146 4152 diss_n(k) = - ABS( v_comp(k) - gv ) * ( & 4147 10.0 * ( v(k,j+1,i) - v(k,j,i) ) &4148 - 5.0 * ( v(k,j+2,i) - v(k,j-1,i) ) &4149 + ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_54153 10.0_wp * ( v(k,j+1,i) - v(k,j,i) ) & 4154 - 5.0_wp * ( v(k,j+2,i) - v(k,j-1,i) ) & 4155 + ( v(k,j+3,i) - v(k,j-2,i) ) ) * adv_mom_5 4150 4156 ! 4151 4157 !-- k index has to be modified near bottom and top, else array … … 4161 4167 w_comp = w(k,j-1,i) + w(k,j,i) 4162 4168 flux_t(k) = w_comp * ( & 4163 ( 37.0 * ibit26 * adv_mom_5 &4164 + 7.0 * ibit25 * adv_mom_3 &4165 + ibit24 * adv_mom_1 &4169 ( 37.0_wp * ibit26 * adv_mom_5 & 4170 + 7.0_wp * ibit25 * adv_mom_3 & 4171 + ibit24 * adv_mom_1 & 4166 4172 ) * & 4167 4173 ( v(k+1,j,i) + v(k,j,i) ) & 4168 - ( 8.0 * ibit26 * adv_mom_5 &4169 + ibit25 * adv_mom_3 &4174 - ( 8.0_wp * ibit26 * adv_mom_5 & 4175 + ibit25 * adv_mom_3 & 4170 4176 ) * & 4171 4177 ( v(k_pp,j,i) + v(k-1,j,i) ) & 4172 + ( ibit26 * adv_mom_5 &4178 + ( ibit26 * adv_mom_5 & 4173 4179 ) * & 4174 4180 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & … … 4176 4182 4177 4183 diss_t(k) = - ABS( w_comp ) * ( & 4178 ( 10.0 * ibit26 * adv_mom_5 &4179 + 3.0 * ibit25 * adv_mom_3 &4180 + ibit24 * adv_mom_1 &4184 ( 10.0_wp * ibit26 * adv_mom_5 & 4185 + 3.0_wp * ibit25 * adv_mom_3 & 4186 + ibit24 * adv_mom_1 & 4181 4187 ) * & 4182 4188 ( v(k+1,j,i) - v(k,j,i) ) & 4183 - ( 5.0 * ibit26 * adv_mom_5 &4184 + ibit25 * adv_mom_3 &4189 - ( 5.0_wp * ibit26 * adv_mom_5 & 4190 + ibit25 * adv_mom_3 & 4185 4191 ) * & 4186 4192 ( v(k_pp,j,i) - v(k-1,j,i) ) & 4187 + ( ibit26 * adv_mom_5 &4193 + ( ibit26 * adv_mom_5 & 4188 4194 ) * & 4189 4195 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & … … 4197 4203 + ( w_comp - ( w(k-1,j-1,i) + w(k-1,j,i) ) ) & 4198 4204 * ddzw(k) & 4199 ) * 0.5 4205 ) * 0.5_wp 4200 4206 4201 4207 tend(k,j,i) = tend(k,j,i) - ( & … … 4223 4229 sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 4224 4230 + ( flux_n(k) & 4225 * ( v_comp(k) - 2.0 * hom(k,1,2,0) ) &4231 * ( v_comp(k) - 2.0_wp * hom(k,1,2,0) ) & 4226 4232 / ( v_comp(k) - gv + 1.0E-20_wp ) & 4227 4233 + diss_n(k) & 4228 * ABS( v_comp(k) - 2.0 * hom(k,1,2,0) ) &4234 * ABS( v_comp(k) - 2.0_wp * hom(k,1,2,0) ) & 4229 4235 / ( ABS( v_comp(k) - gv ) +1.0E-20_wp ) ) & 4230 4236 * weight_substep(intermediate_timestep_count) … … 4312 4318 REAL(wp) :: w_comp !: 4313 4319 4314 gu = 2.0 * u_gtrans4315 gv = 2.0 * v_gtrans4320 gu = 2.0_wp * u_gtrans 4321 gv = 2.0_wp * v_gtrans 4316 4322 4317 4323 ! … … 4328 4334 u_comp_l = u(k,j-1,i) + u(k,j,i) - gu 4329 4335 flux_l = u_comp_l * ( & 4330 ( 37.0 * ibit20 * adv_mom_5 &4331 + 7.0 * ibit19 * adv_mom_3 &4332 + ibit18 * adv_mom_1 &4336 ( 37.0_wp * ibit20 * adv_mom_5 & 4337 + 7.0_wp * ibit19 * adv_mom_3 & 4338 + ibit18 * adv_mom_1 & 4333 4339 ) * & 4334 4340 ( v(k,j,i) + v(k,j,i-1) ) & 4335 - ( 8.0 * ibit20 * adv_mom_5 &4336 + ibit19 * adv_mom_3 &4341 - ( 8.0_wp * ibit20 * adv_mom_5 & 4342 + ibit19 * adv_mom_3 & 4337 4343 ) * & 4338 4344 ( v(k,j,i+1) + v(k,j,i-2) ) & 4339 + ( ibit20 * adv_mom_5 &4345 + ( ibit20 * adv_mom_5 & 4340 4346 ) * & 4341 4347 ( v(k,j,i+2) + v(k,j,i-3) ) & … … 4343 4349 4344 4350 diss_l = - ABS( u_comp_l ) * ( & 4345 ( 10.0 * ibit20 * adv_mom_5 &4346 + 3.0 * ibit19 * adv_mom_3 &4347 + ibit18 * adv_mom_1 &4351 ( 10.0_wp * ibit20 * adv_mom_5 & 4352 + 3.0_wp * ibit19 * adv_mom_3 & 4353 + ibit18 * adv_mom_1 & 4348 4354 ) * & 4349 4355 ( v(k,j,i) - v(k,j,i-1) ) & 4350 - ( 5.0 * ibit20 * adv_mom_5 &4351 + ibit19 * adv_mom_3 &4356 - ( 5.0_wp * ibit20 * adv_mom_5 & 4357 + ibit19 * adv_mom_3 & 4352 4358 ) * & 4353 4359 ( v(k,j,i+1) - v(k,j,i-2) ) & 4354 + ( ibit20 * adv_mom_5 &4360 + ( ibit20 * adv_mom_5 & 4355 4361 ) * & 4356 4362 ( v(k,j,i+2) - v(k,j,i-3) ) & … … 4359 4365 u_comp = u(k,j-1,i+1) + u(k,j,i+1) - gu 4360 4366 flux_r = u_comp * ( & 4361 ( 37.0 * ibit20 * adv_mom_5 &4362 + 7.0 * ibit19 * adv_mom_3 &4363 + ibit18 * adv_mom_1 &4367 ( 37.0_wp * ibit20 * adv_mom_5 & 4368 + 7.0_wp * ibit19 * adv_mom_3 & 4369 + ibit18 * adv_mom_1 & 4364 4370 ) * & 4365 4371 ( v(k,j,i+1) + v(k,j,i) ) & 4366 - ( 8.0 * ibit20 * adv_mom_5 &4367 + ibit19 * adv_mom_3 &4372 - ( 8.0_wp * ibit20 * adv_mom_5 & 4373 + ibit19 * adv_mom_3 & 4368 4374 ) * & 4369 4375 ( v(k,j,i+2) + v(k,j,i-1) ) & 4370 + ( ibit20 * adv_mom_5 &4376 + ( ibit20 * adv_mom_5 & 4371 4377 ) * & 4372 4378 ( v(k,j,i+3) + v(k,j,i-2) ) & … … 4374 4380 4375 4381 diss_r = - ABS( u_comp ) * ( & 4376 ( 10.0 * ibit20 * adv_mom_5 &4377 + 3.0 * ibit19 * adv_mom_3 &4378 + ibit18 * adv_mom_1 &4382 ( 10.0_wp * ibit20 * adv_mom_5 & 4383 + 3.0_wp * ibit19 * adv_mom_3 & 4384 + ibit18 * adv_mom_1 & 4379 4385 ) * & 4380 4386 ( v(k,j,i+1) - v(k,j,i) ) & 4381 - ( 5.0 * ibit20 * adv_mom_5 &4382 + ibit19 * adv_mom_3 &4387 - ( 5.0_wp * ibit20 * adv_mom_5 & 4388 + ibit19 * adv_mom_3 & 4383 4389 ) * & 4384 4390 ( v(k,j,i+2) - v(k,j,i-1) ) & 4385 + ( ibit20 * adv_mom_5 &4391 + ( ibit20 * adv_mom_5 & 4386 4392 ) * & 4387 4393 ( v(k,j,i+3) - v(k,j,i-2) ) & … … 4395 4401 v_comp_s = v(k,j,i) + v(k,j-1,i) - gv 4396 4402 flux_s = v_comp_s * ( & 4397 ( 37.0 * ibit23 * adv_mom_5 &4398 + 7.0 * ibit22 * adv_mom_3 &4399 + ibit21 * adv_mom_1 &4403 ( 37.0_wp * ibit23 * adv_mom_5 & 4404 + 7.0_wp * ibit22 * adv_mom_3 & 4405 + ibit21 * adv_mom_1 & 4400 4406 ) * & 4401 4407 ( v(k,j,i) + v(k,j-1,i) ) & 4402 - ( 8.0 * ibit23 * adv_mom_5 &4403 + ibit22 * adv_mom_3 &4408 - ( 8.0_wp * ibit23 * adv_mom_5 & 4409 + ibit22 * adv_mom_3 & 4404 4410 ) * & 4405 4411 ( v(k,j+1,i) + v(k,j-2,i) ) & 4406 + ( ibit23 * adv_mom_5 &4412 + ( ibit23 * adv_mom_5 & 4407 4413 ) * & 4408 4414 ( v(k,j+2,i) + v(k,j-3,i) ) & … … 4410 4416 4411 4417 diss_s = - ABS( v_comp_s ) * ( & 4412 ( 10.0 * ibit23 * adv_mom_5 &4413 + 3.0 * ibit22 * adv_mom_3 &4414 + ibit21 * adv_mom_1 &4418 ( 10.0_wp * ibit23 * adv_mom_5 & 4419 + 3.0_wp * ibit22 * adv_mom_3 & 4420 + ibit21 * adv_mom_1 & 4415 4421 ) * & 4416 4422 ( v(k,j,i) - v(k,j-1,i) ) & 4417 - ( 5.0 * ibit23 * adv_mom_5 &4418 + ibit22 * adv_mom_3 &4423 - ( 5.0_wp * ibit23 * adv_mom_5 & 4424 + ibit22 * adv_mom_3 & 4419 4425 ) * & 4420 4426 ( v(k,j+1,i) - v(k,j-2,i) ) & 4421 + ( ibit23 * adv_mom_5 &4427 + ( ibit23 * adv_mom_5 & 4422 4428 ) * & 4423 4429 ( v(k,j+2,i) - v(k,j-3,i) ) & … … 4426 4432 v_comp = v(k,j+1,i) + v(k,j,i) 4427 4433 flux_n = ( v_comp - gv ) * ( & 4428 ( 37.0 * ibit23 * adv_mom_5 &4429 + 7.0 * ibit22 * adv_mom_3 &4430 + ibit21 * adv_mom_1 &4434 ( 37.0_wp * ibit23 * adv_mom_5 & 4435 + 7.0_wp * ibit22 * adv_mom_3 & 4436 + ibit21 * adv_mom_1 & 4431 4437 ) * & 4432 4438 ( v(k,j+1,i) + v(k,j,i) ) & 4433 - ( 8.0 * ibit23 * adv_mom_5 &4434 + ibit22 * adv_mom_3 &4439 - ( 8.0_wp * ibit23 * adv_mom_5 & 4440 + ibit22 * adv_mom_3 & 4435 4441 ) * & 4436 4442 ( v(k,j+2,i) + v(k,j-1,i) ) & 4437 + ( ibit23 * adv_mom_5 &4443 + ( ibit23 * adv_mom_5 & 4438 4444 ) * & 4439 4445 ( v(k,j+3,i) + v(k,j-2,i) ) & … … 4441 4447 4442 4448 diss_n = - ABS( v_comp - gv ) * ( & 4443 ( 10.0 * ibit23 * adv_mom_5 &4444 + 3.0 * ibit22 * adv_mom_3 &4445 + ibit21 * adv_mom_1 &4449 ( 10.0_wp * ibit23 * adv_mom_5 & 4450 + 3.0_wp * ibit22 * adv_mom_3 & 4451 + ibit21 * adv_mom_1 & 4446 4452 ) * & 4447 4453 ( v(k,j+1,i) - v(k,j,i) ) & 4448 - ( 5.0 * ibit23 * adv_mom_5 &4449 + ibit22 * adv_mom_3 &4454 - ( 5.0_wp * ibit23 * adv_mom_5 & 4455 + ibit22 * adv_mom_3 & 4450 4456 ) * & 4451 4457 ( v(k,j+2,i) - v(k,j-1,i) ) & 4452 + ( ibit23 * adv_mom_5 &4458 + ( ibit23 * adv_mom_5 & 4453 4459 ) * & 4454 4460 ( v(k,j+3,i) - v(k,j-2,i) ) & … … 4465 4471 w_comp = w(k-1,j-1,i) + w(k-1,j,i) 4466 4472 flux_d = w_comp * ( & 4467 ( 37.0 * ibit26 * adv_mom_5 &4468 + 7.0 * ibit25 * adv_mom_3 &4469 + ibit24 * adv_mom_1 &4473 ( 37.0_wp * ibit26 * adv_mom_5 & 4474 + 7.0_wp * ibit25 * adv_mom_3 & 4475 + ibit24 * adv_mom_1 & 4470 4476 ) * & 4471 4477 ( v(k,j,i) + v(k-1,j,i) ) & 4472 - ( 8.0 * ibit26 * adv_mom_5 &4473 + ibit25 * adv_mom_3 &4478 - ( 8.0_wp * ibit26 * adv_mom_5 & 4479 + ibit25 * adv_mom_3 & 4474 4480 ) * & 4475 4481 ( v(k+1,j,i) + v(k_mm,j,i) ) & 4476 + ( ibit26 * adv_mom_5 &4482 + ( ibit26 * adv_mom_5 & 4477 4483 ) * & 4478 4484 ( v(k_pp,j,i) + v(k_mmm,j,i) ) & … … 4480 4486 4481 4487 diss_d = - ABS( w_comp ) * ( & 4482 ( 10.0 * ibit26 * adv_mom_5 &4483 + 3.0 * ibit25 * adv_mom_3 &4484 + ibit24 * adv_mom_1 &4488 ( 10.0_wp * ibit26 * adv_mom_5 & 4489 + 3.0_wp * ibit25 * adv_mom_3 & 4490 + ibit24 * adv_mom_1 & 4485 4491 ) * & 4486 4492 ( v(k,j,i) - v(k-1,j,i) ) & 4487 - ( 5.0 * ibit26 * adv_mom_5 &4488 + ibit25 * adv_mom_3 &4493 - ( 5.0_wp * ibit26 * adv_mom_5 & 4494 + ibit25 * adv_mom_3 & 4489 4495 ) * & 4490 4496 ( v(k+1,j,i) - v(k_mm,j,i) ) & 4491 + ( ibit26 * adv_mom_5 &4497 + ( ibit26 * adv_mom_5 & 4492 4498 ) * & 4493 4499 ( v(k_pp,j,i) - v(k_mmm,j,i) ) & … … 4506 4512 w_comp = w(k,j-1,i) + w(k,j,i) 4507 4513 flux_t = w_comp * ( & 4508 ( 37.0 * ibit26 * adv_mom_5 &4509 + 7.0 * ibit25 * adv_mom_3 &4510 + ibit24 * adv_mom_1 &4514 ( 37.0_wp * ibit26 * adv_mom_5 & 4515 + 7.0_wp * ibit25 * adv_mom_3 & 4516 + ibit24 * adv_mom_1 & 4511 4517 ) * & 4512 4518 ( v(k+1,j,i) + v(k,j,i) ) & 4513 - ( 8.0 * ibit26 * adv_mom_5 &4514 + ibit25 * adv_mom_3 &4519 - ( 8.0_wp * ibit26 * adv_mom_5 & 4520 + ibit25 * adv_mom_3 & 4515 4521 ) * & 4516 4522 ( v(k_pp,j,i) + v(k-1,j,i) ) & 4517 + ( ibit26 * adv_mom_5 &4523 + ( ibit26 * adv_mom_5 & 4518 4524 ) * & 4519 4525 ( v(k_ppp,j,i) + v(k_mm,j,i) ) & … … 4521 4527 4522 4528 diss_t = - ABS( w_comp ) * ( & 4523 ( 10.0 * ibit26 * adv_mom_5 &4524 + 3.0 * ibit25 * adv_mom_3 &4525 + ibit24 * adv_mom_1 &4529 ( 10.0_wp * ibit26 * adv_mom_5 & 4530 + 3.0_wp * ibit25 * adv_mom_3 & 4531 + ibit24 * adv_mom_1 & 4526 4532 ) * & 4527 4533 ( v(k+1,j,i) - v(k,j,i) ) & 4528 - ( 5.0 * ibit26 * adv_mom_5 &4529 + ibit25 * adv_mom_3 &4534 - ( 5.0_wp * ibit26 * adv_mom_5 & 4535 + ibit25 * adv_mom_3 & 4530 4536 ) * & 4531 4537 ( v(k_pp,j,i) - v(k-1,j,i) ) & 4532 + ( ibit26 * adv_mom_5 &4538 + ( ibit26 * adv_mom_5 & 4533 4539 ) * & 4534 4540 ( v(k_ppp,j,i) - v(k_mm,j,i) ) & … … 4542 4548 + ( w_comp - ( w(k-1,j-1,i) + w(k-1,j,i) ) & 4543 4549 ) * ddzw(k) & 4544 ) * 0.5 4550 ) * 0.5_wp 4545 4551 4546 4552 tend(k,j,i) = - ( & … … 4556 4562 ! sums_vs2_ws_l(k,tn) = sums_vs2_ws_l(k,tn) & 4557 4563 ! + ( flux_n & 4558 ! * ( v_comp - 2.0 * hom(k,1,2,0) ) &4564 ! * ( v_comp - 2.0_wp * hom(k,1,2,0) ) & 4559 4565 ! / ( v_comp - gv + 1.0E-20_wp ) & 4560 4566 ! + diss_n & 4561 ! * ABS( v_comp - 2.0 * hom(k,1,2,0) ) &4567 ! * ABS( v_comp - 2.0_wp * hom(k,1,2,0) ) & 4562 4568 ! / ( ABS( v_comp - gv ) +1.0E-20_wp ) ) & 4563 4569 ! * weight_substep(intermediate_timestep_count) … … 4646 4652 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) :: swap_flux_x_local_w !: 4647 4653 4648 gu = 2.0 * u_gtrans4649 gv = 2.0 * v_gtrans4654 gu = 2.0_wp * u_gtrans 4655 gv = 2.0_wp * v_gtrans 4650 4656 ! 4651 4657 !-- compute the whole left boundary of the processor domain … … 4660 4666 u_comp = u(k+1,j,i) + u(k,j,i) - gu 4661 4667 swap_flux_x_local_w(k,j) = u_comp * ( & 4662 ( 37.0 * ibit29 * adv_mom_5 &4663 + 7.0 * ibit28 * adv_mom_3 &4664 + ibit27 * adv_mom_1 &4668 ( 37.0_wp * ibit29 * adv_mom_5 & 4669 + 7.0_wp * ibit28 * adv_mom_3 & 4670 + ibit27 * adv_mom_1 & 4665 4671 ) * & 4666 4672 ( w(k,j,i) + w(k,j,i-1) ) & 4667 - ( 8.0 * ibit29 * adv_mom_5 &4668 + ibit28 * adv_mom_3 &4673 - ( 8.0_wp * ibit29 * adv_mom_5 & 4674 + ibit28 * adv_mom_3 & 4669 4675 ) * & 4670 4676 ( w(k,j,i+1) + w(k,j,i-2) ) & 4671 + ( ibit29 * adv_mom_5 &4677 + ( ibit29 * adv_mom_5 & 4672 4678 ) * & 4673 4679 ( w(k,j,i+2) + w(k,j,i-3) ) & … … 4675 4681 4676 4682 swap_diss_x_local_w(k,j) = - ABS( u_comp ) * ( & 4677 ( 10.0 * ibit29 * adv_mom_5 &4678 + 3.0 * ibit28 * adv_mom_3 &4679 + ibit27 * adv_mom_1 &4683 ( 10.0_wp * ibit29 * adv_mom_5 & 4684 + 3.0_wp * ibit28 * adv_mom_3 & 4685 + ibit27 * adv_mom_1 & 4680 4686 ) * & 4681 4687 ( w(k,j,i) - w(k,j,i-1) ) & 4682 - ( 5.0 * ibit29 * adv_mom_5 &4683 + ibit28 * adv_mom_3 &4688 - ( 5.0_wp * ibit29 * adv_mom_5 & 4689 + ibit28 * adv_mom_3 & 4684 4690 ) * & 4685 4691 ( w(k,j,i+1) - w(k,j,i-2) ) & 4686 + ( ibit29 * adv_mom_5 &4692 + ( ibit29 * adv_mom_5 & 4687 4693 ) * & 4688 4694 ( w(k,j,i+2) - w(k,j,i-3) ) & … … 4695 4701 u_comp = u(k+1,j,i) + u(k,j,i) - gu 4696 4702 swap_flux_x_local_w(k,j) = u_comp * ( & 4697 37.0 * ( w(k,j,i) + w(k,j,i-1) ) &4698 - 8.0 * ( w(k,j,i+1) + w(k,j,i-2) ) &4699 + ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_54703 37.0_wp * ( w(k,j,i) + w(k,j,i-1) ) & 4704 - 8.0_wp * ( w(k,j,i+1) + w(k,j,i-2) ) & 4705 + ( w(k,j,i+2) + w(k,j,i-3) ) ) * adv_mom_5 4700 4706 swap_diss_x_local_w(k,j) = - ABS( u_comp ) * ( & 4701 10.0 * ( w(k,j,i) - w(k,j,i-1) ) &4702 - 5.0 * ( w(k,j,i+1) - w(k,j,i-2) ) &4703 + ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_54707 10.0_wp * ( w(k,j,i) - w(k,j,i-1) ) & 4708 - 5.0_wp * ( w(k,j,i+1) - w(k,j,i-2) ) & 4709 + ( w(k,j,i+2) - w(k,j,i-3) ) ) * adv_mom_5 4704 4710 4705 4711 ENDDO … … 4718 4724 v_comp = v(k+1,j,i) + v(k,j,i) - gv 4719 4725 swap_flux_y_local_w(k) = v_comp * ( & 4720 ( 37.0 * ibit32 * adv_mom_5 &4721 + 7.0 * ibit31 * adv_mom_3 &4722 + ibit30 * adv_mom_1 &4723 ) * &4726 ( 37.0_wp * ibit32 * adv_mom_5 & 4727 + 7.0_wp * ibit31 * adv_mom_3 & 4728 + ibit30 * adv_mom_1 & 4729 ) * & 4724 4730 ( w(k,j,i) + w(k,j-1,i) ) & 4725 - ( 8.0 * ibit32 * adv_mom_5 &4726 + ibit31 * adv_mom_3 &4731 - ( 8.0_wp * ibit32 * adv_mom_5 & 4732 + ibit31 * adv_mom_3 & 4727 4733 ) * & 4728 4734 ( w(k,j+1,i) + w(k,j-2,i) ) & 4729 + ( ibit32 * adv_mom_5 &4735 + ( ibit32 * adv_mom_5 & 4730 4736 ) * & 4731 4737 ( w(k,j+2,i) + w(k,j-3,i) ) & … … 4733 4739 4734 4740 swap_diss_y_local_w(k) = - ABS( v_comp ) * ( & 4735 ( 10.0 * ibit32 * adv_mom_5 &4736 + 3.0 * ibit31 * adv_mom_3 &4737 + ibit30 * adv_mom_1 &4741 ( 10.0_wp * ibit32 * adv_mom_5 & 4742 + 3.0_wp * ibit31 * adv_mom_3 & 4743 + ibit30 * adv_mom_1 & 4738 4744 ) * & 4739 4745 ( w(k,j,i) - w(k,j-1,i) ) & 4740 - ( 5.0 * ibit32 * adv_mom_5 &4741 + ibit31 * adv_mom_3 &4746 - ( 5.0_wp * ibit32 * adv_mom_5 & 4747 + ibit31 * adv_mom_3 & 4742 4748 ) * & 4743 4749 ( w(k,j+1,i) - w(k,j-2,i) ) & 4744 + ( ibit32 * adv_mom_5 &4750 + ( ibit32 * adv_mom_5 & 4745 4751 ) * & 4746 4752 ( w(k,j+2,i) - w(k,j-3,i) ) & … … 4753 4759 v_comp = v(k+1,j,i) + v(k,j,i) - gv 4754 4760 swap_flux_y_local_w(k) = v_comp * ( & 4755 37.0 * ( w(k,j,i) + w(k,j-1,i) ) &4756 - 8.0 * ( w(k,j+1,i) +w(k,j-2,i) ) &4757 + ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_54761 37.0_wp * ( w(k,j,i) + w(k,j-1,i) ) & 4762 - 8.0_wp * ( w(k,j+1,i) +w(k,j-2,i) ) & 4763 + ( w(k,j+2,i) + w(k,j-3,i) ) ) * adv_mom_5 4758 4764 swap_diss_y_local_w(k) = - ABS( v_comp ) * ( & 4759 10.0 * ( w(k,j,i) - w(k,j-1,i) ) &4760 - 5.0 * ( w(k,j+1,i) - w(k,j-2,i) ) &4761 + ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_54765 10.0_wp * ( w(k,j,i) - w(k,j-1,i) ) & 4766 - 5.0_wp * ( w(k,j+1,i) - w(k,j-2,i) ) & 4767 + ( w(k,j+2,i) - w(k,j-3,i) ) ) * adv_mom_5 4762 4768 4763 4769 ENDDO … … 4784 4790 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 4785 4791 flux_r(k) = u_comp * ( & 4786 ( 37.0 * ibit29 * adv_mom_5 &4787 + 7.0 * ibit28 * adv_mom_3 &4788 + ibit27 * adv_mom_1 &4792 ( 37.0_wp * ibit29 * adv_mom_5 & 4793 + 7.0_wp * ibit28 * adv_mom_3 & 4794 + ibit27 * adv_mom_1 & 4789 4795 ) * & 4790 4796 ( w(k,j,i+1) + w(k,j,i) ) & 4791 - ( 8.0 * ibit29 * adv_mom_5 &4792 + ibit28 * adv_mom_3 &4797 - ( 8.0_wp * ibit29 * adv_mom_5 & 4798 + ibit28 * adv_mom_3 & 4793 4799 ) * & 4794 4800 ( w(k,j,i+2) + w(k,j,i-1) ) & 4795 + ( ibit29 * adv_mom_5 &4801 + ( ibit29 * adv_mom_5 & 4796 4802 ) * & 4797 4803 ( w(k,j,i+3) + w(k,j,i-2) ) & … … 4799 4805 4800 4806 diss_r(k) = - ABS( u_comp ) * ( & 4801 ( 10.0 * ibit29 * adv_mom_5 &4802 + 3.0 * ibit28 * adv_mom_3 &4803 + ibit27 * adv_mom_1 &4807 ( 10.0_wp * ibit29 * adv_mom_5 & 4808 + 3.0_wp * ibit28 * adv_mom_3 & 4809 + ibit27 * adv_mom_1 & 4804 4810 ) * & 4805 4811 ( w(k,j,i+1) - w(k,j,i) ) & 4806 - ( 5.0 * ibit29 * adv_mom_5 &4807 + ibit28 * adv_mom_3 &4812 - ( 5.0_wp * ibit29 * adv_mom_5 & 4813 + ibit28 * adv_mom_3 & 4808 4814 ) * & 4809 4815 ( w(k,j,i+2) - w(k,j,i-1) ) & 4810 + ( ibit29 * adv_mom_5 &4816 + ( ibit29 * adv_mom_5 & 4811 4817 ) * & 4812 4818 ( w(k,j,i+3) - w(k,j,i-2) ) & … … 4819 4825 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 4820 4826 flux_n(k) = v_comp * ( & 4821 ( 37.0 * ibit32 * adv_mom_5 &4822 + 7.0 * ibit31 * adv_mom_3 &4823 + ibit30 * adv_mom_1 &4827 ( 37.0_wp * ibit32 * adv_mom_5 & 4828 + 7.0_wp * ibit31 * adv_mom_3 & 4829 + ibit30 * adv_mom_1 & 4824 4830 ) * & 4825 4831 ( w(k,j+1,i) + w(k,j,i) ) & 4826 - ( 8.0 * ibit32 * adv_mom_5 &4827 + ibit31 * adv_mom_3 &4828 ) * &4832 - ( 8.0_wp * ibit32 * adv_mom_5 & 4833 + ibit31 * adv_mom_3 & 4834 ) * & 4829 4835 ( w(k,j+2,i) + w(k,j-1,i) ) & 4830 + ( ibit32 * adv_mom_5 &4836 + ( ibit32 * adv_mom_5 & 4831 4837 ) * & 4832 4838 ( w(k,j+3,i) + w(k,j-2,i) ) & … … 4834 4840 4835 4841 diss_n(k) = - ABS( v_comp ) * ( & 4836 ( 10.0 * ibit32 * adv_mom_5 &4837 + 3.0 * ibit31 * adv_mom_3 &4838 + ibit30 * adv_mom_1 &4842 ( 10.0_wp * ibit32 * adv_mom_5 & 4843 + 3.0_wp * ibit31 * adv_mom_3 & 4844 + ibit30 * adv_mom_1 & 4839 4845 ) * & 4840 4846 ( w(k,j+1,i) - w(k,j,i) ) & 4841 - ( 5.0 * ibit32 * adv_mom_5 &4842 + ibit31 * adv_mom_3 &4847 - ( 5.0_wp * ibit32 * adv_mom_5 & 4848 + ibit31 * adv_mom_3 & 4843 4849 ) * & 4844 4850 ( w(k,j+2,i) - w(k,j-1,i) ) & 4845 + ( ibit32 * adv_mom_5 &4851 + ( ibit32 * adv_mom_5 & 4846 4852 ) * & 4847 4853 ( w(k,j+3,i) - w(k,j-2,i) ) & … … 4860 4866 w_comp = w(k+1,j,i) + w(k,j,i) 4861 4867 flux_t(k) = w_comp * ( & 4862 ( 37.0 * ibit35 * adv_mom_5 &4863 + 7.0 * ibit34 * adv_mom_3 &4864 + ibit33 * adv_mom_1 &4868 ( 37.0_wp * ibit35 * adv_mom_5 & 4869 + 7.0_wp * ibit34 * adv_mom_3 & 4870 + ibit33 * adv_mom_1 & 4865 4871 ) * & 4866 4872 ( w(k+1,j,i) + w(k,j,i) ) & 4867 - ( 8.0 * ibit35 * adv_mom_5 &4868 + ibit34 * adv_mom_3 &4873 - ( 8.0_wp * ibit35 * adv_mom_5 & 4874 + ibit34 * adv_mom_3 & 4869 4875 ) * & 4870 4876 ( w(k_pp,j,i) + w(k-1,j,i) ) & 4871 + ( ibit35 * adv_mom_5 &4877 + ( ibit35 * adv_mom_5 & 4872 4878 ) * & 4873 4879 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & … … 4875 4881 4876 4882 diss_t(k) = - ABS( w_comp ) * ( & 4877 ( 10.0 * ibit35 * adv_mom_5 &4878 + 3.0 * ibit34 * adv_mom_3 &4879 + ibit33 * adv_mom_1 &4883 ( 10.0_wp * ibit35 * adv_mom_5 & 4884 + 3.0_wp * ibit34 * adv_mom_3 & 4885 + ibit33 * adv_mom_1 & 4880 4886 ) * & 4881 4887 ( w(k+1,j,i) - w(k,j,i) ) & 4882 - ( 5.0 * ibit35 * adv_mom_5 &4883 + ibit34 * adv_mom_3 &4888 - ( 5.0_wp * ibit35 * adv_mom_5 & 4889 + ibit34 * adv_mom_3 & 4884 4890 ) * & 4885 4891 ( w(k_pp,j,i) - w(k-1,j,i) ) & 4886 + ( ibit35 * adv_mom_5 &4892 + ( ibit35 * adv_mom_5 & 4887 4893 ) * & 4888 4894 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & … … 4896 4902 + ( w_comp - ( w(k,j,i) + w(k-1,j,i) ) ) & 4897 4903 * ddzu(k+1) & 4898 ) * 0.5 4904 ) * 0.5_wp 4899 4905 4900 4906 tend(k,j,i) = tend(k,j,i) - ( & … … 4927 4933 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 4928 4934 flux_r(k) = u_comp * ( & 4929 37.0 * ( w(k,j,i+1) + w(k,j,i) ) &4930 - 8.0 * ( w(k,j,i+2) + w(k,j,i-1) ) &4931 + ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_54935 37.0_wp * ( w(k,j,i+1) + w(k,j,i) ) & 4936 - 8.0_wp * ( w(k,j,i+2) + w(k,j,i-1) ) & 4937 + ( w(k,j,i+3) + w(k,j,i-2) ) ) * adv_mom_5 4932 4938 4933 4939 diss_r(k) = - ABS( u_comp ) * ( & 4934 10.0 * ( w(k,j,i+1) - w(k,j,i) ) &4935 - 5.0 * ( w(k,j,i+2) - w(k,j,i-1) ) &4936 + ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_54940 10.0_wp * ( w(k,j,i+1) - w(k,j,i) ) & 4941 - 5.0_wp * ( w(k,j,i+2) - w(k,j,i-1) ) & 4942 + ( w(k,j,i+3) - w(k,j,i-2) ) ) * adv_mom_5 4937 4943 4938 4944 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 4939 4945 flux_n(k) = v_comp * ( & 4940 37.0 * ( w(k,j+1,i) + w(k,j,i) ) &4941 - 8.0 * ( w(k,j+2,i) + w(k,j-1,i) ) &4942 + ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_54946 37.0_wp * ( w(k,j+1,i) + w(k,j,i) ) & 4947 - 8.0_wp * ( w(k,j+2,i) + w(k,j-1,i) ) & 4948 + ( w(k,j+3,i) + w(k,j-2,i) ) ) * adv_mom_5 4943 4949 4944 4950 diss_n(k) = - ABS( v_comp ) * ( & 4945 10.0 * ( w(k,j+1,i) - w(k,j,i) ) &4946 - 5.0 * ( w(k,j+2,i) - w(k,j-1,i) ) &4947 + ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_54951 10.0_wp * ( w(k,j+1,i) - w(k,j,i) ) & 4952 - 5.0_wp * ( w(k,j+2,i) - w(k,j-1,i) ) & 4953 + ( w(k,j+3,i) - w(k,j-2,i) ) ) * adv_mom_5 4948 4954 ! 4949 4955 !-- k index has to be modified near bottom and top, else array … … 4959 4965 w_comp = w(k+1,j,i) + w(k,j,i) 4960 4966 flux_t(k) = w_comp * ( & 4961 ( 37.0 * ibit35 * adv_mom_5 &4962 + 7.0 * ibit34 * adv_mom_3 &4963 + ibit33 * adv_mom_1 &4967 ( 37.0_wp * ibit35 * adv_mom_5 & 4968 + 7.0_wp * ibit34 * adv_mom_3 & 4969 + ibit33 * adv_mom_1 & 4964 4970 ) * & 4965 4971 ( w(k+1,j,i) + w(k,j,i) ) & 4966 - ( 8.0 * ibit35 * adv_mom_5 &4967 + ibit34 * adv_mom_3 &4972 - ( 8.0_wp * ibit35 * adv_mom_5 & 4973 + ibit34 * adv_mom_3 & 4968 4974 ) * & 4969 4975 ( w(k_pp,j,i) + w(k-1,j,i) ) & 4970 + ( ibit35 * adv_mom_5 &4976 + ( ibit35 * adv_mom_5 & 4971 4977 ) * & 4972 4978 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & … … 4974 4980 4975 4981 diss_t(k) = - ABS( w_comp ) * ( & 4976 ( 10.0 * ibit35 * adv_mom_5 &4977 + 3.0 * ibit34 * adv_mom_3 &4978 + ibit33 * adv_mom_1 &4982 ( 10.0_wp * ibit35 * adv_mom_5 & 4983 + 3.0_wp * ibit34 * adv_mom_3 & 4984 + ibit33 * adv_mom_1 & 4979 4985 ) * & 4980 4986 ( w(k+1,j,i) - w(k,j,i) ) & 4981 - ( 5.0 * ibit35 * adv_mom_5 &4982 + ibit34 * adv_mom_3 &4987 - ( 5.0_wp * ibit35 * adv_mom_5 & 4988 + ibit34 * adv_mom_3 & 4983 4989 ) * & 4984 4990 ( w(k_pp,j,i) - w(k-1,j,i) ) & 4985 + ( ibit35 * adv_mom_5 &4991 + ( ibit35 * adv_mom_5 & 4986 4992 ) * & 4987 4993 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & … … 4995 5001 + ( w_comp - ( w(k,j,i) + w(k-1,j,i) ) ) & 4996 5002 * ddzu(k+1) & 4997 ) * 0.5 5003 ) * 0.5_wp 4998 5004 4999 5005 tend(k,j,i) = tend(k,j,i) - ( & … … 5094 5100 REAL(wp) :: w_comp !: 5095 5101 5096 gu = 2.0 * u_gtrans5097 gv = 2.0 * v_gtrans5102 gu = 2.0_wp * u_gtrans 5103 gv = 2.0_wp * v_gtrans 5098 5104 5099 5105 … … 5111 5117 u_comp_l = u(k+1,j,i) + u(k,j,i) - gu 5112 5118 flux_l = u_comp_l * ( & 5113 ( 37.0 * ibit29 * adv_mom_5 &5114 + 7.0 * ibit28 * adv_mom_3 &5115 + ibit27 * adv_mom_1 &5119 ( 37.0_wp * ibit29 * adv_mom_5 & 5120 + 7.0_wp * ibit28 * adv_mom_3 & 5121 + ibit27 * adv_mom_1 & 5116 5122 ) * & 5117 5123 ( w(k,j,i) + w(k,j,i-1) ) & 5118 - ( 8.0 * ibit29 * adv_mom_5 &5119 + ibit28 * adv_mom_3 &5124 - ( 8.0_wp * ibit29 * adv_mom_5 & 5125 + ibit28 * adv_mom_3 & 5120 5126 ) * & 5121 5127 ( w(k,j,i+1) + w(k,j,i-2) ) & 5122 + ( ibit29 * adv_mom_5 &5128 + ( ibit29 * adv_mom_5 & 5123 5129 ) * & 5124 5130 ( w(k,j,i+2) + w(k,j,i-3) ) & … … 5126 5132 5127 5133 diss_l = - ABS( u_comp_l ) * ( & 5128 ( 10.0 * ibit29 * adv_mom_5 &5129 + 3.0 * ibit28 * adv_mom_3 &5130 + ibit27 * adv_mom_1 &5134 ( 10.0_wp * ibit29 * adv_mom_5 & 5135 + 3.0_wp * ibit28 * adv_mom_3 & 5136 + ibit27 * adv_mom_1 & 5131 5137 ) * & 5132 5138 ( w(k,j,i) - w(k,j,i-1) ) & 5133 - ( 5.0 * ibit29 * adv_mom_5 &5134 + ibit28 * adv_mom_3 &5139 - ( 5.0_wp * ibit29 * adv_mom_5 & 5140 + ibit28 * adv_mom_3 & 5135 5141 ) * & 5136 5142 ( w(k,j,i+1) - w(k,j,i-2) ) & 5137 + ( ibit29 * adv_mom_5 &5143 + ( ibit29 * adv_mom_5 & 5138 5144 ) * & 5139 5145 ( w(k,j,i+2) - w(k,j,i-3) ) & … … 5142 5148 u_comp = u(k+1,j,i+1) + u(k,j,i+1) - gu 5143 5149 flux_r = u_comp * ( & 5144 ( 37.0 * ibit29 * adv_mom_5 &5145 + 7.0 * ibit28 * adv_mom_3 &5146 + ibit27 * adv_mom_1 &5150 ( 37.0_wp * ibit29 * adv_mom_5 & 5151 + 7.0_wp * ibit28 * adv_mom_3 & 5152 + ibit27 * adv_mom_1 & 5147 5153 ) * & 5148 5154 ( w(k,j,i+1) + w(k,j,i) ) & 5149 - ( 8.0 * ibit29 * adv_mom_5 &5150 + ibit28 * adv_mom_3 &5155 - ( 8.0_wp * ibit29 * adv_mom_5 & 5156 + ibit28 * adv_mom_3 & 5151 5157 ) * & 5152 5158 ( w(k,j,i+2) + w(k,j,i-1) ) & 5153 + ( ibit29 * adv_mom_5 &5159 + ( ibit29 * adv_mom_5 & 5154 5160 ) * & 5155 5161 ( w(k,j,i+3) + w(k,j,i-2) ) & … … 5157 5163 5158 5164 diss_r = - ABS( u_comp ) * ( & 5159 ( 10.0 * ibit29 * adv_mom_5 &5160 + 3.0 * ibit28 * adv_mom_3 &5161 + ibit27 * adv_mom_1 &5165 ( 10.0_wp * ibit29 * adv_mom_5 & 5166 + 3.0_wp * ibit28 * adv_mom_3 & 5167 + ibit27 * adv_mom_1 & 5162 5168 ) * & 5163 5169 ( w(k,j,i+1) - w(k,j,i) ) & 5164 - ( 5.0 * ibit29 * adv_mom_5 &5165 + ibit28 * adv_mom_3 &5170 - ( 5.0_wp * ibit29 * adv_mom_5 & 5171 + ibit28 * adv_mom_3 & 5166 5172 ) * & 5167 5173 ( w(k,j,i+2) - w(k,j,i-1) ) & 5168 + ( ibit29 * adv_mom_5 &5174 + ( ibit29 * adv_mom_5 & 5169 5175 ) * & 5170 5176 ( w(k,j,i+3) - w(k,j,i-2) ) & … … 5176 5182 v_comp_s = v(k+1,j,i) + v(k,j,i) - gv 5177 5183 flux_s = v_comp_s * ( & 5178 ( 37.0 * ibit32 * adv_mom_5 &5179 + 7.0 * ibit31 * adv_mom_3 &5180 + ibit30 * adv_mom_1 &5184 ( 37.0_wp * ibit32 * adv_mom_5 & 5185 + 7.0_wp * ibit31 * adv_mom_3 & 5186 + ibit30 * adv_mom_1 & 5181 5187 ) * & 5182 5188 ( w(k,j,i) + w(k,j-1,i) ) & 5183 - ( 8.0 * ibit32 * adv_mom_5 &5184 + ibit31 * adv_mom_3 &5189 - ( 8.0_wp * ibit32 * adv_mom_5 & 5190 + ibit31 * adv_mom_3 & 5185 5191 ) * & 5186 5192 ( w(k,j+1,i) + w(k,j-2,i) ) & 5187 + ( ibit32 * adv_mom_5 &5193 + ( ibit32 * adv_mom_5 & 5188 5194 ) * & 5189 5195 ( w(k,j+2,i) + w(k,j-3,i) ) & … … 5191 5197 5192 5198 diss_s = - ABS( v_comp_s ) * ( & 5193 ( 10.0 * ibit32 * adv_mom_5 &5194 + 3.0 * ibit31 * adv_mom_3 &5195 + ibit30 * adv_mom_1 &5199 ( 10.0_wp * ibit32 * adv_mom_5 & 5200 + 3.0_wp * ibit31 * adv_mom_3 & 5201 + ibit30 * adv_mom_1 & 5196 5202 ) * & 5197 5203 ( w(k,j,i) - w(k,j-1,i) ) & 5198 - ( 5.0 * ibit32 * adv_mom_5 &5199 + ibit31 * adv_mom_3 &5204 - ( 5.0_wp * ibit32 * adv_mom_5 & 5205 + ibit31 * adv_mom_3 & 5200 5206 ) * & 5201 5207 ( w(k,j+1,i) - w(k,j-2,i) ) & 5202 + ( ibit32 * adv_mom_5 &5208 + ( ibit32 * adv_mom_5 & 5203 5209 ) * & 5204 5210 ( w(k,j+2,i) - w(k,j-3,i) ) & … … 5207 5213 v_comp = v(k+1,j+1,i) + v(k,j+1,i) - gv 5208 5214 flux_n = v_comp * ( & 5209 ( 37.0 * ibit32 * adv_mom_5 &5210 + 7.0 * ibit31 * adv_mom_3 &5211 + ibit30 * adv_mom_1 &5212 ) * &5215 ( 37.0_wp * ibit32 * adv_mom_5 & 5216 + 7.0_wp * ibit31 * adv_mom_3 & 5217 + ibit30 * adv_mom_1 & 5218 ) * & 5213 5219 ( w(k,j+1,i) + w(k,j,i) ) & 5214 - ( 8.0 * ibit32 * adv_mom_5 &5215 + ibit31 * adv_mom_3 &5220 - ( 8.0_wp * ibit32 * adv_mom_5 & 5221 + ibit31 * adv_mom_3 & 5216 5222 ) * & 5217 5223 ( w(k,j+2,i) + w(k,j-1,i) ) & 5218 + ( ibit32 * adv_mom_5 &5224 + ( ibit32 * adv_mom_5 & 5219 5225 ) * & 5220 5226 ( w(k,j+3,i) + w(k,j-2,i) ) & … … 5222 5228 5223 5229 diss_n = - ABS( v_comp ) * ( & 5224 ( 10.0 * ibit32 * adv_mom_5 &5225 + 3.0 * ibit31 * adv_mom_3 &5226 + ibit30 * adv_mom_1 &5230 ( 10.0_wp * ibit32 * adv_mom_5 & 5231 + 3.0_wp * ibit31 * adv_mom_3 & 5232 + ibit30 * adv_mom_1 & 5227 5233 ) * & 5228 5234 ( w(k,j+1,i) - w(k,j,i) ) & 5229 - ( 5.0 * ibit32 * adv_mom_5 &5230 + ibit31 * adv_mom_3 &5235 - ( 5.0_wp * ibit32 * adv_mom_5 & 5236 + ibit31 * adv_mom_3 & 5231 5237 ) * & 5232 5238 ( w(k,j+2,i) - w(k,j-1,i) ) & 5233 + ( ibit32 * adv_mom_5 &5239 + ( ibit32 * adv_mom_5 & 5234 5240 ) * & 5235 5241 ( w(k,j+3,i) - w(k,j-2,i) ) & … … 5246 5252 w_comp = w(k,j,i) + w(k-1,j,i) 5247 5253 flux_d = w_comp * ( & 5248 ( 37.0 * ibit35 * adv_mom_5 &5249 + 7.0 * ibit34 * adv_mom_3 &5250 + ibit33 * adv_mom_1 &5254 ( 37.0_wp * ibit35 * adv_mom_5 & 5255 + 7.0_wp * ibit34 * adv_mom_3 & 5256 + ibit33 * adv_mom_1 & 5251 5257 ) * & 5252 5258 ( w(k,j,i) + w(k-1,j,i) ) & 5253 - ( 8.0 * ibit35 * adv_mom_5 &5254 + ibit34 * adv_mom_3 &5259 - ( 8.0_wp * ibit35 * adv_mom_5 & 5260 + ibit34 * adv_mom_3 & 5255 5261 ) * & 5256 5262 ( w(k+1,j,i) + w(k_mm,j,i) ) & 5257 + ( ibit35 * adv_mom_5 &5263 + ( ibit35 * adv_mom_5 & 5258 5264 ) * & 5259 5265 ( w(k_pp,j,i) + w(k_mmm,j,i) ) & … … 5261 5267 5262 5268 diss_d = - ABS( w_comp ) * ( & 5263 ( 10.0 * ibit35 * adv_mom_5 &5264 + 3.0 * ibit34 * adv_mom_3 &5265 + ibit33 * adv_mom_1 &5269 ( 10.0_wp * ibit35 * adv_mom_5 & 5270 + 3.0_wp * ibit34 * adv_mom_3 & 5271 + ibit33 * adv_mom_1 & 5266 5272 ) * & 5267 5273 ( w(k,j,i) - w(k-1,j,i) ) & 5268 - ( 5.0 * ibit35 * adv_mom_5 &5269 + ibit34 * adv_mom_3 &5274 - ( 5.0_wp * ibit35 * adv_mom_5 & 5275 + ibit34 * adv_mom_3 & 5270 5276 ) * & 5271 5277 ( w(k+1,j,i) - w(k_mm,j,i) ) & 5272 + ( ibit35 * adv_mom_5 &5278 + ( ibit35 * adv_mom_5 & 5273 5279 ) * & 5274 5280 ( w(k_pp,j,i) - w(k_mmm,j,i) ) & … … 5288 5294 w_comp = w(k+1,j,i) + w(k,j,i) 5289 5295 flux_t = w_comp * ( & 5290 ( 37.0 * ibit35 * adv_mom_5 &5291 + 7.0 * ibit34 * adv_mom_3 &5292 + ibit33 * adv_mom_1 &5296 ( 37.0_wp * ibit35 * adv_mom_5 & 5297 + 7.0_wp * ibit34 * adv_mom_3 & 5298 + ibit33 * adv_mom_1 & 5293 5299 ) * & 5294 5300 ( w(k+1,j,i) + w(k,j,i) ) & 5295 - ( 8.0 * ibit35 * adv_mom_5 &5296 + ibit34 * adv_mom_3 &5301 - ( 8.0_wp * ibit35 * adv_mom_5 & 5302 + ibit34 * adv_mom_3 & 5297 5303 ) * & 5298 5304 ( w(k_pp,j,i) + w(k-1,j,i) ) & 5299 + ( ibit35 * adv_mom_5 &5305 + ( ibit35 * adv_mom_5 & 5300 5306 ) * & 5301 5307 ( w(k_ppp,j,i) + w(k_mm,j,i) ) & … … 5303 5309 5304 5310 diss_t = - ABS( w_comp ) * ( & 5305 ( 10.0 * ibit35 * adv_mom_5 &5306 + 3.0 * ibit34 * adv_mom_3 &5307 + ibit33 * adv_mom_1 &5311 ( 10.0_wp * ibit35 * adv_mom_5 & 5312 + 3.0_wp * ibit34 * adv_mom_3 & 5313 + ibit33 * adv_mom_1 & 5308 5314 ) * & 5309 5315 ( w(k+1,j,i) - w(k,j,i) ) & 5310 - ( 5.0 * ibit35 * adv_mom_5 &5311 + ibit34 * adv_mom_3 &5316 - ( 5.0_wp * ibit35 * adv_mom_5 & 5317 + ibit34 * adv_mom_3 & 5312 5318 ) * & 5313 5319 ( w(k_pp,j,i) - w(k-1,j,i) ) & 5314 + ( ibit35 * adv_mom_5 &5320 + ( ibit35 * adv_mom_5 & 5315 5321 ) * & 5316 5322 ( w(k_ppp,j,i) - w(k_mm,j,i) ) & … … 5324 5330 + ( w_comp - ( w(k,j,i) + w(k-1,j,i) ) ) & 5325 5331 * ddzu(k+1) & 5326 ) * 0.5 5332 ) * 0.5_wp 5327 5333 5328 5334 tend(k,j,i) = - ( &
Note: See TracChangeset
for help on using the changeset viewer.
