Changeset 1001 for palm/trunk/SOURCE/prognostic_equations.f90
- Timestamp:
- Sep 13, 2012 2:08:46 PM (12 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/prognostic_equations.f90 (modified) (79 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/prognostic_equations.f90
r979 r1001 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! all actions concerning leapfrog- and upstream-spline-scheme removed 7 7 ! 8 8 ! Former revisions: … … 163 163 CHARACTER (LEN=9) :: time_to_string 164 164 INTEGER :: i, i_omp_start, j, k, tn = 0 165 REAL :: s at, sbt165 REAL :: sbt 166 166 167 167 ! … … 178 178 CALL cpu_log( log_point(5), 'u-equation', 'start' ) 179 179 180 !181 !-- u-tendency terms with communication182 IF ( momentum_advec == 'ups-scheme' ) THEN183 tend = 0.0184 CALL advec_u_ups185 ENDIF186 187 !188 !-- u-tendency terms with no communication189 180 i_omp_start = nxlu 190 181 DO i = nxlu, nxr … … 192 183 ! 193 184 !-- Tendency terms 194 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN195 tend(:,j,i) = 0.0185 tend(:,j,i) = 0.0 186 IF ( timestep_scheme(1:5) == 'runge' ) THEN 196 187 IF ( ws_scheme_mom ) THEN 197 188 CALL advec_u_ws( i, j, i_omp_start, tn ) … … 199 190 CALL advec_u_pw( i, j ) 200 191 ENDIF 201 202 192 ELSE 203 IF ( momentum_advec /= 'ups-scheme' ) THEN 204 tend(:,j,i) = 0.0 205 CALL advec_u_up( i, j ) 206 ENDIF 207 ENDIF 208 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 209 CALL diffusion_u( i, j, ddzu, ddzw, km_m, tend, u_m, usws_m, & 210 uswst_m, v_m, w_m ) 211 ELSE 212 CALL diffusion_u( i, j, ddzu, ddzw, km, tend, u, usws, uswst, & 213 v, w ) 214 ENDIF 193 CALL advec_u_up( i, j ) 194 ENDIF 195 CALL diffusion_u( i, j ) 215 196 CALL coriolis( i, j, 1 ) 216 197 IF ( sloping_surface .AND. .NOT. neutral ) THEN … … 235 216 !-- Prognostic equation for u-velocity component 236 217 DO k = nzb_u_inner(j,i)+1, nzt 237 u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) + & 238 dt_3d * ( & 239 tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) & 240 ) - & 241 tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) ) 218 u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 219 tsc(3) * tu_m(k,j,i) ) & 220 - tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) ) 242 221 ENDDO 243 222 … … 266 245 CALL cpu_log( log_point(6), 'v-equation', 'start' ) 267 246 268 !269 !-- v-tendency terms with communication270 IF ( momentum_advec == 'ups-scheme' ) THEN271 tend = 0.0272 CALL advec_v_ups273 ENDIF274 275 !276 !-- v-tendency terms with no communication277 247 i_omp_start = nxl 278 248 DO i = nxl, nxr … … 280 250 ! 281 251 !-- Tendency terms 282 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN283 tend(:,j,i) = 0.0252 tend(:,j,i) = 0.0 253 IF ( timestep_scheme(1:5) == 'runge' ) THEN 284 254 IF ( ws_scheme_mom ) THEN 285 255 CALL advec_v_ws( i, j, i_omp_start, tn ) … … 289 259 290 260 ELSE 291 IF ( momentum_advec /= 'ups-scheme' ) THEN 292 tend(:,j,i) = 0.0 293 CALL advec_v_up( i, j ) 294 ENDIF 295 ENDIF 296 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 297 CALL diffusion_v( i, j, ddzu, ddzw, km_m, tend, u_m, v_m, & 298 vsws_m, vswst_m, w_m ) 299 ELSE 300 CALL diffusion_v( i, j, ddzu, ddzw, km, tend, u, v, vsws, & 301 vswst, w ) 302 ENDIF 261 CALL advec_v_up( i, j ) 262 ENDIF 263 CALL diffusion_v( i, j ) 303 264 CALL coriolis( i, j, 2 ) 304 265 … … 320 281 !-- Prognostic equation for v-velocity component 321 282 DO k = nzb_v_inner(j,i)+1, nzt 322 v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) + & 323 dt_3d * ( & 324 tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) & 325 ) - & 326 tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) ) 283 v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 284 tsc(3) * tv_m(k,j,i) ) & 285 - tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) ) 327 286 ENDDO 328 287 … … 351 310 CALL cpu_log( log_point(7), 'w-equation', 'start' ) 352 311 353 !354 !-- w-tendency terms with communication355 IF ( momentum_advec == 'ups-scheme' ) THEN356 tend = 0.0357 CALL advec_w_ups358 ENDIF359 360 !361 !-- w-tendency terms with no communication362 312 DO i = nxl, nxr 363 313 DO j = nys, nyn 364 314 ! 365 315 !-- Tendency terms 366 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN367 tend(:,j,i) = 0.0316 tend(:,j,i) = 0.0 317 IF ( timestep_scheme(1:5) == 'runge' ) THEN 368 318 IF ( ws_scheme_mom ) THEN 369 319 CALL advec_w_ws( i, j, i_omp_start, tn ) … … 373 323 374 324 ELSE 375 IF ( momentum_advec /= 'ups-scheme' ) THEN 376 tend(:,j,i) = 0.0 377 CALL advec_w_up( i, j ) 378 ENDIF 379 ENDIF 380 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 381 CALL diffusion_w( i, j, ddzu, ddzw, km_m, tend, u_m, v_m, w_m ) 382 ELSE 383 CALL diffusion_w( i, j, ddzu, ddzw, km, tend, u, v, w ) 384 ENDIF 325 CALL advec_w_up( i, j ) 326 ENDIF 327 CALL diffusion_w( i, j ) 385 328 CALL coriolis( i, j, 3 ) 386 329 … … 406 349 !-- Prognostic equation for w-velocity component 407 350 DO k = nzb_w_inner(j,i)+1, nzt-1 408 w_p(k,j,i) = ( 1.0-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) + & 409 dt_3d * ( & 410 tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) & 411 ) - & 412 tsc(5) * rdf(k) * w(k,j,i) 351 w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 352 tsc(3) * tw_m(k,j,i) ) & 353 - tsc(5) * rdf(k) * w(k,j,i) 413 354 ENDDO 414 355 … … 439 380 CALL cpu_log( log_point(13), 'pt-equation', 'start' ) 440 381 441 ! 442 !-- pt-tendency terms with communication 443 sat = tsc(1) 382 ! 383 !-- pt-tendency terms with communication 444 384 sbt = tsc(2) 445 385 IF ( scalar_advec == 'bc-scheme' ) THEN 446 386 447 387 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 448 ! 449 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 450 !-- switched on. Thus: 451 sat = 1.0 388 ! 389 !-- Bott-Chlond scheme always uses Euler time step. Thus: 452 390 sbt = 1.0 453 391 ENDIF 454 392 tend = 0.0 455 393 CALL advec_s_bc( pt, 'pt' ) 456 ELSE 457 IF ( tsc(2) /= 2.0 .AND. scalar_advec == 'ups-scheme' ) THEN 458 tend = 0.0 459 CALL advec_s_ups( pt, 'pt' ) 460 ENDIF 461 ENDIF 462 463 ! 464 !-- pt-tendency terms with no communication 394 395 ENDIF 396 397 ! 398 !-- pt-tendency terms with no communication 465 399 DO i = nxl, nxr 466 400 DO j = nys, nyn 467 ! 468 !-- Tendency terms 469 IF ( scalar_advec == 'bc-scheme' ) THEN 470 CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, & 471 wall_heatflux, tend ) 472 ELSE 473 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) & 474 THEN 475 tend(:,j,i) = 0.0 401 ! 402 !-- Tendency terms 403 IF ( scalar_advec /= 'bc-scheme' ) THEN 404 tend(:,j,i) = 0.0 405 IF ( timestep_scheme(1:5) == 'runge' ) THEN 476 406 IF ( ws_scheme_sca ) THEN 477 407 CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, & … … 482 412 ENDIF 483 413 ELSE 484 IF ( scalar_advec /= 'ups-scheme' ) THEN 485 tend(:,j,i) = 0.0 486 CALL advec_s_up( i, j, pt ) 487 ENDIF 488 ENDIF 489 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 490 THEN 491 CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, & 492 tswst_m, wall_heatflux, tend ) 493 ELSE 494 CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, & 495 wall_heatflux, tend ) 496 ENDIF 497 ENDIF 498 499 ! 500 !-- If required compute heating/cooling due to long wave radiation 501 !-- processes 414 CALL advec_s_up( i, j, pt ) 415 ENDIF 416 ENDIF 417 418 CALL diffusion_s( i, j, pt, shf, tswst, wall_heatflux ) 419 420 ! 421 !-- If required compute heating/cooling due to long wave radiation 422 !-- processes 502 423 IF ( radiation ) THEN 503 424 CALL calc_radiation( i, j ) 504 425 ENDIF 505 426 506 507 !--If required compute impact of latent heat due to precipitation427 ! 428 !-- If required compute impact of latent heat due to precipitation 508 429 IF ( precipitation ) THEN 509 430 CALL impact_of_latent_heat( i, j ) 510 431 ENDIF 511 432 512 513 !--Consideration of heat sources within the plant canopy433 ! 434 !-- Consideration of heat sources within the plant canopy 514 435 IF ( plant_canopy .AND. ( cthf /= 0.0 ) ) THEN 515 436 CALL plant_canopy_model( i, j, 4 ) 516 437 ENDIF 517 438 518 519 !--If required compute influence of large-scale subsidence/ascent439 ! 440 !-- If required compute influence of large-scale subsidence/ascent 520 441 IF ( large_scale_subsidence ) THEN 521 442 CALL subsidence( i, j, tend, pt, pt_init ) … … 524 445 CALL user_actions( i, j, 'pt-tendency' ) 525 446 526 527 !--Prognostic equation for potential temperature447 ! 448 !-- Prognostic equation for potential temperature 528 449 DO k = nzb_s_inner(j,i)+1, nzt 529 pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + & 530 dt_3d * ( & 531 sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) & 532 ) - & 533 tsc(5) * ( pt(k,j,i) - pt_init(k) ) * & 534 ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) ) 535 ENDDO 536 537 ! 538 !-- Calculate tendencies for the next Runge-Kutta step 450 pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( sbt * tend(k,j,i) + & 451 tsc(3) * tpt_m(k,j,i) ) & 452 - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *& 453 ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) ) 454 ENDDO 455 456 ! 457 !-- Calculate tendencies for the next Runge-Kutta step 539 458 IF ( timestep_scheme(1:5) == 'runge' ) THEN 540 459 IF ( intermediate_timestep_count == 1 ) THEN … … 566 485 ! 567 486 !-- sa-tendency terms with communication 568 sat = tsc(1)569 487 sbt = tsc(2) 570 488 IF ( scalar_advec == 'bc-scheme' ) THEN … … 572 490 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 573 491 ! 574 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 575 !-- switched on. Thus: 576 sat = 1.0 492 !-- Bott-Chlond scheme always uses Euler time step. Thus: 577 493 sbt = 1.0 578 494 ENDIF 579 495 tend = 0.0 580 496 CALL advec_s_bc( sa, 'sa' ) 581 ELSE 582 IF ( tsc(2) /= 2.0 ) THEN 583 IF ( scalar_advec == 'ups-scheme' ) THEN 584 tend = 0.0 585 CALL advec_s_ups( sa, 'sa' ) 586 ENDIF 587 ENDIF 497 588 498 ENDIF 589 499 … … 594 504 ! 595 505 !-- Tendency-terms 596 IF ( scalar_advec == 'bc-scheme' ) THEN 597 CALL diffusion_s( i, j, ddzu, ddzw, kh, sa, saswsb, saswst, & 598 wall_salinityflux, tend ) 599 ELSE 600 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 601 tend(:,j,i) = 0.0 506 IF ( scalar_advec /= 'bc-scheme' ) THEN 507 tend(:,j,i) = 0.0 508 IF ( timestep_scheme(1:5) == 'runge' ) THEN 602 509 IF ( ws_scheme_sca ) THEN 603 510 CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa, & … … 608 515 609 516 ELSE 610 IF ( scalar_advec /= 'ups-scheme' ) THEN 611 tend(:,j,i) = 0.0 612 CALL advec_s_up( i, j, sa ) 613 ENDIF 614 ENDIF 615 CALL diffusion_s( i, j, ddzu, ddzw, kh, sa, saswsb, saswst, & 616 wall_salinityflux, tend ) 617 ENDIF 517 CALL advec_s_up( i, j, sa ) 518 ENDIF 519 ENDIF 520 521 CALL diffusion_s( i, j, sa, saswsb, saswst, wall_salinityflux ) 618 522 619 523 CALL user_actions( i, j, 'sa-tendency' ) … … 622 526 !-- Prognostic equation for salinity 623 527 DO k = nzb_s_inner(j,i)+1, nzt 624 sa_p(k,j,i) = sat * sa(k,j,i) + & 625 dt_3d * ( & 626 sbt * tend(k,j,i) + tsc(3) * tsa_m(k,j,i) & 627 ) - & 628 tsc(5) * rdf_sc(k) * ( sa(k,j,i) - sa_init(k) ) 528 sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( sbt * tend(k,j,i) + & 529 tsc(3) * tsa_m(k,j,i) ) & 530 - tsc(5) * rdf_sc(k) * & 531 ( sa(k,j,i) - sa_init(k) ) 629 532 IF ( sa_p(k,j,i) < 0.0 ) sa_p(k,j,i) = 0.1 * sa(k,j,i) 630 533 ENDDO … … 665 568 ! 666 569 !-- Scalar/q-tendency terms with communication 667 sat = tsc(1)668 570 sbt = tsc(2) 669 571 IF ( scalar_advec == 'bc-scheme' ) THEN … … 671 573 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 672 574 ! 673 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 674 !-- switched on. Thus: 675 sat = 1.0 575 !-- Bott-Chlond scheme always uses Euler time step. Thus: 676 576 sbt = 1.0 677 577 ENDIF 678 578 tend = 0.0 679 579 CALL advec_s_bc( q, 'q' ) 680 ELSE 681 IF ( tsc(2) /= 2.0 ) THEN 682 IF ( scalar_advec == 'ups-scheme' ) THEN 683 tend = 0.0 684 CALL advec_s_ups( q, 'q' ) 685 ENDIF 686 ENDIF 580 687 581 ENDIF 688 582 … … 693 587 ! 694 588 !-- Tendency-terms 695 IF ( scalar_advec == 'bc-scheme' ) THEN 696 CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, & 697 wall_qflux, tend ) 698 ELSE 699 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 700 tend(:,j,i) = 0.0 589 IF ( scalar_advec /= 'bc-scheme' ) THEN 590 tend(:,j,i) = 0.0 591 IF ( timestep_scheme(1:5) == 'runge' ) THEN 701 592 IF ( ws_scheme_sca ) THEN 702 593 CALL advec_s_ws( i, j, q, 'q', flux_s_q, & … … 706 597 ENDIF 707 598 ELSE 708 IF ( scalar_advec /= 'ups-scheme' ) THEN 709 tend(:,j,i) = 0.0 710 CALL advec_s_up( i, j, q ) 711 ENDIF 712 ENDIF 713 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' )& 714 THEN 715 CALL diffusion_s( i, j, ddzu, ddzw, kh_m, q_m, qsws_m, & 716 qswst_m, wall_qflux, tend ) 717 ELSE 718 CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, & 719 wall_qflux, tend ) 720 ENDIF 721 ENDIF 599 CALL advec_s_up( i, j, q ) 600 ENDIF 601 ENDIF 602 603 CALL diffusion_s( i, j, q, qsws, qswst, wall_qflux ) 722 604 723 605 ! … … 743 625 !-- Prognostic equation for total water content / scalar 744 626 DO k = nzb_s_inner(j,i)+1, nzt 745 q_p(k,j,i) = ( 1 - sat ) * q_m(k,j,i) + sat * q(k,j,i) + & 746 dt_3d * ( & 747 sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) & 748 ) - & 749 tsc(5) * rdf_sc(k) * ( q(k,j,i) - q_init(k) ) 627 q_p(k,j,i) = q(k,j,i) + dt_3d * ( sbt * tend(k,j,i) + & 628 tsc(3) * tq_m(k,j,i) ) & 629 - tsc(5) * rdf_sc(k) * & 630 ( q(k,j,i) - q_init(k) ) 750 631 IF ( q_p(k,j,i) < 0.0 ) q_p(k,j,i) = 0.1 * q(k,j,i) 751 632 ENDDO … … 784 665 CALL production_e_init 785 666 786 sat = tsc(1)787 667 sbt = tsc(2) 788 668 IF ( .NOT. use_upstream_for_tke ) THEN … … 791 671 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 792 672 ! 793 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 794 !-- switched on. Thus: 795 sat = 1.0 673 !-- Bott-Chlond scheme always uses Euler time step. Thus: 796 674 sbt = 1.0 797 675 ENDIF 798 676 tend = 0.0 799 677 CALL advec_s_bc( e, 'e' ) 800 ELSE801 IF ( tsc(2) /= 2.0 ) THEN802 IF ( scalar_advec == 'ups-scheme' ) THEN803 tend = 0.0804 CALL advec_s_ups( e, 'e' )805 ENDIF806 ENDIF807 678 ENDIF 808 679 ENDIF … … 814 685 ! 815 686 !-- Tendency-terms 816 IF ( scalar_advec == 'bc-scheme' .AND. & 817 .NOT. use_upstream_for_tke ) THEN 818 IF ( .NOT. humidity ) THEN 819 IF ( ocean ) THEN 820 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, & 821 l_grid, prho, prho_reference, rif, & 822 tend, zu, zw ) 823 ELSE 824 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, & 825 l_grid, pt, pt_reference, rif, tend, & 826 zu, zw ) 827 ENDIF 828 ELSE 829 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, & 830 l_grid, vpt, pt_reference, rif, tend, zu, & 831 zw ) 832 ENDIF 833 ELSE 687 IF ( scalar_advec /= 'bc-scheme' .OR. use_upstream_for_tke ) THEN 834 688 IF ( use_upstream_for_tke ) THEN 835 689 tend(:,j,i) = 0.0 836 690 CALL advec_s_up( i, j, e ) 837 691 ELSE 838 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) & 839 THEN 840 tend(:,j,i) = 0.0 692 tend(:,j,i) = 0.0 693 IF ( timestep_scheme(1:5) == 'runge' ) THEN 841 694 IF ( ws_scheme_sca ) THEN 842 695 CALL advec_s_ws( i, j, e, 'e', flux_s_e, & … … 846 699 ENDIF 847 700 ELSE 848 IF ( scalar_advec /= 'ups-scheme' ) THEN 849 tend(:,j,i) = 0.0 850 CALL advec_s_up( i, j, e ) 851 ENDIF 701 CALL advec_s_up( i, j, e ) 852 702 ENDIF 853 703 ENDIF 854 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' )& 855 THEN 856 IF ( .NOT. humidity ) THEN 857 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, & 858 km_m, l_grid, pt_m, pt_reference, & 859 rif_m, tend, zu, zw ) 860 ELSE 861 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, & 862 km_m, l_grid, vpt_m, pt_reference, & 863 rif_m, tend, zu, zw ) 864 ENDIF 704 ENDIF 705 706 IF ( .NOT. humidity ) THEN 707 IF ( ocean ) THEN 708 CALL diffusion_e( i, j, prho, prho_reference ) 865 709 ELSE 866 IF ( .NOT. humidity ) THEN 867 IF ( ocean ) THEN 868 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, & 869 km, l_grid, prho, prho_reference, & 870 rif, tend, zu, zw ) 871 ELSE 872 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, & 873 km, l_grid, pt, pt_reference, rif, & 874 tend, zu, zw ) 875 ENDIF 876 ELSE 877 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, & 878 l_grid, vpt, pt_reference, rif, tend, & 879 zu, zw ) 880 ENDIF 881 ENDIF 882 ENDIF 710 CALL diffusion_e( i, j, pt, pt_reference ) 711 ENDIF 712 ELSE 713 CALL diffusion_e( i, j, vpt, pt_reference ) 714 ENDIF 715 883 716 CALL production_e( i, j ) 884 717 … … 895 728 !-- value is reduced by 90%. 896 729 DO k = nzb_s_inner(j,i)+1, nzt 897 e_p(k,j,i) = ( 1 - sat ) * e_m(k,j,i) + sat * e(k,j,i) + & 898 dt_3d * ( & 899 sbt * tend(k,j,i) + tsc(3) * te_m(k,j,i) & 900 ) 730 e_p(k,j,i) = e(k,j,i) + dt_3d * ( sbt * tend(k,j,i) + & 731 tsc(3) * te_m(k,j,i) ) 901 732 IF ( e_p(k,j,i) < 0.0 ) e_p(k,j,i) = 0.1 * e(k,j,i) 902 733 ENDDO … … 986 817 987 818 tend(:,j,i) = 0.0 988 IF ( t sc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN819 IF ( timestep_scheme(1:5) == 'runge' ) THEN 989 820 IF ( ws_scheme_mom ) THEN 990 821 IF ( ( inflow_l .OR. outflow_l ) .AND. i_omp_start == nxl ) THEN 991 ! CALL local_diss( i, j, u) ! dissipation control992 822 CALL advec_u_ws( i, j, i_omp_start + 1, tn ) 993 823 ELSE … … 1000 830 CALL advec_u_up( i, j ) 1001 831 ENDIF 1002 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 1003 THEN 1004 CALL diffusion_u( i, j, ddzu, ddzw, km_m, tend, u_m, & 1005 usws_m, uswst_m, v_m, w_m ) 1006 ELSE 1007 CALL diffusion_u( i, j, ddzu, ddzw, km, tend, u, usws, & 1008 uswst, v, w ) 1009 ENDIF 832 CALL diffusion_u( i, j ) 1010 833 CALL coriolis( i, j, 1 ) 1011 834 IF ( sloping_surface .AND. .NOT. neutral ) THEN … … 1030 853 !-- Prognostic equation for u-velocity component 1031 854 DO k = nzb_u_inner(j,i)+1, nzt 1032 u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) + & 1033 dt_3d * ( & 1034 tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) & 1035 ) - & 1036 tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) ) 855 u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 856 tsc(3) * tu_m(k,j,i) ) & 857 - tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) ) 1037 858 ENDDO 1038 859 … … 1059 880 1060 881 tend(:,j,i) = 0.0 1061 IF ( t sc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN882 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1062 883 IF ( ws_scheme_mom ) THEN 1063 ! CALL local_diss( i, j, v)1064 884 CALL advec_v_ws( i, j, i_omp_start, tn ) 1065 885 ELSE … … 1069 889 CALL advec_v_up( i, j ) 1070 890 ENDIF 1071 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 1072 THEN 1073 CALL diffusion_v( i, j, ddzu, ddzw, km_m, tend, u_m, v_m, & 1074 vsws_m, vswst_m, w_m ) 1075 ELSE 1076 CALL diffusion_v( i, j, ddzu, ddzw, km, tend, u, v, vsws, & 1077 vswst, w ) 1078 ENDIF 891 CALL diffusion_v( i, j ) 1079 892 CALL coriolis( i, j, 2 ) 1080 893 … … 1096 909 !-- Prognostic equation for v-velocity component 1097 910 DO k = nzb_v_inner(j,i)+1, nzt 1098 v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) + & 1099 dt_3d * ( & 1100 tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) & 1101 ) - & 1102 tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) ) 911 v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 912 tsc(3) * tv_m(k,j,i) ) & 913 - tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) ) 1103 914 ENDDO 1104 915 … … 1123 934 !-- Tendency terms for w-velocity component 1124 935 tend(:,j,i) = 0.0 1125 IF ( t sc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN936 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1126 937 IF ( ws_scheme_mom ) THEN 1127 ! CALL local_diss( i, j, w)1128 938 CALL advec_w_ws( i, j, i_omp_start, tn ) 1129 939 ELSE … … 1133 943 CALL advec_w_up( i, j ) 1134 944 ENDIF 1135 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 1136 THEN 1137 CALL diffusion_w( i, j, ddzu, ddzw, km_m, tend, u_m, v_m, & 1138 w_m ) 1139 ELSE 1140 CALL diffusion_w( i, j, ddzu, ddzw, km, tend, u, v, w ) 1141 ENDIF 945 CALL diffusion_w( i, j ) 1142 946 CALL coriolis( i, j, 3 ) 1143 947 … … 1163 967 !-- Prognostic equation for w-velocity component 1164 968 DO k = nzb_w_inner(j,i)+1, nzt-1 1165 w_p(k,j,i) = ( 1.0-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) + & 1166 dt_3d * ( & 1167 tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) & 1168 ) - & 1169 tsc(5) * rdf(k) * w(k,j,i) 969 w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 970 tsc(3) * tw_m(k,j,i) ) & 971 - tsc(5) * rdf(k) * w(k,j,i) 1170 972 ENDDO 1171 973 … … 1191 993 !-- Tendency terms for potential temperature 1192 994 tend(:,j,i) = 0.0 1193 IF ( t sc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN995 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1194 996 IF ( ws_scheme_sca ) THEN 1195 997 CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, diss_s_pt, & … … 1201 1003 CALL advec_s_up( i, j, pt ) 1202 1004 ENDIF 1203 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 1204 THEN 1205 CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, & 1206 tswst_m, wall_heatflux, tend ) 1207 ELSE 1208 CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, & 1209 wall_heatflux, tend ) 1210 ENDIF 1005 CALL diffusion_s( i, j, pt, shf, tswst, wall_heatflux ) 1211 1006 1212 1007 ! … … 1241 1036 !-- Prognostic equation for potential temperature 1242 1037 DO k = nzb_s_inner(j,i)+1, nzt 1243 pt_p(k,j,i) = ( 1.0-tsc(1) ) * pt_m(k,j,i) + tsc(1)*pt(k,j,i) +& 1244 dt_3d * ( & 1245 tsc(2) * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) & 1246 ) - & 1247 tsc(5) * ( pt(k,j,i) - pt_init(k) ) * & 1248 ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) ) 1038 pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 1039 tsc(3) * tpt_m(k,j,i) ) & 1040 - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *& 1041 ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) ) 1249 1042 ENDDO 1250 1043 … … 1274 1067 !-- Tendency-terms for salinity 1275 1068 tend(:,j,i) = 0.0 1276 IF ( t sc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) &1069 IF ( timestep_scheme(1:5) == 'runge' ) & 1277 1070 THEN 1278 1071 IF ( ws_scheme_sca ) THEN 1279 ! CALL local_diss( i, j, sa )1280 1072 CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa, & 1281 1073 diss_s_sa, flux_l_sa, diss_l_sa, i_omp_start, tn ) … … 1286 1078 CALL advec_s_up( i, j, sa ) 1287 1079 ENDIF 1288 CALL diffusion_s( i, j, ddzu, ddzw, kh, sa, saswsb, saswst, & 1289 wall_salinityflux, tend ) 1080 CALL diffusion_s( i, j, sa, saswsb, saswst, wall_salinityflux ) 1290 1081 1291 1082 CALL user_actions( i, j, 'sa-tendency' ) … … 1294 1085 !-- Prognostic equation for salinity 1295 1086 DO k = nzb_s_inner(j,i)+1, nzt 1296 sa_p(k,j,i) = tsc(1) * sa(k,j,i) + & 1297 dt_3d * ( & 1298 tsc(2) * tend(k,j,i) + tsc(3) * tsa_m(k,j,i) & 1299 ) - & 1300 tsc(5) * rdf_sc(k) * ( sa(k,j,i) - sa_init(k) ) 1087 sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 1088 tsc(3) * tsa_m(k,j,i) ) & 1089 - tsc(5) * rdf_sc(k) * & 1090 ( sa(k,j,i) - sa_init(k) ) 1301 1091 IF ( sa_p(k,j,i) < 0.0 ) sa_p(k,j,i) = 0.1 * sa(k,j,i) 1302 1092 ENDDO … … 1332 1122 !-- Tendency-terms for total water content / scalar 1333 1123 tend(:,j,i) = 0.0 1334 IF ( t sc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) &1124 IF ( timestep_scheme(1:5) == 'runge' ) & 1335 1125 THEN 1336 1126 IF ( ws_scheme_sca ) THEN 1337 ! CALL local_diss( i, j, q )1338 1127 CALL advec_s_ws( i, j, q, 'q', flux_s_q, & 1339 1128 diss_s_q, flux_l_q, diss_l_q, i_omp_start, tn ) … … 1344 1133 CALL advec_s_up( i, j, q ) 1345 1134 ENDIF 1346 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' )& 1347 THEN 1348 CALL diffusion_s( i, j, ddzu, ddzw, kh_m, q_m, qsws_m, & 1349 qswst_m, wall_qflux, tend ) 1350 ELSE 1351 CALL diffusion_s( i, j, ddzu, ddzw, kh, q, qsws, qswst, & 1352 wall_qflux, tend ) 1353 ENDIF 1135 CALL diffusion_s( i, j, q, qsws, qswst, wall_qflux ) 1354 1136 1355 1137 ! … … 1374 1156 !-- Prognostic equation for total water content / scalar 1375 1157 DO k = nzb_s_inner(j,i)+1, nzt 1376 q_p(k,j,i) = ( 1.0-tsc(1) ) * q_m(k,j,i) + tsc(1)*q(k,j,i) +& 1377 dt_3d * ( & 1378 tsc(2) * tend(k,j,i) + tsc(3) * tq_m(k,j,i) & 1379 ) - & 1380 tsc(5) * rdf_sc(k) * ( q(k,j,i) - q_init(k) ) 1158 q_p(k,j,i) = q(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 1159 tsc(3) * tq_m(k,j,i) ) & 1160 - tsc(5) * rdf_sc(k) * & 1161 ( q(k,j,i) - q_init(k) ) 1381 1162 IF ( q_p(k,j,i) < 0.0 ) q_p(k,j,i) = 0.1 * q(k,j,i) 1382 1163 ENDDO … … 1408 1189 !-- Tendency-terms for TKE 1409 1190 tend(:,j,i) = 0.0 1410 IF ( ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' )&1191 IF ( timestep_scheme(1:5) == 'runge' & 1411 1192 .AND. .NOT. use_upstream_for_tke ) THEN 1412 1193 IF ( ws_scheme_sca ) THEN 1413 ! CALL local_diss( i, j, e ) 1414 CALL advec_s_ws( i, j, e, 'e', flux_s_e, & 1415 diss_s_e, flux_l_e, diss_l_e , i_omp_start, tn ) 1194 CALL advec_s_ws( i, j, e, 'e', flux_s_e, diss_s_e, & 1195 flux_l_e, diss_l_e , i_omp_start, tn ) 1416 1196 ELSE 1417 1197 CALL advec_s_pw( i, j, e ) … … 1420 1200 CALL advec_s_up( i, j, e ) 1421 1201 ENDIF 1422 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' )& 1423 THEN 1424 IF ( .NOT. humidity ) THEN 1425 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, & 1426 km_m, l_grid, pt_m, pt_reference, & 1427 rif_m, tend, zu, zw ) 1202 IF ( .NOT. humidity ) THEN 1203 IF ( ocean ) THEN 1204 CALL diffusion_e( i, j, prho, prho_reference ) 1428 1205 ELSE 1429 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e_m, & 1430 km_m, l_grid, vpt_m, pt_reference, & 1431 rif_m, tend, zu, zw ) 1206 CALL diffusion_e( i, j, pt, pt_reference ) 1432 1207 ENDIF 1433 1208 ELSE 1434 IF ( .NOT. humidity ) THEN 1435 IF ( ocean ) THEN 1436 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, & 1437 km, l_grid, prho, prho_reference, & 1438 rif, tend, zu, zw ) 1439 ELSE 1440 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, & 1441 km, l_grid, pt, pt_reference, rif, & 1442 tend, zu, zw ) 1443 ENDIF 1444 ELSE 1445 CALL diffusion_e( i, j, ddzu, dd2zu, ddzw, diss, e, km, & 1446 l_grid, vpt, pt_reference, rif, tend, & 1447 zu, zw ) 1448 ENDIF 1209 CALL diffusion_e( i, j, vpt, pt_reference ) 1449 1210 ENDIF 1450 1211 CALL production_e( i, j ) … … 1462 1223 !-- TKE value is reduced by 90%. 1463 1224 DO k = nzb_s_inner(j,i)+1, nzt 1464 e_p(k,j,i) = ( 1.0-tsc(1) ) * e_m(k,j,i) + tsc(1)*e(k,j,i) +& 1465 dt_3d * ( & 1466 tsc(2) * tend(k,j,i) + tsc(3) * te_m(k,j,i) & 1467 ) 1225 e_p(k,j,i) = e(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 1226 tsc(3) * te_m(k,j,i) ) 1468 1227 IF ( e_p(k,j,i) < 0.0 ) e_p(k,j,i) = 0.1 * e(k,j,i) 1469 1228 ENDDO … … 1507 1266 CHARACTER (LEN=9) :: time_to_string 1508 1267 INTEGER :: i, j, k 1509 REAL :: s at, sbt1268 REAL :: sbt 1510 1269 1511 1270 ! … … 1522 1281 CALL cpu_log( log_point(5), 'u-equation', 'start' ) 1523 1282 1524 ! 1525 !-- u-tendency terms with communication 1526 IF ( momentum_advec == 'ups-scheme' ) THEN 1527 tend = 0.0 1528 CALL advec_u_ups 1529 ENDIF 1530 1531 ! 1532 !-- u-tendency terms with no communication 1533 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1534 tend = 0.0 1283 tend = 0.0 1284 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1535 1285 IF ( ws_scheme_mom ) THEN 1536 1286 CALL advec_u_ws … … 1539 1289 ENDIF 1540 1290 ELSE 1541 IF ( momentum_advec /= 'ups-scheme' ) THEN 1542 tend = 0.0 1543 CALL advec_u_up 1544 ENDIF 1291 CALL advec_u_up 1545 1292 ENDIF 1546 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 1547 CALL diffusion_u( ddzu, ddzw, km_m, tend, u_m, usws_m, uswst_m, & 1548 v_m, w_m ) 1549 ELSE 1550 CALL diffusion_u( ddzu, ddzw, km, tend, u, usws, uswst, v, w ) 1551 ENDIF 1293 CALL diffusion_u 1552 1294 CALL coriolis( 1 ) 1553 1295 IF ( sloping_surface .AND. .NOT. neutral ) THEN … … 1578 1320 DO j = nys, nyn 1579 1321 DO k = nzb_u_inner(j,i)+1, nzt 1580 u_p(k,j,i) = ( 1.0-tsc(1) ) * u_m(k,j,i) + tsc(1) * u(k,j,i) + & 1581 dt_3d * ( & 1582 tsc(2) * tend(k,j,i) + tsc(3) * tu_m(k,j,i) & 1583 ) - & 1584 tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) ) 1322 u_p(k,j,i) = u(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 1323 tsc(3) * tu_m(k,j,i) ) & 1324 - tsc(5) * rdf(k) * ( u(k,j,i) - ug(k) ) 1585 1325 ENDDO 1586 1326 ENDDO … … 1616 1356 CALL cpu_log( log_point(6), 'v-equation', 'start' ) 1617 1357 1618 ! 1619 !-- v-tendency terms with communication 1620 IF ( momentum_advec == 'ups-scheme' ) THEN 1621 tend = 0.0 1622 CALL advec_v_ups 1623 ENDIF 1624 1625 ! 1626 !-- v-tendency terms with no communication 1627 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1628 tend = 0.0 1358 tend = 0.0 1359 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1629 1360 IF ( ws_scheme_mom ) THEN 1630 1361 CALL advec_v_ws … … 1633 1364 END IF 1634 1365 ELSE 1635 IF ( momentum_advec /= 'ups-scheme' ) THEN 1636 tend = 0.0 1637 CALL advec_v_up 1638 ENDIF 1366 CALL advec_v_up 1639 1367 ENDIF 1640 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 1641 CALL diffusion_v( ddzu, ddzw, km_m, tend, u_m, v_m, vsws_m, vswst_m, & 1642 w_m ) 1643 ELSE 1644 CALL diffusion_v( ddzu, ddzw, km, tend, u, v, vsws, vswst, w ) 1645 ENDIF 1368 CALL diffusion_v 1646 1369 CALL coriolis( 2 ) 1647 1370 … … 1669 1392 DO j = nysv, nyn 1670 1393 DO k = nzb_v_inner(j,i)+1, nzt 1671 v_p(k,j,i) = ( 1.0-tsc(1) ) * v_m(k,j,i) + tsc(1) * v(k,j,i) + & 1672 dt_3d * ( & 1673 tsc(2) * tend(k,j,i) + tsc(3) * tv_m(k,j,i) & 1674 ) - & 1675 tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) ) 1394 v_p(k,j,i) = v(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 1395 tsc(3) * tv_m(k,j,i) ) & 1396 - tsc(5) * rdf(k) * ( v(k,j,i) - vg(k) ) 1676 1397 ENDDO 1677 1398 ENDDO … … 1707 1428 CALL cpu_log( log_point(7), 'w-equation', 'start' ) 1708 1429 1709 ! 1710 !-- w-tendency terms with communication 1711 IF ( momentum_advec == 'ups-scheme' ) THEN 1712 tend = 0.0 1713 CALL advec_w_ups 1714 ENDIF 1715 1716 ! 1717 !-- w-tendency terms with no communication 1718 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1719 tend = 0.0 1430 tend = 0.0 1431 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1720 1432 IF ( ws_scheme_mom ) THEN 1721 1433 CALL advec_w_ws … … 1724 1436 ENDIF 1725 1437 ELSE 1726 IF ( momentum_advec /= 'ups-scheme' ) THEN 1727 tend = 0.0 1728 CALL advec_w_up 1729 ENDIF 1438 CALL advec_w_up 1730 1439 ENDIF 1731 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 1732 CALL diffusion_w( ddzu, ddzw, km_m, tend, u_m, v_m, w_m ) 1733 ELSE 1734 CALL diffusion_w( ddzu, ddzw, km, tend, u, v, w ) 1735 ENDIF 1440 CALL diffusion_w 1736 1441 CALL coriolis( 3 ) 1737 1442 … … 1759 1464 DO j = nys, nyn 1760 1465 DO k = nzb_w_inner(j,i)+1, nzt-1 1761 w_p(k,j,i) = ( 1-tsc(1) ) * w_m(k,j,i) + tsc(1) * w(k,j,i) + & 1762 dt_3d * ( & 1763 tsc(2) * tend(k,j,i) + tsc(3) * tw_m(k,j,i) & 1764 ) - & 1765 tsc(5) * rdf(k) * w(k,j,i) 1466 w_p(k,j,i) = w(k,j,i) + dt_3d * ( tsc(2) * tend(k,j,i) + & 1467 tsc(3) * tw_m(k,j,i) ) & 1468 - tsc(5) * rdf(k) * w(k,j,i) 1766 1469 ENDDO 1767 1470 ENDDO … … 1802 1505 ! 1803 1506 !-- pt-tendency terms with communication 1804 sat = tsc(1)1805 1507 sbt = tsc(2) 1806 1508 IF ( scalar_advec == 'bc-scheme' ) THEN … … 1808 1510 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1809 1511 ! 1810 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 1811 !-- switched on. Thus: 1812 sat = 1.0 1512 !-- Bott-Chlond scheme always uses Euler time step. Thus: 1813 1513 sbt = 1.0 1814 1514 ENDIF 1815 1515 tend = 0.0 1816 1516 CALL advec_s_bc( pt, 'pt' ) 1817 ELSE 1818 IF ( tsc(2) /= 2.0 .AND. scalar_advec == 'ups-scheme' ) THEN 1819 tend = 0.0 1820 CALL advec_s_ups( pt, 'pt' ) 1821 ENDIF 1517 1822 1518 ENDIF 1823 1519 1824 1520 ! 1825 1521 !-- pt-tendency terms with no communication 1826 IF ( scalar_advec == 'bc-scheme' ) THEN 1827 CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, wall_heatflux, & 1828 tend ) 1829 ELSE 1830 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1831 tend = 0.0 1522 IF ( scalar_advec /= 'bc-scheme' ) THEN 1523 tend = 0.0 1524 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1832 1525 IF ( ws_scheme_sca ) THEN 1833 1526 CALL advec_s_ws( pt, 'pt' ) … … 1836 1529 ENDIF 1837 1530 ELSE 1838 IF ( scalar_advec /= 'ups-scheme' ) THEN 1839 tend = 0.0 1840 CALL advec_s_up( pt ) 1841 ENDIF 1842 ENDIF 1843 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 1844 CALL diffusion_s( ddzu, ddzw, kh_m, pt_m, shf_m, tswst_m, & 1845 wall_heatflux, tend ) 1846 ELSE 1847 CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, wall_heatflux, & 1848 tend ) 1849 ENDIF 1850 ENDIF 1531 CALL advec_s_up( pt ) 1532 ENDIF 1533 ENDIF 1534 1535 CALL diffusion_s( pt, shf, tswst, wall_heatflux ) 1851 1536 1852 1537 ! … … 1881 1566 DO j = nys, nyn 1882 1567 DO k = nzb_s_inner(j,i)+1, nzt 1883 pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + & 1884 dt_3d * ( & 1885 sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i)& 1886 ) - & 1887 tsc(5) * ( pt(k,j,i) - pt_init(k) ) * & 1888 ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) ) 1568 pt_p(k,j,i) = pt(k,j,i) + dt_3d * ( sbt * tend(k,j,i) + & 1569 tsc(3) * tpt_m(k,j,i) ) & 1570 - tsc(5) * ( pt(k,j,i) - pt_init(k) ) *& 1571 ( rdf_sc(k) + ptdf_x(i) + ptdf_y(j) ) 1889 1572 ENDDO 1890 1573 ENDDO … … 1927 1610 ! 1928 1611 !-- sa-tendency terms with communication 1929 sat = tsc(1)1930 1612 sbt = tsc(2) 1931 1613 IF ( scalar_advec == 'bc-scheme' ) THEN … … 1933 1615 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1934 1616 ! 1935 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 1936 !-- switched on. Thus: 1937 sat = 1.0 1617 !-- Bott-Chlond scheme always uses Euler time step. Thus: 1938 1618 sbt = 1.0 1939 1619 ENDIF 1940 1620 tend = 0.0 1941 1621 CALL advec_s_bc( sa, 'sa' ) 1942 ELSE 1943 IF ( tsc(2) /= 2.0 ) THEN 1944 IF ( scalar_advec == 'ups-scheme' ) THEN 1945 tend = 0.0 1946 CALL advec_s_ups( sa, 'sa' ) 1947 ENDIF 1948 ENDIF 1622 1949 1623 ENDIF 1950 1624 1951 1625 ! 1952 1626 !-- sa-tendency terms with no communication 1953 IF ( scalar_advec == 'bc-scheme' ) THEN 1954 CALL diffusion_s( ddzu, ddzw, kh, sa, saswsb, saswst, & 1955 wall_salinityflux, tend ) 1956 ELSE 1957 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1958 tend = 0.0 1627 IF ( scalar_advec /= 'bc-scheme' ) THEN 1628 tend = 0.0 1629 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1959 1630 IF ( ws_scheme_sca ) THEN 1960 1631 CALL advec_s_ws( sa, 'sa' ) … … 1963 1634 ENDIF 1964 1635 ELSE 1965 IF ( scalar_advec /= 'ups-scheme' ) THEN 1966 tend = 0.0 1967 CALL advec_s_up( sa ) 1968 ENDIF 1969 ENDIF 1970 CALL diffusion_s( ddzu, ddzw, kh, sa, saswsb, saswst, & 1971 wall_salinityflux, tend ) 1972 ENDIF 1636 CALL advec_s_up( sa ) 1637 ENDIF 1638 ENDIF 1639 1640 CALL diffusion_s( sa, saswsb, saswst, wall_salinityflux ) 1973 1641 1974 1642 CALL user_actions( 'sa-tendency' ) … … 1979 1647 DO j = nys, nyn 1980 1648 DO k = nzb_s_inner(j,i)+1, nzt 1981 sa_p(k,j,i) = sat * sa(k,j,i) + & 1982 dt_3d * ( & 1983 sbt * tend(k,j,i) + tsc(3) * tsa_m(k,j,i) & 1984 ) - & 1985 tsc(5) * rdf_sc(k) * ( sa(k,j,i) - sa_init(k) ) 1649 sa_p(k,j,i) = sa(k,j,i) + dt_3d * ( sbt * tend(k,j,i) + & 1650 tsc(3) * tsa_m(k,j,i) ) & 1651 - tsc(5) * rdf_sc(k) * & 1652 ( sa(k,j,i) - sa_init(k) ) 1986 1653 IF ( sa_p(k,j,i) < 0.0 ) sa_p(k,j,i) = 0.1 * sa(k,j,i) 1987 1654 ENDDO … … 2031 1698 ! 2032 1699 !-- Scalar/q-tendency terms with communication 2033 sat = tsc(1)2034 1700 sbt = tsc(2) 2035 1701 IF ( scalar_advec == 'bc-scheme' ) THEN … … 2037 1703 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 2038 1704 ! 2039 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 2040 !-- switched on. Thus: 2041 sat = 1.0 1705 !-- Bott-Chlond scheme always uses Euler time step. Thus: 2042 1706 sbt = 1.0 2043 1707 ENDIF 2044 1708 tend = 0.0 2045 1709 CALL advec_s_bc( q, 'q' ) 2046 ELSE 2047 IF ( tsc(2) /= 2.0 ) THEN 2048 IF ( scalar_advec == 'ups-scheme' ) THEN 2049 tend = 0.0 2050 CALL advec_s_ups( q, 'q' ) 2051 ENDIF 2052 ENDIF 1710 2053 1711 ENDIF 2054 1712 2055 1713 ! 2056 1714 !-- Scalar/q-tendency terms with no communication 2057 IF ( scalar_advec == 'bc-scheme' ) THEN 2058 CALL diffusion_s( ddzu, ddzw, kh, q, qsws, qswst, wall_qflux, tend ) 2059 ELSE 2060 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 2061 tend = 0.0 1715 IF ( scalar_advec /= 'bc-scheme' ) THEN 1716 tend = 0.0 1717 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2062 1718 IF ( ws_scheme_sca ) THEN 2063 1719 CALL advec_s_ws( q, 'q' ) … … 2066 1722 ENDIF 2067 1723 ELSE 2068 IF ( scalar_advec /= 'ups-scheme' ) THEN 2069 tend = 0.0 2070 CALL advec_s_up( q ) 2071 ENDIF 2072 ENDIF 2073 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 2074 CALL diffusion_s( ddzu, ddzw, kh_m, q_m, qsws_m, qswst_m, & 2075 wall_qflux, tend ) 2076 ELSE 2077 CALL diffusion_s( ddzu, ddzw, kh, q, qsws, qswst, & 2078 wall_qflux, tend ) 2079 ENDIF 2080 ENDIF 1724 CALL advec_s_up( q ) 1725 ENDIF 1726 ENDIF 1727 1728 CALL diffusion_s( q, qsws, qswst, wall_qflux ) 2081 1729 2082 1730 ! … … 2104 1752 DO j = nys, nyn 2105 1753 DO k = nzb_s_inner(j,i)+1, nzt 2106 q_p(k,j,i) = ( 1 - sat ) * q_m(k,j,i) + sat * q(k,j,i) + & 2107 dt_3d * ( & 2108 sbt * tend(k,j,i) + tsc(3) * tq_m(k,j,i) & 2109 ) - & 2110 tsc(5) * rdf_sc(k) * ( q(k,j,i) - q_init(k) ) 1754 q_p(k,j,i) = q(k,j,i) + dt_3d * ( sbt * tend(k,j,i) + & 1755 tsc(3) * tq_m(k,j,i) ) & 1756 - tsc(5) * rdf_sc(k) * & 1757 ( q(k,j,i) - q_init(k) ) 2111 1758 IF ( q_p(k,j,i) < 0.0 ) q_p(k,j,i) = 0.1 * q(k,j,i) 2112 1759 ENDDO … … 2152 1799 CALL production_e_init 2153 1800 2154 sat = tsc(1)2155 1801 sbt = tsc(2) 2156 1802 IF ( .NOT. use_upstream_for_tke ) THEN … … 2159 1805 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 2160 1806 ! 2161 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 2162 !-- switched on. Thus: 2163 sat = 1.0 1807 !-- Bott-Chlond scheme always uses Euler time step. Thus: 2164 1808 sbt = 1.0 2165 1809 ENDIF 2166 1810 tend = 0.0 2167 1811 CALL advec_s_bc( e, 'e' ) 2168 ELSE 2169 IF ( tsc(2) /= 2.0 ) THEN 2170 IF ( scalar_advec == 'ups-scheme' ) THEN 2171 tend = 0.0 2172 CALL advec_s_ups( e, 'e' ) 2173 ENDIF 2174 ENDIF 1812 2175 1813 ENDIF 2176 1814 ENDIF … … 2178 1816 ! 2179 1817 !-- TKE-tendency terms with no communication 2180 IF ( scalar_advec == 'bc-scheme' .AND. .NOT. use_upstream_for_tke ) & 2181 THEN 2182 IF ( .NOT. humidity ) THEN 2183 IF ( ocean ) THEN 2184 CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, & 2185 prho, prho_reference, rif, tend, zu, zw ) 2186 ELSE 2187 CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, pt, & 2188 pt_reference, rif, tend, zu, zw ) 2189 ENDIF 2190 ELSE 2191 CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, vpt, & 2192 pt_reference, rif, tend, zu, zw ) 2193 ENDIF 2194 ELSE 1818 IF ( scalar_advec /= 'bc-scheme' .OR. use_upstream_for_tke ) THEN 2195 1819 IF ( use_upstream_for_tke ) THEN 2196 1820 tend = 0.0 2197 1821 CALL advec_s_up( e ) 2198 1822 ELSE 2199 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN2200 tend = 0.01823 tend = 0.0 1824 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2201 1825 IF ( ws_scheme_sca ) THEN 2202 1826 CALL advec_s_ws( e, 'e' ) … … 2205 1829 ENDIF 2206 1830 ELSE 2207 IF ( scalar_advec /= 'ups-scheme' ) THEN 2208 tend = 0.0 2209 CALL advec_s_up( e ) 2210 ENDIF 2211 ENDIF 2212 ENDIF 2213 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 2214 IF ( .NOT. humidity ) THEN 2215 CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e_m, km_m, l_grid, & 2216 pt_m, pt_reference, rif_m, tend, zu, zw ) 2217 ELSE 2218 CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e_m, km_m, l_grid, & 2219 vpt_m, pt_reference, rif_m, tend, zu, zw ) 2220 ENDIF 1831 CALL advec_s_up( e ) 1832 ENDIF 1833 ENDIF 1834 ENDIF 1835 1836 IF ( .NOT. humidity ) THEN 1837 IF ( ocean ) THEN 1838 CALL diffusion_e( prho, prho_reference ) 2221 1839 ELSE 2222 IF ( .NOT. humidity ) THEN 2223 IF ( ocean ) THEN 2224 CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, & 2225 prho, prho_reference, rif, tend, zu, zw ) 2226 ELSE 2227 CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, & 2228 pt, pt_reference, rif, tend, zu, zw ) 2229 ENDIF 2230 ELSE 2231 CALL diffusion_e( ddzu, dd2zu, ddzw, diss, e, km, l_grid, vpt, & 2232 pt_reference, rif, tend, zu, zw ) 2233 ENDIF 2234 ENDIF 2235 ENDIF 1840 CALL diffusion_e( pt, pt_reference ) 1841 ENDIF 1842 ELSE 1843 CALL diffusion_e( vpt, pt_reference ) 1844 ENDIF 1845 2236 1846 CALL production_e 2237 1847 … … 2249 1859 DO j = nys, nyn 2250 1860 DO k = nzb_s_inner(j,i)+1, nzt 2251 e_p(k,j,i) = ( 1 - sat ) * e_m(k,j,i) + sat * e(k,j,i) + & 2252 dt_3d * ( & 2253 sbt * tend(k,j,i) + tsc(3) * te_m(k,j,i) & 2254 ) 1861 e_p(k,j,i) = e(k,j,i) + dt_3d * ( sbt * tend(k,j,i) + & 1862 tsc(3) * te_m(k,j,i) ) 2255 1863 IF ( e_p(k,j,i) < 0.0 ) e_p(k,j,i) = 0.1 * e(k,j,i) 2256 1864 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
