Changeset 940 for palm/trunk/SOURCE/prognostic_equations.f90
- Timestamp:
- Jul 9, 2012 2:31:00 PM (12 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/prognostic_equations.f90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/prognostic_equations.f90
r786 r940 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! temperature equation can be switched off 7 7 ! 8 8 ! Former revisions: … … 159 159 !-- Calculate those variables needed in the tendency terms which need 160 160 !-- global communication 161 CALL calc_mean_profile( pt, 4 )162 IF ( ocean ) CALL calc_mean_profile( rho, 64 )163 IF ( humidity ) CALL calc_mean_profile( vpt, 44 )161 IF ( .NOT. neutral ) CALL calc_mean_profile( pt, 4 ) 162 IF ( ocean ) CALL calc_mean_profile( rho, 64 ) 163 IF ( humidity ) CALL calc_mean_profile( vpt, 44 ) 164 164 IF ( ( ws_scheme_mom .OR. ws_scheme_sca ) .AND. & 165 165 intermediate_timestep_count == 1 ) CALL ws_statistics … … 205 205 ENDIF 206 206 CALL coriolis( i, j, 1 ) 207 IF ( sloping_surface ) CALL buoyancy( i, j, pt, pt_reference, 1, 4 ) 207 IF ( sloping_surface .AND. .NOT. neutral ) THEN 208 CALL buoyancy( i, j, pt, pt_reference, 1, 4 ) 209 ENDIF 208 210 209 211 ! … … 375 377 ENDIF 376 378 CALL coriolis( i, j, 3 ) 377 IF ( ocean ) THEN 378 CALL buoyancy( i, j, rho, rho_reference, 3, 64 ) 379 ELSE 380 IF ( .NOT. humidity ) THEN 381 CALL buoyancy( i, j, pt, pt_reference, 3, 4 ) 382 ELSE 383 CALL buoyancy( i, j, vpt, pt_reference, 3, 44 ) 379 380 IF ( .NOT. neutral ) THEN 381 IF ( ocean ) THEN 382 CALL buoyancy( i, j, rho, rho_reference, 3, 64 ) 383 ELSE 384 IF ( .NOT. humidity ) THEN 385 CALL buoyancy( i, j, pt, pt_reference, 3, 4 ) 386 ELSE 387 CALL buoyancy( i, j, vpt, pt_reference, 3, 44 ) 388 ENDIF 384 389 ENDIF 385 390 ENDIF … … 422 427 423 428 ! 424 !-- potential temperature 425 CALL cpu_log( log_point(13), 'pt-equation', 'start' ) 426 427 ! 428 !-- pt-tendency terms with communication 429 sat = tsc(1) 430 sbt = tsc(2) 431 IF ( scalar_advec == 'bc-scheme' ) THEN 432 433 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 434 ! 435 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 436 !-- switched on. Thus: 437 sat = 1.0 438 sbt = 1.0 439 ENDIF 440 tend = 0.0 441 CALL advec_s_bc( pt, 'pt' ) 442 ELSE 443 IF ( tsc(2) /= 2.0 .AND. scalar_advec == 'ups-scheme' ) THEN 429 !-- If required, compute prognostic equation for potential temperature 430 IF ( .NOT. neutral ) THEN 431 432 CALL cpu_log( log_point(13), 'pt-equation', 'start' ) 433 434 ! 435 !-- pt-tendency terms with communication 436 sat = tsc(1) 437 sbt = tsc(2) 438 IF ( scalar_advec == 'bc-scheme' ) THEN 439 440 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 441 ! 442 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 443 !-- switched on. Thus: 444 sat = 1.0 445 sbt = 1.0 446 ENDIF 444 447 tend = 0.0 445 CALL advec_s_ups( pt, 'pt' ) 446 ENDIF 447 ENDIF 448 449 ! 450 !-- pt-tendency terms with no communication 451 DO i = nxl, nxr 452 DO j = nys, nyn 453 ! 454 !-- Tendency terms 455 IF ( scalar_advec == 'bc-scheme' ) THEN 456 CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, & 457 wall_heatflux, tend ) 458 ELSE 459 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 460 tend(:,j,i) = 0.0 461 IF ( ws_scheme_sca ) THEN 462 CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, & 463 diss_s_pt, flux_l_pt, diss_l_pt, i_omp_start, tn ) 464 ELSE 465 CALL advec_s_pw( i, j, pt ) 466 ENDIF 467 ELSE 468 IF ( scalar_advec /= 'ups-scheme' ) THEN 469 tend(:,j,i) = 0.0 470 CALL advec_s_up( i, j, pt ) 471 ENDIF 472 ENDIF 473 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 474 THEN 475 CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, & 476 tswst_m, wall_heatflux, tend ) 477 ELSE 448 CALL advec_s_bc( pt, 'pt' ) 449 ELSE 450 IF ( tsc(2) /= 2.0 .AND. scalar_advec == 'ups-scheme' ) THEN 451 tend = 0.0 452 CALL advec_s_ups( pt, 'pt' ) 453 ENDIF 454 ENDIF 455 456 ! 457 !-- pt-tendency terms with no communication 458 DO i = nxl, nxr 459 DO j = nys, nyn 460 ! 461 !-- Tendency terms 462 IF ( scalar_advec == 'bc-scheme' ) THEN 478 463 CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, & 479 464 wall_heatflux, tend ) 480 ENDIF 481 ENDIF 482 483 ! 484 !-- If required compute heating/cooling due to long wave radiation 485 !-- processes 486 IF ( radiation ) THEN 487 CALL calc_radiation( i, j ) 488 ENDIF 489 490 ! 491 !-- If required compute impact of latent heat due to precipitation 492 IF ( precipitation ) THEN 493 CALL impact_of_latent_heat( i, j ) 494 ENDIF 495 496 ! 497 !-- Consideration of heat sources within the plant canopy 498 IF ( plant_canopy .AND. ( cthf /= 0.0 ) ) THEN 499 CALL plant_canopy_model( i, j, 4 ) 500 ENDIF 501 502 ! 503 !-- If required compute influence of large-scale subsidence/ascent 504 IF ( large_scale_subsidence ) THEN 505 CALL subsidence ( i, j, tend, pt, pt_init ) 506 ENDIF 507 508 CALL user_actions( i, j, 'pt-tendency' ) 509 510 ! 511 !-- Prognostic equation for potential temperature 512 DO k = nzb_s_inner(j,i)+1, nzt 513 pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + & 514 dt_3d * ( & 515 sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) & 516 ) - & 517 tsc(5) * rdf_sc(k) * ( pt(k,j,i) - pt_init(k) ) 465 ELSE 466 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) & 467 THEN 468 tend(:,j,i) = 0.0 469 IF ( ws_scheme_sca ) THEN 470 CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, & 471 diss_s_pt, flux_l_pt, diss_l_pt, & 472 i_omp_start, tn ) 473 ELSE 474 CALL advec_s_pw( i, j, pt ) 475 ENDIF 476 ELSE 477 IF ( scalar_advec /= 'ups-scheme' ) THEN 478 tend(:,j,i) = 0.0 479 CALL advec_s_up( i, j, pt ) 480 ENDIF 481 ENDIF 482 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 483 THEN 484 CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, & 485 tswst_m, wall_heatflux, tend ) 486 ELSE 487 CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, & 488 wall_heatflux, tend ) 489 ENDIF 490 ENDIF 491 492 ! 493 !-- If required compute heating/cooling due to long wave radiation 494 !-- processes 495 IF ( radiation ) THEN 496 CALL calc_radiation( i, j ) 497 ENDIF 498 499 ! 500 !-- If required compute impact of latent heat due to precipitation 501 IF ( precipitation ) THEN 502 CALL impact_of_latent_heat( i, j ) 503 ENDIF 504 505 ! 506 !-- Consideration of heat sources within the plant canopy 507 IF ( plant_canopy .AND. ( cthf /= 0.0 ) ) THEN 508 CALL plant_canopy_model( i, j, 4 ) 509 ENDIF 510 511 ! 512 !-- If required compute influence of large-scale subsidence/ascent 513 IF ( large_scale_subsidence ) THEN 514 CALL subsidence( i, j, tend, pt, pt_init ) 515 ENDIF 516 517 CALL user_actions( i, j, 'pt-tendency' ) 518 519 ! 520 !-- Prognostic equation for potential temperature 521 DO k = nzb_s_inner(j,i)+1, nzt 522 pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + & 523 dt_3d * ( & 524 sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) & 525 ) - & 526 tsc(5) * rdf_sc(k) * ( pt(k,j,i) - pt_init(k) ) 527 ENDDO 528 529 ! 530 !-- Calculate tendencies for the next Runge-Kutta step 531 IF ( timestep_scheme(1:5) == 'runge' ) THEN 532 IF ( intermediate_timestep_count == 1 ) THEN 533 DO k = nzb_s_inner(j,i)+1, nzt 534 tpt_m(k,j,i) = tend(k,j,i) 535 ENDDO 536 ELSEIF ( intermediate_timestep_count < & 537 intermediate_timestep_count_max ) THEN 538 DO k = nzb_s_inner(j,i)+1, nzt 539 tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + & 540 5.3125 * tpt_m(k,j,i) 541 ENDDO 542 ENDIF 543 ENDIF 544 518 545 ENDDO 519 520 !521 !-- Calculate tendencies for the next Runge-Kutta step522 IF ( timestep_scheme(1:5) == 'runge' ) THEN523 IF ( intermediate_timestep_count == 1 ) THEN524 DO k = nzb_s_inner(j,i)+1, nzt525 tpt_m(k,j,i) = tend(k,j,i)526 ENDDO527 ELSEIF ( intermediate_timestep_count < &528 intermediate_timestep_count_max ) THEN529 DO k = nzb_s_inner(j,i)+1, nzt530 tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tpt_m(k,j,i)531 ENDDO532 ENDIF533 ENDIF534 535 546 ENDDO 536 ENDDO 537 538 CALL cpu_log( log_point(13), 'pt-equation', 'stop' ) 547 548 CALL cpu_log( log_point(13), 'pt-equation', 'stop' ) 549 550 ENDIF 539 551 540 552 ! … … 714 726 ! 715 727 !-- If required compute influence of large-scale subsidence/ascent 716 IF ( large_scale_subsidence ) THEN717 CALL subsidence 728 IF ( large_scale_subsidence ) THEN 729 CALL subsidence( i, j, tend, q, q_init ) 718 730 ENDIF 719 731 … … 936 948 !-- Calculate those variables needed in the tendency terms which need 937 949 !-- global communication 938 CALL calc_mean_profile( pt, 4 )939 IF ( ocean ) CALL calc_mean_profile( rho, 64 )940 IF ( humidity ) CALL calc_mean_profile( vpt, 44 )950 IF ( .NOT. neutral ) CALL calc_mean_profile( pt, 4 ) 951 IF ( ocean ) CALL calc_mean_profile( rho, 64 ) 952 IF ( humidity ) CALL calc_mean_profile( vpt, 44 ) 941 953 IF ( .NOT. constant_diffusion ) CALL production_e_init 942 954 IF ( ( ws_scheme_mom .OR. ws_scheme_sca ) .AND. & … … 989 1001 ENDIF 990 1002 CALL coriolis( i, j, 1 ) 991 IF ( sloping_surface ) CALL buoyancy( i, j, pt, pt_reference, 1, & 992 4 ) 1003 IF ( sloping_surface .AND. .NOT. neutral ) THEN 1004 CALL buoyancy( i, j, pt, pt_reference, 1, 4 ) 1005 ENDIF 993 1006 994 1007 ! … … 1121 1134 ENDIF 1122 1135 CALL coriolis( i, j, 3 ) 1123 IF ( ocean ) THEN 1124 CALL buoyancy( i, j, rho, rho_reference, 3, 64 ) 1125 ELSE 1126 IF ( .NOT. humidity ) THEN 1127 CALL buoyancy( i, j, pt, pt_reference, 3, 4 ) 1128 ELSE 1129 CALL buoyancy( i, j, vpt, pt_reference, 3, 44 ) 1136 1137 IF ( .NOT. neutral ) THEN 1138 IF ( ocean ) THEN 1139 CALL buoyancy( i, j, rho, rho_reference, 3, 64 ) 1140 ELSE 1141 IF ( .NOT. humidity ) THEN 1142 CALL buoyancy( i, j, pt, pt_reference, 3, 4 ) 1143 ELSE 1144 CALL buoyancy( i, j, vpt, pt_reference, 3, 44 ) 1145 ENDIF 1130 1146 ENDIF 1131 1147 ENDIF … … 1163 1179 1164 1180 ! 1165 !-- Tendency terms for potential temperature 1166 tend(:,j,i) = 0.0 1167 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1168 IF ( ws_scheme_sca ) THEN 1169 ! CALL local_diss( i, j, pt ) 1170 CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, & 1171 diss_s_pt, flux_l_pt, diss_l_pt, i_omp_start, tn ) 1172 ELSE 1173 CALL advec_s_pw( i, j, pt ) 1174 ENDIF 1175 ELSE 1176 CALL advec_s_up( i, j, pt ) 1177 ENDIF 1178 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 1179 THEN 1180 CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, & 1181 tswst_m, wall_heatflux, tend ) 1182 ELSE 1183 CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, & 1184 wall_heatflux, tend ) 1185 ENDIF 1186 1187 ! 1188 !-- If required compute heating/cooling due to long wave radiation 1189 !-- processes 1190 IF ( radiation ) THEN 1191 CALL calc_radiation( i, j ) 1192 ENDIF 1193 1194 ! 1195 !-- If required compute impact of latent heat due to precipitation 1196 IF ( precipitation ) THEN 1197 CALL impact_of_latent_heat( i, j ) 1198 ENDIF 1199 1200 ! 1201 !-- Consideration of heat sources within the plant canopy 1202 IF ( plant_canopy .AND. ( cthf /= 0.0 ) ) THEN 1203 CALL plant_canopy_model( i, j, 4 ) 1204 ENDIF 1205 1206 1207 !-- If required compute influence of large-scale subsidence/ascent 1208 IF ( large_scale_subsidence ) THEN 1209 CALL subsidence ( i, j, tend, pt, pt_init ) 1210 ENDIF 1211 1212 1213 CALL user_actions( i, j, 'pt-tendency' ) 1214 1215 ! 1216 !-- Prognostic equation for potential temperature 1217 DO k = nzb_s_inner(j,i)+1, nzt 1218 pt_p(k,j,i) = ( 1.0-tsc(1) ) * pt_m(k,j,i) + tsc(1)*pt(k,j,i) +& 1219 dt_3d * ( & 1220 tsc(2) * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) & 1221 ) - & 1222 tsc(5) * rdf_sc(k) * ( pt(k,j,i) - pt_init(k) ) 1223 ENDDO 1224 1225 ! 1226 !-- Calculate tendencies for the next Runge-Kutta step 1227 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1228 IF ( intermediate_timestep_count == 1 ) THEN 1229 DO k = nzb_s_inner(j,i)+1, nzt 1230 tpt_m(k,j,i) = tend(k,j,i) 1231 ENDDO 1232 ELSEIF ( intermediate_timestep_count < & 1233 intermediate_timestep_count_max ) THEN 1234 DO k = nzb_s_inner(j,i)+1, nzt 1235 tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + & 1236 5.3125 * tpt_m(k,j,i) 1237 ENDDO 1238 ENDIF 1181 !-- If required, compute prognostic equation for potential temperature 1182 IF ( .NOT. neutral ) THEN 1183 ! 1184 !-- Tendency terms for potential temperature 1185 tend(:,j,i) = 0.0 1186 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1187 IF ( ws_scheme_sca ) THEN 1188 CALL advec_s_ws( i, j, pt, 'pt', flux_s_pt, diss_s_pt, & 1189 flux_l_pt, diss_l_pt, i_omp_start, tn ) 1190 ELSE 1191 CALL advec_s_pw( i, j, pt ) 1192 ENDIF 1193 ELSE 1194 CALL advec_s_up( i, j, pt ) 1195 ENDIF 1196 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) & 1197 THEN 1198 CALL diffusion_s( i, j, ddzu, ddzw, kh_m, pt_m, shf_m, & 1199 tswst_m, wall_heatflux, tend ) 1200 ELSE 1201 CALL diffusion_s( i, j, ddzu, ddzw, kh, pt, shf, tswst, & 1202 wall_heatflux, tend ) 1203 ENDIF 1204 1205 ! 1206 !-- If required compute heating/cooling due to long wave radiation 1207 !-- processes 1208 IF ( radiation ) THEN 1209 CALL calc_radiation( i, j ) 1210 ENDIF 1211 1212 ! 1213 !-- If required compute impact of latent heat due to precipitation 1214 IF ( precipitation ) THEN 1215 CALL impact_of_latent_heat( i, j ) 1216 ENDIF 1217 1218 ! 1219 !-- Consideration of heat sources within the plant canopy 1220 IF ( plant_canopy .AND. ( cthf /= 0.0 ) ) THEN 1221 CALL plant_canopy_model( i, j, 4 ) 1222 ENDIF 1223 1224 ! 1225 !-- If required, compute influence of large-scale subsidence/ascent 1226 IF ( large_scale_subsidence ) THEN 1227 CALL subsidence( i, j, tend, pt, pt_init ) 1228 ENDIF 1229 1230 1231 CALL user_actions( i, j, 'pt-tendency' ) 1232 1233 ! 1234 !-- Prognostic equation for potential temperature 1235 DO k = nzb_s_inner(j,i)+1, nzt 1236 pt_p(k,j,i) = ( 1.0-tsc(1) ) * pt_m(k,j,i) + tsc(1)*pt(k,j,i) +& 1237 dt_3d * ( & 1238 tsc(2) * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) & 1239 ) - & 1240 tsc(5) * rdf_sc(k) * ( pt(k,j,i) - pt_init(k) ) 1241 ENDDO 1242 1243 ! 1244 !-- Calculate tendencies for the next Runge-Kutta step 1245 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1246 IF ( intermediate_timestep_count == 1 ) THEN 1247 DO k = nzb_s_inner(j,i)+1, nzt 1248 tpt_m(k,j,i) = tend(k,j,i) 1249 ENDDO 1250 ELSEIF ( intermediate_timestep_count < & 1251 intermediate_timestep_count_max ) THEN 1252 DO k = nzb_s_inner(j,i)+1, nzt 1253 tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + & 1254 5.3125 * tpt_m(k,j,i) 1255 ENDDO 1256 ENDIF 1257 ENDIF 1258 1239 1259 ENDIF 1240 1260 … … 1337 1357 1338 1358 !-- If required compute influence of large-scale subsidence/ascent 1339 IF ( large_scale_subsidence ) THEN1340 CALL subsidence 1359 IF ( large_scale_subsidence ) THEN 1360 CALL subsidence( i, j, tend, q, q_init ) 1341 1361 ENDIF 1342 1362 … … 1484 1504 !-- Calculate those variables needed in the tendency terms which need 1485 1505 !-- global communication 1486 CALL calc_mean_profile( pt, 4 )1487 IF ( ocean ) CALL calc_mean_profile( rho, 64 )1488 IF ( humidity ) CALL calc_mean_profile( vpt, 44 )1506 IF ( .NOT. neutral ) CALL calc_mean_profile( pt, 4 ) 1507 IF ( ocean ) CALL calc_mean_profile( rho, 64 ) 1508 IF ( humidity ) CALL calc_mean_profile( vpt, 44 ) 1489 1509 IF ( ( ws_scheme_mom .OR. ws_scheme_sca ) .AND. & 1490 1510 intermediate_timestep_count == 1 ) CALL ws_statistics … … 1523 1543 ENDIF 1524 1544 CALL coriolis( 1 ) 1525 IF ( sloping_surface ) CALL buoyancy( pt, pt_reference, 1, 4 ) 1545 IF ( sloping_surface .AND. .NOT. neutral ) THEN 1546 CALL buoyancy( pt, pt_reference, 1, 4 ) 1547 ENDIF 1526 1548 1527 1549 ! … … 1706 1728 ENDIF 1707 1729 CALL coriolis( 3 ) 1708 IF ( ocean ) THEN 1709 CALL buoyancy( rho, rho_reference, 3, 64 ) 1710 ELSE 1711 IF ( .NOT. humidity ) THEN 1712 CALL buoyancy( pt, pt_reference, 3, 4 ) 1730 1731 IF ( .NOT. neutral ) THEN 1732 IF ( ocean ) THEN 1733 CALL buoyancy( rho, rho_reference, 3, 64 ) 1713 1734 ELSE 1714 CALL buoyancy( vpt, pt_reference, 3, 44 ) 1735 IF ( .NOT. humidity ) THEN 1736 CALL buoyancy( pt, pt_reference, 3, 4 ) 1737 ELSE 1738 CALL buoyancy( vpt, pt_reference, 3, 44 ) 1739 ENDIF 1715 1740 ENDIF 1716 1741 ENDIF … … 1761 1786 CALL cpu_log( log_point(7), 'w-equation', 'stop' ) 1762 1787 1763 ! 1764 !-- potential temperature 1765 CALL cpu_log( log_point(13), 'pt-equation', 'start' ) 1766 1767 ! 1768 !-- pt-tendency terms with communication 1769 sat = tsc(1) 1770 sbt = tsc(2) 1771 IF ( scalar_advec == 'bc-scheme' ) THEN 1772 1773 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1774 ! 1775 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 1776 !-- switched on. Thus: 1777 sat = 1.0 1778 sbt = 1.0 1779 ENDIF 1780 tend = 0.0 1781 CALL advec_s_bc( pt, 'pt' ) 1782 ELSE 1783 IF ( tsc(2) /= 2.0 .AND. scalar_advec == 'ups-scheme' ) THEN 1788 1789 ! 1790 !-- If required, compute prognostic equation for potential temperature 1791 IF ( .NOT. neutral ) THEN 1792 1793 CALL cpu_log( log_point(13), 'pt-equation', 'start' ) 1794 1795 ! 1796 !-- pt-tendency terms with communication 1797 sat = tsc(1) 1798 sbt = tsc(2) 1799 IF ( scalar_advec == 'bc-scheme' ) THEN 1800 1801 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1802 ! 1803 !-- Bott-Chlond scheme always uses Euler time step when leapfrog is 1804 !-- switched on. Thus: 1805 sat = 1.0 1806 sbt = 1.0 1807 ENDIF 1784 1808 tend = 0.0 1785 CALL advec_s_ups( pt, 'pt' ) 1786 ENDIF 1787 ENDIF 1788 1789 ! 1790 !-- pt-tendency terms with no communication 1791 IF ( scalar_advec == 'bc-scheme' ) THEN 1792 CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, wall_heatflux, & 1793 tend ) 1794 ELSE 1795 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1796 tend = 0.0 1797 IF ( ws_scheme_sca ) THEN 1798 CALL advec_s_ws( pt, 'pt' ) 1799 ELSE 1800 CALL advec_s_pw( pt ) 1801 ENDIF 1809 CALL advec_s_bc( pt, 'pt' ) 1802 1810 ELSE 1803 IF ( scalar_advec /= 'ups-scheme' ) THEN1811 IF ( tsc(2) /= 2.0 .AND. scalar_advec == 'ups-scheme' ) THEN 1804 1812 tend = 0.0 1805 CALL advec_s_up ( pt)1806 ENDIF 1807 ENDIF 1808 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 1809 CALL diffusion_s( ddzu, ddzw, kh_m, pt_m, shf_m, tswst_m, & 1810 wall_heatflux, tend ) 1811 ELSE1813 CALL advec_s_ups( pt, 'pt' ) 1814 ENDIF 1815 ENDIF 1816 1817 ! 1818 !-- pt-tendency terms with no communication 1819 IF ( scalar_advec == 'bc-scheme' ) THEN 1812 1820 CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, wall_heatflux, & 1813 1821 tend ) 1814 ENDIF 1815 ENDIF 1816 1817 ! 1818 !-- If required compute heating/cooling due to long wave radiation 1819 !-- processes 1820 IF ( radiation ) THEN 1821 CALL calc_radiation 1822 ENDIF 1823 1824 ! 1825 !-- If required compute impact of latent heat due to precipitation 1826 IF ( precipitation ) THEN 1827 CALL impact_of_latent_heat 1828 ENDIF 1829 1830 ! 1831 !-- Consideration of heat sources within the plant canopy 1832 IF ( plant_canopy .AND. ( cthf /= 0.0 ) ) THEN 1833 CALL plant_canopy_model( 4 ) 1834 ENDIF 1835 1836 !--If required compute influence of large-scale subsidence/ascent 1837 IF ( large_scale_subsidence ) THEN 1838 CALL subsidence ( tend, pt, pt_init ) 1839 ENDIF 1840 1841 CALL user_actions( 'pt-tendency' ) 1842 1843 ! 1844 !-- Prognostic equation for potential temperature 1845 DO i = nxl, nxr 1846 DO j = nys, nyn 1847 DO k = nzb_s_inner(j,i)+1, nzt 1848 pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + & 1849 dt_3d * ( & 1850 sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) & 1851 ) - & 1852 tsc(5) * rdf_sc(k) * ( pt(k,j,i) - pt_init(k) ) 1822 ELSE 1823 IF ( tsc(2) == 2.0 .OR. timestep_scheme(1:5) == 'runge' ) THEN 1824 tend = 0.0 1825 IF ( ws_scheme_sca ) THEN 1826 CALL advec_s_ws( pt, 'pt' ) 1827 ELSE 1828 CALL advec_s_pw( pt ) 1829 ENDIF 1830 ELSE 1831 IF ( scalar_advec /= 'ups-scheme' ) THEN 1832 tend = 0.0 1833 CALL advec_s_up( pt ) 1834 ENDIF 1835 ENDIF 1836 IF ( tsc(2) == 2.0 .AND. timestep_scheme(1:8) == 'leapfrog' ) THEN 1837 CALL diffusion_s( ddzu, ddzw, kh_m, pt_m, shf_m, tswst_m, & 1838 wall_heatflux, tend ) 1839 ELSE 1840 CALL diffusion_s( ddzu, ddzw, kh, pt, shf, tswst, wall_heatflux, & 1841 tend ) 1842 ENDIF 1843 ENDIF 1844 1845 ! 1846 !-- If required compute heating/cooling due to long wave radiation processes 1847 IF ( radiation ) THEN 1848 CALL calc_radiation 1849 ENDIF 1850 1851 ! 1852 !-- If required compute impact of latent heat due to precipitation 1853 IF ( precipitation ) THEN 1854 CALL impact_of_latent_heat 1855 ENDIF 1856 1857 ! 1858 !-- Consideration of heat sources within the plant canopy 1859 IF ( plant_canopy .AND. ( cthf /= 0.0 ) ) THEN 1860 CALL plant_canopy_model( 4 ) 1861 ENDIF 1862 1863 ! 1864 !-- If required compute influence of large-scale subsidence/ascent 1865 IF ( large_scale_subsidence ) THEN 1866 CALL subsidence( tend, pt, pt_init ) 1867 ENDIF 1868 1869 CALL user_actions( 'pt-tendency' ) 1870 1871 ! 1872 !-- Prognostic equation for potential temperature 1873 DO i = nxl, nxr 1874 DO j = nys, nyn 1875 DO k = nzb_s_inner(j,i)+1, nzt 1876 pt_p(k,j,i) = ( 1 - sat ) * pt_m(k,j,i) + sat * pt(k,j,i) + & 1877 dt_3d * ( & 1878 sbt * tend(k,j,i) + tsc(3) * tpt_m(k,j,i) & 1879 ) - & 1880 tsc(5) * rdf_sc(k) * ( pt(k,j,i) - pt_init(k) ) 1881 ENDDO 1853 1882 ENDDO 1854 1883 ENDDO 1855 ENDDO 1856 1857 ! 1858 !-- Calculate tendencies for the next Runge-Kutta step 1859 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1860 IF ( intermediate_timestep_count == 1 ) THEN 1861 DO i = nxl, nxr 1862 DO j = nys, nyn 1863 DO k = nzb_s_inner(j,i)+1, nzt 1864 tpt_m(k,j,i) = tend(k,j,i) 1865 ENDDO 1866 ENDDO 1867 ENDDO 1868 ELSEIF ( intermediate_timestep_count < & 1869 intermediate_timestep_count_max ) THEN 1870 DO i = nxl, nxr 1871 DO j = nys, nyn 1872 DO k = nzb_s_inner(j,i)+1, nzt 1873 tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + 5.3125 * tpt_m(k,j,i) 1874 ENDDO 1875 ENDDO 1876 ENDDO 1877 ENDIF 1878 ENDIF 1879 1880 CALL cpu_log( log_point(13), 'pt-equation', 'stop' ) 1884 1885 ! 1886 !-- Calculate tendencies for the next Runge-Kutta step 1887 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1888 IF ( intermediate_timestep_count == 1 ) THEN 1889 DO i = nxl, nxr 1890 DO j = nys, nyn 1891 DO k = nzb_s_inner(j,i)+1, nzt 1892 tpt_m(k,j,i) = tend(k,j,i) 1893 ENDDO 1894 ENDDO 1895 ENDDO 1896 ELSEIF ( intermediate_timestep_count < & 1897 intermediate_timestep_count_max ) THEN 1898 DO i = nxl, nxr 1899 DO j = nys, nyn 1900 DO k = nzb_s_inner(j,i)+1, nzt 1901 tpt_m(k,j,i) = -9.5625 * tend(k,j,i) + & 1902 5.3125 * tpt_m(k,j,i) 1903 ENDDO 1904 ENDDO 1905 ENDDO 1906 ENDIF 1907 ENDIF 1908 1909 CALL cpu_log( log_point(13), 'pt-equation', 'stop' ) 1910 1911 ENDIF 1881 1912 1882 1913 ! … … 2054 2085 ! 2055 2086 !-- If required compute influence of large-scale subsidence/ascent 2056 IF ( large_scale_subsidence ) THEN2057 CALL subsidence 2087 IF ( large_scale_subsidence ) THEN 2088 CALL subsidence( tend, q, q_init ) 2058 2089 ENDIF 2059 2090
Note: See TracChangeset
for help on using the changeset viewer.
