Changeset 3870
- Timestamp:
- Apr 8, 2019 1:44:34 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 5 edited
-
Makefile (modified) (2 diffs)
-
advec_ws.f90 (modified) (10 diffs)
-
bulk_cloud_model_mod.f90 (modified) (12 diffs)
-
module_interface.f90 (modified) (5 diffs)
-
prognostic_equations.f90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r3864 r3870 776 776 modules.o 777 777 advec_ws.o: \ 778 bulk_cloud_model_mod.o \779 778 mod_kinds.o \ 780 779 modules.o \ … … 815 814 basic_constants_and_equations_mod.o \ 816 815 cpulog_mod.o \ 816 advec_ws.o \ 817 advec_s_bc.o \ 818 advec_s_pw.o \ 819 advec_s_up.o \ 820 diffusion_s.o \ 817 821 mod_kinds.o \ 818 822 modules.o \ -
palm/trunk/SOURCE/advec_ws.f90
r3864 r3870 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Moving initialization of bcm specific flux arrays into bulk_cloud_model_mod 28 ! 29 ! 3864 2019-04-05 09:01:56Z monakurppa 27 30 ! Remove tailing white spaces 28 31 ! … … 325 328 326 329 USE arrays_3d, & 327 ONLY: diss_l_diss, diss_l_e, diss_l_ nc, diss_l_nr, diss_l_pt, &328 diss_l_q, diss_l_ qc, diss_l_qr, diss_l_s, diss_l_sa, &330 ONLY: diss_l_diss, diss_l_e, diss_l_pt, & 331 diss_l_q, diss_l_s, diss_l_sa, & 329 332 diss_l_u, diss_l_v, diss_l_w, flux_l_diss, flux_l_e, & 330 flux_l_ nc, flux_l_nr, flux_l_pt, flux_l_q, flux_l_qc,&331 flux_l_ qr, flux_l_s, flux_l_sa, flux_l_u, flux_l_v, &332 flux_l_w, diss_s_diss, diss_s_e, diss_s_nc, diss_s_nr,&333 diss_s_pt, diss_s_q, diss_s_ qc, diss_s_qr, diss_s_s, &333 flux_l_pt, flux_l_q, & 334 flux_l_s, flux_l_sa, flux_l_u, flux_l_v, & 335 flux_l_w, diss_s_diss, diss_s_e, & 336 diss_s_pt, diss_s_q, diss_s_s, & 334 337 diss_s_sa, diss_s_u, diss_s_v, diss_s_w, flux_s_diss, & 335 flux_s_e, flux_s_ nc, flux_s_nr, flux_s_pt, flux_s_q, &336 flux_s_ qc, flux_s_qr, flux_s_s, flux_s_sa, flux_s_u, &338 flux_s_e, flux_s_pt, flux_s_q, & 339 flux_s_s, flux_s_sa, flux_s_u, & 337 340 flux_s_v, flux_s_w 338 341 … … 346 349 USE kinds 347 350 348 USE bulk_cloud_model_mod, &349 ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert350 351 351 USE pegrid 352 352 … … 355 355 356 356 USE statistics, & 357 ONLY: sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsncs_ws_l,&358 sums_ws nrs_ws_l,sums_wspts_ws_l, sums_wsqcs_ws_l, &359 sums_wsq rs_ws_l, sums_wsqs_ws_l, sums_wsss_ws_l, &357 ONLY: sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l,& 358 sums_wspts_ws_l, & 359 sums_wsqs_ws_l, sums_wsss_ws_l, & 360 360 sums_wssas_ws_l, sums_wsss_ws_l, sums_wsus_ws_l, & 361 361 sums_wsvs_ws_l … … 397 397 sums_wsqs_ws_l = 0.0_wp 398 398 ENDIF 399 399 400 400 IF ( passive_scalar ) THEN 401 401 ALLOCATE( sums_wsss_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 402 402 sums_wsss_ws_l = 0.0_wp 403 ENDIF404 405 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN406 ALLOCATE( sums_wsqcs_ws_l(nzb:nzt+1,0:threads_per_task-1) )407 ALLOCATE( sums_wsncs_ws_l(nzb:nzt+1,0:threads_per_task-1) )408 sums_wsqcs_ws_l = 0.0_wp409 sums_wsncs_ws_l = 0.0_wp410 ENDIF411 412 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN413 ALLOCATE( sums_wsqrs_ws_l(nzb:nzt+1,0:threads_per_task-1) )414 ALLOCATE( sums_wsnrs_ws_l(nzb:nzt+1,0:threads_per_task-1) )415 sums_wsqrs_ws_l = 0.0_wp416 sums_wsnrs_ws_l = 0.0_wp417 403 ENDIF 418 404 … … 477 463 diss_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 478 464 ENDIF 479 465 480 466 IF ( passive_scalar ) THEN 481 467 ALLOCATE( flux_s_s(nzb+1:nzt,0:threads_per_task-1), & … … 483 469 ALLOCATE( flux_l_s(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 484 470 diss_l_s(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 485 ENDIF486 487 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN488 ALLOCATE( flux_s_qc(nzb+1:nzt,0:threads_per_task-1), &489 diss_s_qc(nzb+1:nzt,0:threads_per_task-1), &490 flux_s_nc(nzb+1:nzt,0:threads_per_task-1), &491 diss_s_nc(nzb+1:nzt,0:threads_per_task-1) )492 ALLOCATE( flux_l_qc(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &493 diss_l_qc(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &494 flux_l_nc(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &495 diss_l_nc(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )496 ENDIF497 498 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN499 ALLOCATE( flux_s_qr(nzb+1:nzt,0:threads_per_task-1), &500 diss_s_qr(nzb+1:nzt,0:threads_per_task-1), &501 flux_s_nr(nzb+1:nzt,0:threads_per_task-1), &502 diss_s_nr(nzb+1:nzt,0:threads_per_task-1) )503 ALLOCATE( flux_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &504 diss_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &505 flux_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), &506 diss_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )507 471 ENDIF 508 472 … … 1140 1104 ws_scheme_sca, salsa 1141 1105 1142 USE kinds 1143 1144 USE bulk_cloud_model_mod, & 1145 ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert 1106 USE kinds 1146 1107 1147 1108 USE salsa_util_mod, & … … 1149 1110 1150 1111 USE statistics, & 1151 ONLY: sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsncs_ws_l,&1152 sums_ws nrs_ws_l, sums_wspts_ws_l, sums_wsqcs_ws_l, &1153 sums_wsq rs_ws_l, sums_wsqs_ws_l, sums_wsss_ws_l, &1112 ONLY: sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, & 1113 sums_wspts_ws_l, & 1114 sums_wsqs_ws_l, sums_wsss_ws_l, & 1154 1115 sums_wssas_ws_l, sums_wsus_ws_l, sums_wsvs_ws_l 1155 1116 … … 1177 1138 IF ( humidity ) sums_wsqs_ws_l = 0.0_wp 1178 1139 IF ( passive_scalar ) sums_wsss_ws_l = 0.0_wp 1179 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN1180 sums_wsqcs_ws_l = 0.0_wp1181 sums_wsncs_ws_l = 0.0_wp1182 ENDIF1183 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN1184 sums_wsqrs_ws_l = 0.0_wp1185 sums_wsnrs_ws_l = 0.0_wp1186 ENDIF1187 1140 IF ( ocean_mode ) sums_wssas_ws_l = 0.0_wp 1188 1141 IF ( salsa ) sums_salsa_ws_l = 0.0_wp -
palm/trunk/SOURCE/bulk_cloud_model_mod.f90
r3869 r3870 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Moving prognostic equations of bcm into bulk_cloud_model_mod 28 ! 29 ! 3869 2019-04-08 11:54:20Z knoop 27 30 ! moving the furniture around ;-) 28 31 ! … … 199 202 MODULE bulk_cloud_model_mod 200 203 204 205 USE advec_s_bc_mod, & 206 ONLY: advec_s_bc 207 208 USE advec_s_pw_mod, & 209 ONLY: advec_s_pw 210 211 USE advec_s_up_mod, & 212 ONLY: advec_s_up 213 214 USE advec_ws, & 215 ONLY: advec_s_ws 216 201 217 USE arrays_3d, & 202 218 ONLY: ddzu, diss, dzu, dzw, hyp, hyrho, & … … 204 220 precipitation_amount, prr, pt, d_exner, pt_init, q, ql, ql_1, & 205 221 qc, qc_1, qc_2, qc_3, qc_p, qr, qr_1, qr_2, qr_3, qr_p, & 206 exner, zu, tnc_m, tnr_m, tqc_m, tqr_m 222 exner, zu, tnc_m, tnr_m, tqc_m, tqr_m, tend, rdf_sc, & 223 flux_l_qc, flux_l_qr, flux_l_nc, flux_l_nr, & 224 flux_s_qc, flux_s_qr, flux_s_nc, flux_s_nr, & 225 diss_l_qc, diss_l_qr, diss_l_nc, diss_l_nr, & 226 diss_s_qc, diss_s_qr, diss_s_nc, diss_s_nr 207 227 208 228 USE averaging, & … … 219 239 intermediate_timestep_count_max, large_scale_forcing, & 220 240 lsf_surf, pt_surface, rho_surface, surface_pressure, & 221 time_do2d_xy, message_string, initializing_actions 241 time_do2d_xy, message_string, initializing_actions, & 242 ws_scheme_sca, scalar_advec, timestep_scheme, tsc, loop_optimization 222 243 223 244 USE cpulog, & 224 ONLY: cpu_log, log_point_s 245 ONLY: cpu_log, log_point, log_point_s 246 247 USE diffusion_s_mod, & 248 ONLY: diffusion_s 225 249 226 250 USE grid_variables, & … … 231 255 wall_flags_0 232 256 233 USE kinds 257 USE kinds 258 259 USE pegrid, & 260 ONLY: threads_per_task 234 261 235 262 USE statistics, & 236 ONLY: weight_pres, weight_substep 263 ONLY: weight_pres, weight_substep, sums_wsncs_ws_l, sums_wsnrs_ws_l, sums_wsqcs_ws_l, sums_wsqrs_ws_l 237 264 238 265 USE surface_mod, & 239 266 ONLY : bc_h, get_topography_top_index_ji, surf_bulk_cloud_model, & 240 surf_microphysics_morrison, surf_microphysics_seifert 267 surf_microphysics_morrison, surf_microphysics_seifert, & 268 surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v 241 269 242 270 IMPLICIT NONE … … 332 360 bcm_header, & 333 361 bcm_actions, & 362 bcm_actions_micro, & 363 bcm_prognostic_equations, & 334 364 bcm_3d_data_averaging, & 335 365 bcm_data_output_2d, & … … 389 419 MODULE PROCEDURE bcm_actions_ij 390 420 END INTERFACE bcm_actions 421 422 INTERFACE bcm_actions_micro 423 MODULE PROCEDURE bcm_actions_micro 424 MODULE PROCEDURE bcm_actions_micro_ij 425 END INTERFACE bcm_actions_micro 426 427 INTERFACE bcm_prognostic_equations 428 MODULE PROCEDURE bcm_prognostic_equations 429 MODULE PROCEDURE bcm_prognostic_equations_ij 430 END INTERFACE bcm_prognostic_equations 391 431 392 432 INTERFACE bcm_swap_timelevel … … 807 847 ENDIF 808 848 849 IF ( ws_scheme_sca ) THEN 850 851 IF ( microphysics_morrison ) THEN 852 ALLOCATE( sums_wsqcs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 853 ALLOCATE( sums_wsncs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 854 sums_wsqcs_ws_l = 0.0_wp 855 sums_wsncs_ws_l = 0.0_wp 856 ENDIF 857 858 IF ( microphysics_seifert ) THEN 859 ALLOCATE( sums_wsqrs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 860 ALLOCATE( sums_wsnrs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 861 sums_wsqrs_ws_l = 0.0_wp 862 sums_wsnrs_ws_l = 0.0_wp 863 ENDIF 864 865 ENDIF 866 867 ! 868 !-- Arrays needed for reasons of speed optimization for cache version. 869 !-- For the vector version the buffer arrays are not necessary, 870 !-- because the the fluxes can swapped directly inside the loops of the 871 !-- advection routines. 872 IF ( loop_optimization /= 'vector' ) THEN 873 874 IF ( ws_scheme_sca ) THEN 875 876 IF ( microphysics_morrison ) THEN 877 ALLOCATE( flux_s_qc(nzb+1:nzt,0:threads_per_task-1), & 878 diss_s_qc(nzb+1:nzt,0:threads_per_task-1), & 879 flux_s_nc(nzb+1:nzt,0:threads_per_task-1), & 880 diss_s_nc(nzb+1:nzt,0:threads_per_task-1) ) 881 ALLOCATE( flux_l_qc(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 882 diss_l_qc(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 883 flux_l_nc(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 884 diss_l_nc(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 885 ENDIF 886 887 IF ( microphysics_seifert ) THEN 888 ALLOCATE( flux_s_qr(nzb+1:nzt,0:threads_per_task-1), & 889 diss_s_qr(nzb+1:nzt,0:threads_per_task-1), & 890 flux_s_nr(nzb+1:nzt,0:threads_per_task-1), & 891 diss_s_nr(nzb+1:nzt,0:threads_per_task-1) ) 892 ALLOCATE( flux_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 893 diss_l_qr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 894 flux_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 895 diss_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 896 ENDIF 897 898 ENDIF 899 900 ENDIF 901 809 902 ! 810 903 !-- Initial assignment of the pointers … … 1004 1097 !> Control of microphysics for all grid points 1005 1098 !------------------------------------------------------------------------------! 1006 SUBROUTINE bcm_actions 1099 SUBROUTINE bcm_actions( location ) 1100 1101 1102 CHARACTER (LEN=*), INTENT(IN) :: location !< call location string 1103 1104 SELECT CASE ( location ) 1105 1106 CASE ( 'before_timestep' ) 1107 1108 IF ( ws_scheme_sca ) THEN 1109 1110 IF ( microphysics_morrison ) THEN 1111 sums_wsqcs_ws_l = 0.0_wp 1112 sums_wsncs_ws_l = 0.0_wp 1113 ENDIF 1114 IF ( microphysics_seifert ) THEN 1115 sums_wsqrs_ws_l = 0.0_wp 1116 sums_wsnrs_ws_l = 0.0_wp 1117 ENDIF 1118 1119 ENDIF 1120 1121 CASE DEFAULT 1122 CONTINUE 1123 1124 END SELECT 1125 1126 END SUBROUTINE bcm_actions 1127 1128 1129 !------------------------------------------------------------------------------! 1130 ! Description: 1131 ! ------------ 1132 !> Control of microphysics for grid points i,j 1133 !------------------------------------------------------------------------------! 1134 1135 SUBROUTINE bcm_actions_ij( i, j, location ) 1136 1137 1138 INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction 1139 INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction 1140 CHARACTER (LEN=*), INTENT(IN) :: location !< call location string 1141 INTEGER(iwp) :: dummy !< call location string 1142 1143 IF ( bulk_cloud_model ) dummy = i + j 1144 1145 SELECT CASE ( location ) 1146 1147 CASE ( 'before_timestep' ) 1148 1149 IF ( ws_scheme_sca ) THEN 1150 1151 IF ( microphysics_morrison ) THEN 1152 sums_wsqcs_ws_l = 0.0_wp 1153 sums_wsncs_ws_l = 0.0_wp 1154 ENDIF 1155 IF ( microphysics_seifert ) THEN 1156 sums_wsqrs_ws_l = 0.0_wp 1157 sums_wsnrs_ws_l = 0.0_wp 1158 ENDIF 1159 1160 ENDIF 1161 1162 CASE DEFAULT 1163 CONTINUE 1164 1165 END SELECT 1166 1167 1168 END SUBROUTINE bcm_actions_ij 1169 1170 1171 !------------------------------------------------------------------------------! 1172 ! Description: 1173 ! ------------ 1174 !> Control of microphysics for all grid points 1175 !------------------------------------------------------------------------------! 1176 SUBROUTINE bcm_actions_micro 1007 1177 1008 1178 IMPLICIT NONE … … 1055 1225 CALL calc_precipitation_amount 1056 1226 1057 END SUBROUTINE bcm_actions 1227 END SUBROUTINE bcm_actions_micro 1058 1228 1059 1229 … … 1064 1234 !------------------------------------------------------------------------------! 1065 1235 1066 SUBROUTINE bcm_actions_ ij( i, j )1236 SUBROUTINE bcm_actions_micro_ij( i, j ) 1067 1237 1068 1238 IMPLICIT NONE … … 1117 1287 CALL calc_precipitation_amount_ij( i,j ) 1118 1288 1119 END SUBROUTINE bcm_actions_ij 1289 END SUBROUTINE bcm_actions_micro_ij 1290 1291 1292 !------------------------------------------------------------------------------! 1293 ! Description: 1294 ! ------------ 1295 !> Control of microphysics for all grid points 1296 !------------------------------------------------------------------------------! 1297 SUBROUTINE bcm_prognostic_equations 1298 1299 1300 INTEGER(iwp) :: i !< grid index in x-direction 1301 INTEGER(iwp) :: j !< grid index in y-direction 1302 INTEGER(iwp) :: k !< grid index in z-direction 1303 1304 REAL(wp) :: sbt !< 1305 1306 ! 1307 !-- If required, calculate prognostic equations for cloud water content 1308 !-- and cloud drop concentration 1309 IF ( microphysics_morrison ) THEN 1310 1311 CALL cpu_log( log_point(67), 'qc-equation', 'start' ) 1312 1313 ! 1314 !-- Calculate prognostic equation for cloud water content 1315 sbt = tsc(2) 1316 IF ( scalar_advec == 'bc-scheme' ) THEN 1317 1318 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1319 ! 1320 !-- Bott-Chlond scheme always uses Euler time step. Thus: 1321 sbt = 1.0_wp 1322 ENDIF 1323 tend = 0.0_wp 1324 CALL advec_s_bc( qc, 'qc' ) 1325 1326 ENDIF 1327 1328 ! 1329 !-- qc-tendency terms with no communication 1330 IF ( scalar_advec /= 'bc-scheme' ) THEN 1331 tend = 0.0_wp 1332 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1333 IF ( ws_scheme_sca ) THEN 1334 CALL advec_s_ws( qc, 'qc' ) 1335 ELSE 1336 CALL advec_s_pw( qc ) 1337 ENDIF 1338 ELSE 1339 CALL advec_s_up( qc ) 1340 ENDIF 1341 ENDIF 1342 1343 CALL diffusion_s( qc, & 1344 surf_def_h(0)%qcsws, surf_def_h(1)%qcsws, & 1345 surf_def_h(2)%qcsws, & 1346 surf_lsm_h%qcsws, surf_usm_h%qcsws, & 1347 surf_def_v(0)%qcsws, surf_def_v(1)%qcsws, & 1348 surf_def_v(2)%qcsws, surf_def_v(3)%qcsws, & 1349 surf_lsm_v(0)%qcsws, surf_lsm_v(1)%qcsws, & 1350 surf_lsm_v(2)%qcsws, surf_lsm_v(3)%qcsws, & 1351 surf_usm_v(0)%qcsws, surf_usm_v(1)%qcsws, & 1352 surf_usm_v(2)%qcsws, surf_usm_v(3)%qcsws ) 1353 1354 ! 1355 !-- Prognostic equation for cloud water content 1356 DO i = nxl, nxr 1357 DO j = nys, nyn 1358 DO k = nzb+1, nzt 1359 qc_p(k,j,i) = qc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & 1360 tsc(3) * tqc_m(k,j,i) ) & 1361 - tsc(5) * rdf_sc(k) * & 1362 qc(k,j,i) & 1363 ) & 1364 * MERGE( 1.0_wp, 0.0_wp, & 1365 BTEST( wall_flags_0(k,j,i), 0 ) & 1366 ) 1367 IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp 1368 ENDDO 1369 ENDDO 1370 ENDDO 1371 1372 ! 1373 !-- Calculate tendencies for the next Runge-Kutta step 1374 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1375 IF ( intermediate_timestep_count == 1 ) THEN 1376 DO i = nxl, nxr 1377 DO j = nys, nyn 1378 DO k = nzb+1, nzt 1379 tqc_m(k,j,i) = tend(k,j,i) 1380 ENDDO 1381 ENDDO 1382 ENDDO 1383 ELSEIF ( intermediate_timestep_count < & 1384 intermediate_timestep_count_max ) THEN 1385 DO i = nxl, nxr 1386 DO j = nys, nyn 1387 DO k = nzb+1, nzt 1388 tqc_m(k,j,i) = -9.5625_wp * tend(k,j,i) & 1389 + 5.3125_wp * tqc_m(k,j,i) 1390 ENDDO 1391 ENDDO 1392 ENDDO 1393 ENDIF 1394 ENDIF 1395 1396 CALL cpu_log( log_point(67), 'qc-equation', 'stop' ) 1397 1398 CALL cpu_log( log_point(68), 'nc-equation', 'start' ) 1399 ! 1400 !-- Calculate prognostic equation for cloud drop concentration 1401 sbt = tsc(2) 1402 IF ( scalar_advec == 'bc-scheme' ) THEN 1403 1404 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1405 ! 1406 !-- Bott-Chlond scheme always uses Euler time step. Thus: 1407 sbt = 1.0_wp 1408 ENDIF 1409 tend = 0.0_wp 1410 CALL advec_s_bc( nc, 'nc' ) 1411 1412 ENDIF 1413 1414 ! 1415 !-- nc-tendency terms with no communication 1416 IF ( scalar_advec /= 'bc-scheme' ) THEN 1417 tend = 0.0_wp 1418 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1419 IF ( ws_scheme_sca ) THEN 1420 CALL advec_s_ws( nc, 'nc' ) 1421 ELSE 1422 CALL advec_s_pw( nc ) 1423 ENDIF 1424 ELSE 1425 CALL advec_s_up( nc ) 1426 ENDIF 1427 ENDIF 1428 1429 CALL diffusion_s( nc, & 1430 surf_def_h(0)%ncsws, surf_def_h(1)%ncsws, & 1431 surf_def_h(2)%ncsws, & 1432 surf_lsm_h%ncsws, surf_usm_h%ncsws, & 1433 surf_def_v(0)%ncsws, surf_def_v(1)%ncsws, & 1434 surf_def_v(2)%ncsws, surf_def_v(3)%ncsws, & 1435 surf_lsm_v(0)%ncsws, surf_lsm_v(1)%ncsws, & 1436 surf_lsm_v(2)%ncsws, surf_lsm_v(3)%ncsws, & 1437 surf_usm_v(0)%ncsws, surf_usm_v(1)%ncsws, & 1438 surf_usm_v(2)%ncsws, surf_usm_v(3)%ncsws ) 1439 1440 ! 1441 !-- Prognostic equation for cloud drop concentration 1442 DO i = nxl, nxr 1443 DO j = nys, nyn 1444 DO k = nzb+1, nzt 1445 nc_p(k,j,i) = nc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & 1446 tsc(3) * tnc_m(k,j,i) ) & 1447 - tsc(5) * rdf_sc(k) * & 1448 nc(k,j,i) & 1449 ) & 1450 * MERGE( 1.0_wp, 0.0_wp, & 1451 BTEST( wall_flags_0(k,j,i), 0 ) & 1452 ) 1453 IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp 1454 ENDDO 1455 ENDDO 1456 ENDDO 1457 1458 ! 1459 !-- Calculate tendencies for the next Runge-Kutta step 1460 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1461 IF ( intermediate_timestep_count == 1 ) THEN 1462 DO i = nxl, nxr 1463 DO j = nys, nyn 1464 DO k = nzb+1, nzt 1465 tnc_m(k,j,i) = tend(k,j,i) 1466 ENDDO 1467 ENDDO 1468 ENDDO 1469 ELSEIF ( intermediate_timestep_count < & 1470 intermediate_timestep_count_max ) THEN 1471 DO i = nxl, nxr 1472 DO j = nys, nyn 1473 DO k = nzb+1, nzt 1474 tnc_m(k,j,i) = -9.5625_wp * tend(k,j,i) & 1475 + 5.3125_wp * tnc_m(k,j,i) 1476 ENDDO 1477 ENDDO 1478 ENDDO 1479 ENDIF 1480 ENDIF 1481 1482 CALL cpu_log( log_point(68), 'nc-equation', 'stop' ) 1483 1484 ENDIF 1485 ! 1486 !-- If required, calculate prognostic equations for rain water content 1487 !-- and rain drop concentration 1488 IF ( microphysics_seifert ) THEN 1489 1490 CALL cpu_log( log_point(52), 'qr-equation', 'start' ) 1491 1492 ! 1493 !-- Calculate prognostic equation for rain water content 1494 sbt = tsc(2) 1495 IF ( scalar_advec == 'bc-scheme' ) THEN 1496 1497 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1498 ! 1499 !-- Bott-Chlond scheme always uses Euler time step. Thus: 1500 sbt = 1.0_wp 1501 ENDIF 1502 tend = 0.0_wp 1503 CALL advec_s_bc( qr, 'qr' ) 1504 1505 ENDIF 1506 1507 ! 1508 !-- qr-tendency terms with no communication 1509 IF ( scalar_advec /= 'bc-scheme' ) THEN 1510 tend = 0.0_wp 1511 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1512 IF ( ws_scheme_sca ) THEN 1513 CALL advec_s_ws( qr, 'qr' ) 1514 ELSE 1515 CALL advec_s_pw( qr ) 1516 ENDIF 1517 ELSE 1518 CALL advec_s_up( qr ) 1519 ENDIF 1520 ENDIF 1521 1522 CALL diffusion_s( qr, & 1523 surf_def_h(0)%qrsws, surf_def_h(1)%qrsws, & 1524 surf_def_h(2)%qrsws, & 1525 surf_lsm_h%qrsws, surf_usm_h%qrsws, & 1526 surf_def_v(0)%qrsws, surf_def_v(1)%qrsws, & 1527 surf_def_v(2)%qrsws, surf_def_v(3)%qrsws, & 1528 surf_lsm_v(0)%qrsws, surf_lsm_v(1)%qrsws, & 1529 surf_lsm_v(2)%qrsws, surf_lsm_v(3)%qrsws, & 1530 surf_usm_v(0)%qrsws, surf_usm_v(1)%qrsws, & 1531 surf_usm_v(2)%qrsws, surf_usm_v(3)%qrsws ) 1532 1533 ! 1534 !-- Prognostic equation for rain water content 1535 DO i = nxl, nxr 1536 DO j = nys, nyn 1537 DO k = nzb+1, nzt 1538 qr_p(k,j,i) = qr(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & 1539 tsc(3) * tqr_m(k,j,i) ) & 1540 - tsc(5) * rdf_sc(k) * & 1541 qr(k,j,i) & 1542 ) & 1543 * MERGE( 1.0_wp, 0.0_wp, & 1544 BTEST( wall_flags_0(k,j,i), 0 ) & 1545 ) 1546 IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp 1547 ENDDO 1548 ENDDO 1549 ENDDO 1550 1551 ! 1552 !-- Calculate tendencies for the next Runge-Kutta step 1553 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1554 IF ( intermediate_timestep_count == 1 ) THEN 1555 DO i = nxl, nxr 1556 DO j = nys, nyn 1557 DO k = nzb+1, nzt 1558 tqr_m(k,j,i) = tend(k,j,i) 1559 ENDDO 1560 ENDDO 1561 ENDDO 1562 ELSEIF ( intermediate_timestep_count < & 1563 intermediate_timestep_count_max ) THEN 1564 DO i = nxl, nxr 1565 DO j = nys, nyn 1566 DO k = nzb+1, nzt 1567 tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) & 1568 + 5.3125_wp * tqr_m(k,j,i) 1569 ENDDO 1570 ENDDO 1571 ENDDO 1572 ENDIF 1573 ENDIF 1574 1575 CALL cpu_log( log_point(52), 'qr-equation', 'stop' ) 1576 CALL cpu_log( log_point(53), 'nr-equation', 'start' ) 1577 1578 ! 1579 !-- Calculate prognostic equation for rain drop concentration 1580 sbt = tsc(2) 1581 IF ( scalar_advec == 'bc-scheme' ) THEN 1582 1583 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1584 ! 1585 !-- Bott-Chlond scheme always uses Euler time step. Thus: 1586 sbt = 1.0_wp 1587 ENDIF 1588 tend = 0.0_wp 1589 CALL advec_s_bc( nr, 'nr' ) 1590 1591 ENDIF 1592 1593 ! 1594 !-- nr-tendency terms with no communication 1595 IF ( scalar_advec /= 'bc-scheme' ) THEN 1596 tend = 0.0_wp 1597 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1598 IF ( ws_scheme_sca ) THEN 1599 CALL advec_s_ws( nr, 'nr' ) 1600 ELSE 1601 CALL advec_s_pw( nr ) 1602 ENDIF 1603 ELSE 1604 CALL advec_s_up( nr ) 1605 ENDIF 1606 ENDIF 1607 1608 CALL diffusion_s( nr, & 1609 surf_def_h(0)%nrsws, surf_def_h(1)%nrsws, & 1610 surf_def_h(2)%nrsws, & 1611 surf_lsm_h%nrsws, surf_usm_h%nrsws, & 1612 surf_def_v(0)%nrsws, surf_def_v(1)%nrsws, & 1613 surf_def_v(2)%nrsws, surf_def_v(3)%nrsws, & 1614 surf_lsm_v(0)%nrsws, surf_lsm_v(1)%nrsws, & 1615 surf_lsm_v(2)%nrsws, surf_lsm_v(3)%nrsws, & 1616 surf_usm_v(0)%nrsws, surf_usm_v(1)%nrsws, & 1617 surf_usm_v(2)%nrsws, surf_usm_v(3)%nrsws ) 1618 1619 ! 1620 !-- Prognostic equation for rain drop concentration 1621 DO i = nxl, nxr 1622 DO j = nys, nyn 1623 DO k = nzb+1, nzt 1624 nr_p(k,j,i) = nr(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & 1625 tsc(3) * tnr_m(k,j,i) ) & 1626 - tsc(5) * rdf_sc(k) * & 1627 nr(k,j,i) & 1628 ) & 1629 * MERGE( 1.0_wp, 0.0_wp, & 1630 BTEST( wall_flags_0(k,j,i), 0 ) & 1631 ) 1632 IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp 1633 ENDDO 1634 ENDDO 1635 ENDDO 1636 1637 ! 1638 !-- Calculate tendencies for the next Runge-Kutta step 1639 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1640 IF ( intermediate_timestep_count == 1 ) THEN 1641 DO i = nxl, nxr 1642 DO j = nys, nyn 1643 DO k = nzb+1, nzt 1644 tnr_m(k,j,i) = tend(k,j,i) 1645 ENDDO 1646 ENDDO 1647 ENDDO 1648 ELSEIF ( intermediate_timestep_count < & 1649 intermediate_timestep_count_max ) THEN 1650 DO i = nxl, nxr 1651 DO j = nys, nyn 1652 DO k = nzb+1, nzt 1653 tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) & 1654 + 5.3125_wp * tnr_m(k,j,i) 1655 ENDDO 1656 ENDDO 1657 ENDDO 1658 ENDIF 1659 ENDIF 1660 1661 CALL cpu_log( log_point(53), 'nr-equation', 'stop' ) 1662 1663 ENDIF 1664 1665 END SUBROUTINE bcm_prognostic_equations 1666 1667 1668 !------------------------------------------------------------------------------! 1669 ! Description: 1670 ! ------------ 1671 !> Control of microphysics for grid points i,j 1672 !------------------------------------------------------------------------------! 1673 1674 SUBROUTINE bcm_prognostic_equations_ij( i, j, i_omp_start, tn ) 1675 1676 1677 INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction 1678 INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction 1679 INTEGER(iwp) :: k !< grid index in z-direction 1680 INTEGER(iwp), INTENT(IN) :: i_omp_start !< first loop index of i-loop in prognostic_equations 1681 INTEGER(iwp), INTENT(IN) :: tn !< task number of openmp task 1682 1683 ! 1684 !-- If required, calculate prognostic equations for cloud water content 1685 !-- and cloud drop concentration 1686 IF ( microphysics_morrison ) THEN 1687 ! 1688 !-- Calculate prognostic equation for cloud water content 1689 tend(:,j,i) = 0.0_wp 1690 IF ( timestep_scheme(1:5) == 'runge' ) & 1691 THEN 1692 IF ( ws_scheme_sca ) THEN 1693 CALL advec_s_ws( i, j, qc, 'qc', flux_s_qc, & 1694 diss_s_qc, flux_l_qc, diss_l_qc, & 1695 i_omp_start, tn ) 1696 ELSE 1697 CALL advec_s_pw( i, j, qc ) 1698 ENDIF 1699 ELSE 1700 CALL advec_s_up( i, j, qc ) 1701 ENDIF 1702 CALL diffusion_s( i, j, qc, & 1703 surf_def_h(0)%qcsws, surf_def_h(1)%qcsws, & 1704 surf_def_h(2)%qcsws, & 1705 surf_lsm_h%qcsws, surf_usm_h%qcsws, & 1706 surf_def_v(0)%qcsws, surf_def_v(1)%qcsws, & 1707 surf_def_v(2)%qcsws, surf_def_v(3)%qcsws, & 1708 surf_lsm_v(0)%qcsws, surf_lsm_v(1)%qcsws, & 1709 surf_lsm_v(2)%qcsws, surf_lsm_v(3)%qcsws, & 1710 surf_usm_v(0)%qcsws, surf_usm_v(1)%qcsws, & 1711 surf_usm_v(2)%qcsws, surf_usm_v(3)%qcsws ) 1712 1713 ! 1714 !-- Prognostic equation for cloud water content 1715 DO k = nzb+1, nzt 1716 qc_p(k,j,i) = qc(k,j,i) + ( dt_3d * & 1717 ( tsc(2) * tend(k,j,i) + & 1718 tsc(3) * tqc_m(k,j,i) )& 1719 - tsc(5) * rdf_sc(k) & 1720 * qc(k,j,i) & 1721 ) & 1722 * MERGE( 1.0_wp, 0.0_wp, & 1723 BTEST( wall_flags_0(k,j,i), 0 )& 1724 ) 1725 IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp 1726 ENDDO 1727 ! 1728 !-- Calculate tendencies for the next Runge-Kutta step 1729 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1730 IF ( intermediate_timestep_count == 1 ) THEN 1731 DO k = nzb+1, nzt 1732 tqc_m(k,j,i) = tend(k,j,i) 1733 ENDDO 1734 ELSEIF ( intermediate_timestep_count < & 1735 intermediate_timestep_count_max ) THEN 1736 DO k = nzb+1, nzt 1737 tqc_m(k,j,i) = -9.5625_wp * tend(k,j,i) + & 1738 5.3125_wp * tqc_m(k,j,i) 1739 ENDDO 1740 ENDIF 1741 ENDIF 1742 1743 ! 1744 !-- Calculate prognostic equation for cloud drop concentration. 1745 tend(:,j,i) = 0.0_wp 1746 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1747 IF ( ws_scheme_sca ) THEN 1748 CALL advec_s_ws( i, j, nc, 'nc', flux_s_nc, & 1749 diss_s_nc, flux_l_nc, diss_l_nc, & 1750 i_omp_start, tn ) 1751 ELSE 1752 CALL advec_s_pw( i, j, nc ) 1753 ENDIF 1754 ELSE 1755 CALL advec_s_up( i, j, nc ) 1756 ENDIF 1757 CALL diffusion_s( i, j, nc, & 1758 surf_def_h(0)%ncsws, surf_def_h(1)%ncsws, & 1759 surf_def_h(2)%ncsws, & 1760 surf_lsm_h%ncsws, surf_usm_h%ncsws, & 1761 surf_def_v(0)%ncsws, surf_def_v(1)%ncsws, & 1762 surf_def_v(2)%ncsws, surf_def_v(3)%ncsws, & 1763 surf_lsm_v(0)%ncsws, surf_lsm_v(1)%ncsws, & 1764 surf_lsm_v(2)%ncsws, surf_lsm_v(3)%ncsws, & 1765 surf_usm_v(0)%ncsws, surf_usm_v(1)%ncsws, & 1766 surf_usm_v(2)%ncsws, surf_usm_v(3)%ncsws ) 1767 1768 ! 1769 !-- Prognostic equation for cloud drop concentration 1770 DO k = nzb+1, nzt 1771 nc_p(k,j,i) = nc(k,j,i) + ( dt_3d * & 1772 ( tsc(2) * tend(k,j,i) + & 1773 tsc(3) * tnc_m(k,j,i) )& 1774 - tsc(5) * rdf_sc(k) & 1775 * nc(k,j,i) & 1776 ) & 1777 * MERGE( 1.0_wp, 0.0_wp, & 1778 BTEST( wall_flags_0(k,j,i), 0 )& 1779 ) 1780 IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp 1781 ENDDO 1782 ! 1783 !-- Calculate tendencies for the next Runge-Kutta step 1784 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1785 IF ( intermediate_timestep_count == 1 ) THEN 1786 DO k = nzb+1, nzt 1787 tnc_m(k,j,i) = tend(k,j,i) 1788 ENDDO 1789 ELSEIF ( intermediate_timestep_count < & 1790 intermediate_timestep_count_max ) THEN 1791 DO k = nzb+1, nzt 1792 tnc_m(k,j,i) = -9.5625_wp * tend(k,j,i) + & 1793 5.3125_wp * tnc_m(k,j,i) 1794 ENDDO 1795 ENDIF 1796 ENDIF 1797 1798 ENDIF 1799 ! 1800 !-- If required, calculate prognostic equations for rain water content 1801 !-- and rain drop concentration 1802 IF ( microphysics_seifert ) THEN 1803 ! 1804 !-- Calculate prognostic equation for rain water content 1805 tend(:,j,i) = 0.0_wp 1806 IF ( timestep_scheme(1:5) == 'runge' ) & 1807 THEN 1808 IF ( ws_scheme_sca ) THEN 1809 CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr, & 1810 diss_s_qr, flux_l_qr, diss_l_qr, & 1811 i_omp_start, tn ) 1812 ELSE 1813 CALL advec_s_pw( i, j, qr ) 1814 ENDIF 1815 ELSE 1816 CALL advec_s_up( i, j, qr ) 1817 ENDIF 1818 CALL diffusion_s( i, j, qr, & 1819 surf_def_h(0)%qrsws, surf_def_h(1)%qrsws, & 1820 surf_def_h(2)%qrsws, & 1821 surf_lsm_h%qrsws, surf_usm_h%qrsws, & 1822 surf_def_v(0)%qrsws, surf_def_v(1)%qrsws, & 1823 surf_def_v(2)%qrsws, surf_def_v(3)%qrsws, & 1824 surf_lsm_v(0)%qrsws, surf_lsm_v(1)%qrsws, & 1825 surf_lsm_v(2)%qrsws, surf_lsm_v(3)%qrsws, & 1826 surf_usm_v(0)%qrsws, surf_usm_v(1)%qrsws, & 1827 surf_usm_v(2)%qrsws, surf_usm_v(3)%qrsws ) 1828 1829 ! 1830 !-- Prognostic equation for rain water content 1831 DO k = nzb+1, nzt 1832 qr_p(k,j,i) = qr(k,j,i) + ( dt_3d * & 1833 ( tsc(2) * tend(k,j,i) + & 1834 tsc(3) * tqr_m(k,j,i) )& 1835 - tsc(5) * rdf_sc(k) & 1836 * qr(k,j,i) & 1837 ) & 1838 * MERGE( 1.0_wp, 0.0_wp, & 1839 BTEST( wall_flags_0(k,j,i), 0 )& 1840 ) 1841 IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp 1842 ENDDO 1843 ! 1844 !-- Calculate tendencies for the next Runge-Kutta step 1845 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1846 IF ( intermediate_timestep_count == 1 ) THEN 1847 DO k = nzb+1, nzt 1848 tqr_m(k,j,i) = tend(k,j,i) 1849 ENDDO 1850 ELSEIF ( intermediate_timestep_count < & 1851 intermediate_timestep_count_max ) THEN 1852 DO k = nzb+1, nzt 1853 tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + & 1854 5.3125_wp * tqr_m(k,j,i) 1855 ENDDO 1856 ENDIF 1857 ENDIF 1858 1859 ! 1860 !-- Calculate prognostic equation for rain drop concentration. 1861 tend(:,j,i) = 0.0_wp 1862 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1863 IF ( ws_scheme_sca ) THEN 1864 CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr, & 1865 diss_s_nr, flux_l_nr, diss_l_nr, & 1866 i_omp_start, tn ) 1867 ELSE 1868 CALL advec_s_pw( i, j, nr ) 1869 ENDIF 1870 ELSE 1871 CALL advec_s_up( i, j, nr ) 1872 ENDIF 1873 CALL diffusion_s( i, j, nr, & 1874 surf_def_h(0)%nrsws, surf_def_h(1)%nrsws, & 1875 surf_def_h(2)%nrsws, & 1876 surf_lsm_h%nrsws, surf_usm_h%nrsws, & 1877 surf_def_v(0)%nrsws, surf_def_v(1)%nrsws, & 1878 surf_def_v(2)%nrsws, surf_def_v(3)%nrsws, & 1879 surf_lsm_v(0)%nrsws, surf_lsm_v(1)%nrsws, & 1880 surf_lsm_v(2)%nrsws, surf_lsm_v(3)%nrsws, & 1881 surf_usm_v(0)%nrsws, surf_usm_v(1)%nrsws, & 1882 surf_usm_v(2)%nrsws, surf_usm_v(3)%nrsws ) 1883 1884 ! 1885 !-- Prognostic equation for rain drop concentration 1886 DO k = nzb+1, nzt 1887 nr_p(k,j,i) = nr(k,j,i) + ( dt_3d * & 1888 ( tsc(2) * tend(k,j,i) + & 1889 tsc(3) * tnr_m(k,j,i) )& 1890 - tsc(5) * rdf_sc(k) & 1891 * nr(k,j,i) & 1892 ) & 1893 * MERGE( 1.0_wp, 0.0_wp, & 1894 BTEST( wall_flags_0(k,j,i), 0 )& 1895 ) 1896 IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp 1897 ENDDO 1898 ! 1899 !-- Calculate tendencies for the next Runge-Kutta step 1900 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1901 IF ( intermediate_timestep_count == 1 ) THEN 1902 DO k = nzb+1, nzt 1903 tnr_m(k,j,i) = tend(k,j,i) 1904 ENDDO 1905 ELSEIF ( intermediate_timestep_count < & 1906 intermediate_timestep_count_max ) THEN 1907 DO k = nzb+1, nzt 1908 tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + & 1909 5.3125_wp * tnr_m(k,j,i) 1910 ENDDO 1911 ENDIF 1912 ENDIF 1913 1914 ENDIF 1915 1916 END SUBROUTINE bcm_prognostic_equations_ij 1120 1917 1121 1918 -
palm/trunk/SOURCE/module_interface.f90
r3864 r3870 146 146 bcm_init, & 147 147 bcm_header, & 148 bcm_actions, & 149 bcm_prognostic_equations, & 148 150 bcm_swap_timelevel, & 149 151 bcm_3d_data_averaging, & … … 876 878 877 879 880 IF ( bulk_cloud_model ) CALL bcm_actions( location ) 878 881 IF ( gust_module_enabled ) CALL gust_actions( location ) 879 882 IF ( user_module_enabled ) CALL user_actions( location ) … … 896 899 897 900 901 IF ( bulk_cloud_model ) CALL bcm_actions( i, j, location ) 898 902 IF ( gust_module_enabled ) CALL gust_actions( i, j, location ) 899 903 IF ( user_module_enabled ) CALL user_actions( i, j, location ) … … 911 915 912 916 917 IF ( bulk_cloud_model ) CALL bcm_prognostic_equations() 913 918 IF ( gust_module_enabled ) CALL gust_prognostic_equations() 914 919 IF ( ocean_mode ) CALL ocean_prognostic_equations() … … 933 938 934 939 940 IF ( bulk_cloud_model ) CALL bcm_prognostic_equations( i, j, i_omp_start, tn ) 935 941 IF ( gust_module_enabled ) CALL gust_prognostic_equations( i, j, i_omp_start, tn ) 936 942 IF ( ocean_mode ) CALL ocean_prognostic_equations( i, j, i_omp_start, tn ) -
palm/trunk/SOURCE/prognostic_equations.f90
r3864 r3870 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Moving prognostic equations of bcm into bulk_cloud_model_mod 28 ! 29 ! 3864 2019-04-05 09:01:56Z monakurppa 27 30 ! Modifications made for salsa: 28 31 ! - salsa_prognostic_equations moved to salsa_mod (and the call to … … 332 335 MODULE prognostic_equations_mod 333 336 334 335 337 USE advec_s_bc_mod, & 336 338 ONLY: advec_s_bc … … 364 366 365 367 USE arrays_3d, & 366 ONLY: diss_l_e, diss_l_ nc, diss_l_nr, diss_l_pt, diss_l_q, diss_l_qc,&367 diss_l_ qr, diss_l_s, diss_l_sa, diss_s_e, diss_s_nc, diss_s_nr,&368 diss_s_pt, diss_s_q, diss_s_ qc, diss_s_qr, diss_s_s, diss_s_sa,&369 e, e_p, flux_s_e, flux_s_ nc, flux_s_nr, flux_s_pt, flux_s_q,&370 flux_s_ qc, flux_s_qr, flux_s_s, flux_s_sa, flux_l_e, flux_l_nc,&371 flux_l_ nr, flux_l_pt, flux_l_q, flux_l_qc, flux_l_qr, flux_l_s,&372 flux_l_sa, nc, nc_p, nr, nr_p, pt, ptdf_x, ptdf_y, pt_init,&373 pt_p, prho, q, q_init, q_p, qc, qc_p, qr, qr_p, rdf, rdf_sc,&374 ref_state, rho_ocean, s, s_init, s_p, tend, te_m, tnc_m,&375 t nr_m, tpt_m, tq_m, tqc_m, tqr_m, ts_m, tu_m, tv_m, tw_m, u,&368 ONLY: diss_l_e, diss_l_pt, diss_l_q, & 369 diss_l_s, diss_l_sa, diss_s_e, & 370 diss_s_pt, diss_s_q, diss_s_s, diss_s_sa, & 371 e, e_p, flux_s_e, flux_s_pt, flux_s_q, & 372 flux_s_s, flux_s_sa, flux_l_e, & 373 flux_l_pt, flux_l_q, flux_l_s, & 374 flux_l_sa, pt, ptdf_x, ptdf_y, pt_init, & 375 pt_p, prho, q, q_init, q_p, rdf, rdf_sc, & 376 ref_state, rho_ocean, s, s_init, s_p, tend, te_m, & 377 tpt_m, tq_m, ts_m, tu_m, tv_m, tw_m, u, & 376 378 ug, u_init, u_p, v, vg, vpt, v_init, v_p, w, w_p 377 379 378 380 USE bulk_cloud_model_mod, & 379 381 ONLY: call_microphysics_at_all_substeps, bulk_cloud_model, & 380 bcm_actions, microphysics_sat_adjust, & 381 microphysics_morrison, microphysics_seifert 382 bcm_actions_micro, microphysics_sat_adjust 382 383 383 384 USE buoyancy_mod, & … … 663 664 DO i = nxlg, nxrg 664 665 DO j = nysg, nyng 665 CALL bcm_actions ( i, j )666 CALL bcm_actions_micro( i, j ) 666 667 ENDDO 667 668 ENDDO … … 1104 1105 ENDIF 1105 1106 1106 !1107 !-- If required, calculate prognostic equations for cloud water content1108 !-- and cloud drop concentration1109 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN1110 !1111 !-- Calculate prognostic equation for cloud water content1112 tend(:,j,i) = 0.0_wp1113 IF ( timestep_scheme(1:5) == 'runge' ) &1114 THEN1115 IF ( ws_scheme_sca ) THEN1116 CALL advec_s_ws( i, j, qc, 'qc', flux_s_qc, &1117 diss_s_qc, flux_l_qc, diss_l_qc, &1118 i_omp_start, tn )1119 ELSE1120 CALL advec_s_pw( i, j, qc )1121 ENDIF1122 ELSE1123 CALL advec_s_up( i, j, qc )1124 ENDIF1125 CALL diffusion_s( i, j, qc, &1126 surf_def_h(0)%qcsws, surf_def_h(1)%qcsws, &1127 surf_def_h(2)%qcsws, &1128 surf_lsm_h%qcsws, surf_usm_h%qcsws, &1129 surf_def_v(0)%qcsws, surf_def_v(1)%qcsws, &1130 surf_def_v(2)%qcsws, surf_def_v(3)%qcsws, &1131 surf_lsm_v(0)%qcsws, surf_lsm_v(1)%qcsws, &1132 surf_lsm_v(2)%qcsws, surf_lsm_v(3)%qcsws, &1133 surf_usm_v(0)%qcsws, surf_usm_v(1)%qcsws, &1134 surf_usm_v(2)%qcsws, surf_usm_v(3)%qcsws )1135 1136 !1137 !-- Prognostic equation for cloud water content1138 DO k = nzb+1, nzt1139 qc_p(k,j,i) = qc(k,j,i) + ( dt_3d * &1140 ( tsc(2) * tend(k,j,i) + &1141 tsc(3) * tqc_m(k,j,i) )&1142 - tsc(5) * rdf_sc(k) &1143 * qc(k,j,i) &1144 ) &1145 * MERGE( 1.0_wp, 0.0_wp, &1146 BTEST( wall_flags_0(k,j,i), 0 )&1147 )1148 IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp1149 ENDDO1150 !1151 !-- Calculate tendencies for the next Runge-Kutta step1152 IF ( timestep_scheme(1:5) == 'runge' ) THEN1153 IF ( intermediate_timestep_count == 1 ) THEN1154 DO k = nzb+1, nzt1155 tqc_m(k,j,i) = tend(k,j,i)1156 ENDDO1157 ELSEIF ( intermediate_timestep_count < &1158 intermediate_timestep_count_max ) THEN1159 DO k = nzb+1, nzt1160 tqc_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &1161 5.3125_wp * tqc_m(k,j,i)1162 ENDDO1163 ENDIF1164 ENDIF1165 1166 !1167 !-- Calculate prognostic equation for cloud drop concentration.1168 tend(:,j,i) = 0.0_wp1169 IF ( timestep_scheme(1:5) == 'runge' ) THEN1170 IF ( ws_scheme_sca ) THEN1171 CALL advec_s_ws( i, j, nc, 'nc', flux_s_nc, &1172 diss_s_nc, flux_l_nc, diss_l_nc, &1173 i_omp_start, tn )1174 ELSE1175 CALL advec_s_pw( i, j, nc )1176 ENDIF1177 ELSE1178 CALL advec_s_up( i, j, nc )1179 ENDIF1180 CALL diffusion_s( i, j, nc, &1181 surf_def_h(0)%ncsws, surf_def_h(1)%ncsws, &1182 surf_def_h(2)%ncsws, &1183 surf_lsm_h%ncsws, surf_usm_h%ncsws, &1184 surf_def_v(0)%ncsws, surf_def_v(1)%ncsws, &1185 surf_def_v(2)%ncsws, surf_def_v(3)%ncsws, &1186 surf_lsm_v(0)%ncsws, surf_lsm_v(1)%ncsws, &1187 surf_lsm_v(2)%ncsws, surf_lsm_v(3)%ncsws, &1188 surf_usm_v(0)%ncsws, surf_usm_v(1)%ncsws, &1189 surf_usm_v(2)%ncsws, surf_usm_v(3)%ncsws )1190 1191 !1192 !-- Prognostic equation for cloud drop concentration1193 DO k = nzb+1, nzt1194 nc_p(k,j,i) = nc(k,j,i) + ( dt_3d * &1195 ( tsc(2) * tend(k,j,i) + &1196 tsc(3) * tnc_m(k,j,i) )&1197 - tsc(5) * rdf_sc(k) &1198 * nc(k,j,i) &1199 ) &1200 * MERGE( 1.0_wp, 0.0_wp, &1201 BTEST( wall_flags_0(k,j,i), 0 )&1202 )1203 IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp1204 ENDDO1205 !1206 !-- Calculate tendencies for the next Runge-Kutta step1207 IF ( timestep_scheme(1:5) == 'runge' ) THEN1208 IF ( intermediate_timestep_count == 1 ) THEN1209 DO k = nzb+1, nzt1210 tnc_m(k,j,i) = tend(k,j,i)1211 ENDDO1212 ELSEIF ( intermediate_timestep_count < &1213 intermediate_timestep_count_max ) THEN1214 DO k = nzb+1, nzt1215 tnc_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &1216 5.3125_wp * tnc_m(k,j,i)1217 ENDDO1218 ENDIF1219 ENDIF1220 1221 ENDIF1222 !1223 !-- If required, calculate prognostic equations for rain water content1224 !-- and rain drop concentration1225 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN1226 !1227 !-- Calculate prognostic equation for rain water content1228 tend(:,j,i) = 0.0_wp1229 IF ( timestep_scheme(1:5) == 'runge' ) &1230 THEN1231 IF ( ws_scheme_sca ) THEN1232 CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr, &1233 diss_s_qr, flux_l_qr, diss_l_qr, &1234 i_omp_start, tn )1235 ELSE1236 CALL advec_s_pw( i, j, qr )1237 ENDIF1238 ELSE1239 CALL advec_s_up( i, j, qr )1240 ENDIF1241 CALL diffusion_s( i, j, qr, &1242 surf_def_h(0)%qrsws, surf_def_h(1)%qrsws, &1243 surf_def_h(2)%qrsws, &1244 surf_lsm_h%qrsws, surf_usm_h%qrsws, &1245 surf_def_v(0)%qrsws, surf_def_v(1)%qrsws, &1246 surf_def_v(2)%qrsws, surf_def_v(3)%qrsws, &1247 surf_lsm_v(0)%qrsws, surf_lsm_v(1)%qrsws, &1248 surf_lsm_v(2)%qrsws, surf_lsm_v(3)%qrsws, &1249 surf_usm_v(0)%qrsws, surf_usm_v(1)%qrsws, &1250 surf_usm_v(2)%qrsws, surf_usm_v(3)%qrsws )1251 1252 !1253 !-- Prognostic equation for rain water content1254 DO k = nzb+1, nzt1255 qr_p(k,j,i) = qr(k,j,i) + ( dt_3d * &1256 ( tsc(2) * tend(k,j,i) + &1257 tsc(3) * tqr_m(k,j,i) )&1258 - tsc(5) * rdf_sc(k) &1259 * qr(k,j,i) &1260 ) &1261 * MERGE( 1.0_wp, 0.0_wp, &1262 BTEST( wall_flags_0(k,j,i), 0 )&1263 )1264 IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp1265 ENDDO1266 !1267 !-- Calculate tendencies for the next Runge-Kutta step1268 IF ( timestep_scheme(1:5) == 'runge' ) THEN1269 IF ( intermediate_timestep_count == 1 ) THEN1270 DO k = nzb+1, nzt1271 tqr_m(k,j,i) = tend(k,j,i)1272 ENDDO1273 ELSEIF ( intermediate_timestep_count < &1274 intermediate_timestep_count_max ) THEN1275 DO k = nzb+1, nzt1276 tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &1277 5.3125_wp * tqr_m(k,j,i)1278 ENDDO1279 ENDIF1280 ENDIF1281 1282 !1283 !-- Calculate prognostic equation for rain drop concentration.1284 tend(:,j,i) = 0.0_wp1285 IF ( timestep_scheme(1:5) == 'runge' ) THEN1286 IF ( ws_scheme_sca ) THEN1287 CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr, &1288 diss_s_nr, flux_l_nr, diss_l_nr, &1289 i_omp_start, tn )1290 ELSE1291 CALL advec_s_pw( i, j, nr )1292 ENDIF1293 ELSE1294 CALL advec_s_up( i, j, nr )1295 ENDIF1296 CALL diffusion_s( i, j, nr, &1297 surf_def_h(0)%nrsws, surf_def_h(1)%nrsws, &1298 surf_def_h(2)%nrsws, &1299 surf_lsm_h%nrsws, surf_usm_h%nrsws, &1300 surf_def_v(0)%nrsws, surf_def_v(1)%nrsws, &1301 surf_def_v(2)%nrsws, surf_def_v(3)%nrsws, &1302 surf_lsm_v(0)%nrsws, surf_lsm_v(1)%nrsws, &1303 surf_lsm_v(2)%nrsws, surf_lsm_v(3)%nrsws, &1304 surf_usm_v(0)%nrsws, surf_usm_v(1)%nrsws, &1305 surf_usm_v(2)%nrsws, surf_usm_v(3)%nrsws )1306 1307 !1308 !-- Prognostic equation for rain drop concentration1309 DO k = nzb+1, nzt1310 nr_p(k,j,i) = nr(k,j,i) + ( dt_3d * &1311 ( tsc(2) * tend(k,j,i) + &1312 tsc(3) * tnr_m(k,j,i) )&1313 - tsc(5) * rdf_sc(k) &1314 * nr(k,j,i) &1315 ) &1316 * MERGE( 1.0_wp, 0.0_wp, &1317 BTEST( wall_flags_0(k,j,i), 0 )&1318 )1319 IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp1320 ENDDO1321 !1322 !-- Calculate tendencies for the next Runge-Kutta step1323 IF ( timestep_scheme(1:5) == 'runge' ) THEN1324 IF ( intermediate_timestep_count == 1 ) THEN1325 DO k = nzb+1, nzt1326 tnr_m(k,j,i) = tend(k,j,i)1327 ENDDO1328 ELSEIF ( intermediate_timestep_count < &1329 intermediate_timestep_count_max ) THEN1330 DO k = nzb+1, nzt1331 tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &1332 5.3125_wp * tnr_m(k,j,i)1333 ENDDO1334 ENDIF1335 ENDIF1336 1337 ENDIF1338 1339 1107 ENDIF 1340 1108 … … 1543 1311 ) THEN 1544 1312 CALL cpu_log( log_point(51), 'microphysics', 'start' ) 1545 CALL bcm_actions 1313 CALL bcm_actions_micro 1546 1314 CALL cpu_log( log_point(51), 'microphysics', 'stop' ) 1547 1315 ENDIF … … 2110 1878 CALL cpu_log( log_point(29), 'q-equation', 'stop' ) 2111 1879 2112 !2113 !-- If required, calculate prognostic equations for cloud water content2114 !-- and cloud drop concentration2115 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN2116 2117 CALL cpu_log( log_point(67), 'qc-equation', 'start' )2118 2119 !2120 !-- Calculate prognostic equation for cloud water content2121 sbt = tsc(2)2122 IF ( scalar_advec == 'bc-scheme' ) THEN2123 2124 IF ( timestep_scheme(1:5) /= 'runge' ) THEN2125 !2126 !-- Bott-Chlond scheme always uses Euler time step. Thus:2127 sbt = 1.0_wp2128 ENDIF2129 tend = 0.0_wp2130 CALL advec_s_bc( qc, 'qc' )2131 2132 ENDIF2133 2134 !2135 !-- qc-tendency terms with no communication2136 IF ( scalar_advec /= 'bc-scheme' ) THEN2137 tend = 0.0_wp2138 IF ( timestep_scheme(1:5) == 'runge' ) THEN2139 IF ( ws_scheme_sca ) THEN2140 CALL advec_s_ws( qc, 'qc' )2141 ELSE2142 CALL advec_s_pw( qc )2143 ENDIF2144 ELSE2145 CALL advec_s_up( qc )2146 ENDIF2147 ENDIF2148 2149 CALL diffusion_s( qc, &2150 surf_def_h(0)%qcsws, surf_def_h(1)%qcsws, &2151 surf_def_h(2)%qcsws, &2152 surf_lsm_h%qcsws, surf_usm_h%qcsws, &2153 surf_def_v(0)%qcsws, surf_def_v(1)%qcsws, &2154 surf_def_v(2)%qcsws, surf_def_v(3)%qcsws, &2155 surf_lsm_v(0)%qcsws, surf_lsm_v(1)%qcsws, &2156 surf_lsm_v(2)%qcsws, surf_lsm_v(3)%qcsws, &2157 surf_usm_v(0)%qcsws, surf_usm_v(1)%qcsws, &2158 surf_usm_v(2)%qcsws, surf_usm_v(3)%qcsws )2159 2160 !2161 !-- Prognostic equation for cloud water content2162 DO i = nxl, nxr2163 DO j = nys, nyn2164 DO k = nzb+1, nzt2165 qc_p(k,j,i) = qc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &2166 tsc(3) * tqc_m(k,j,i) ) &2167 - tsc(5) * rdf_sc(k) * &2168 qc(k,j,i) &2169 ) &2170 * MERGE( 1.0_wp, 0.0_wp, &2171 BTEST( wall_flags_0(k,j,i), 0 ) &2172 )2173 IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp2174 ENDDO2175 ENDDO2176 ENDDO2177 2178 !2179 !-- Calculate tendencies for the next Runge-Kutta step2180 IF ( timestep_scheme(1:5) == 'runge' ) THEN2181 IF ( intermediate_timestep_count == 1 ) THEN2182 DO i = nxl, nxr2183 DO j = nys, nyn2184 DO k = nzb+1, nzt2185 tqc_m(k,j,i) = tend(k,j,i)2186 ENDDO2187 ENDDO2188 ENDDO2189 ELSEIF ( intermediate_timestep_count < &2190 intermediate_timestep_count_max ) THEN2191 DO i = nxl, nxr2192 DO j = nys, nyn2193 DO k = nzb+1, nzt2194 tqc_m(k,j,i) = -9.5625_wp * tend(k,j,i) &2195 + 5.3125_wp * tqc_m(k,j,i)2196 ENDDO2197 ENDDO2198 ENDDO2199 ENDIF2200 ENDIF2201 2202 CALL cpu_log( log_point(67), 'qc-equation', 'stop' )2203 2204 CALL cpu_log( log_point(68), 'nc-equation', 'start' )2205 !2206 !-- Calculate prognostic equation for cloud drop concentration2207 sbt = tsc(2)2208 IF ( scalar_advec == 'bc-scheme' ) THEN2209 2210 IF ( timestep_scheme(1:5) /= 'runge' ) THEN2211 !2212 !-- Bott-Chlond scheme always uses Euler time step. Thus:2213 sbt = 1.0_wp2214 ENDIF2215 tend = 0.0_wp2216 CALL advec_s_bc( nc, 'nc' )2217 2218 ENDIF2219 2220 !2221 !-- nc-tendency terms with no communication2222 IF ( scalar_advec /= 'bc-scheme' ) THEN2223 tend = 0.0_wp2224 IF ( timestep_scheme(1:5) == 'runge' ) THEN2225 IF ( ws_scheme_sca ) THEN2226 CALL advec_s_ws( nc, 'nc' )2227 ELSE2228 CALL advec_s_pw( nc )2229 ENDIF2230 ELSE2231 CALL advec_s_up( nc )2232 ENDIF2233 ENDIF2234 2235 CALL diffusion_s( nc, &2236 surf_def_h(0)%ncsws, surf_def_h(1)%ncsws, &2237 surf_def_h(2)%ncsws, &2238 surf_lsm_h%ncsws, surf_usm_h%ncsws, &2239 surf_def_v(0)%ncsws, surf_def_v(1)%ncsws, &2240 surf_def_v(2)%ncsws, surf_def_v(3)%ncsws, &2241 surf_lsm_v(0)%ncsws, surf_lsm_v(1)%ncsws, &2242 surf_lsm_v(2)%ncsws, surf_lsm_v(3)%ncsws, &2243 surf_usm_v(0)%ncsws, surf_usm_v(1)%ncsws, &2244 surf_usm_v(2)%ncsws, surf_usm_v(3)%ncsws )2245 2246 !2247 !-- Prognostic equation for cloud drop concentration2248 DO i = nxl, nxr2249 DO j = nys, nyn2250 DO k = nzb+1, nzt2251 nc_p(k,j,i) = nc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &2252 tsc(3) * tnc_m(k,j,i) ) &2253 - tsc(5) * rdf_sc(k) * &2254 nc(k,j,i) &2255 ) &2256 * MERGE( 1.0_wp, 0.0_wp, &2257 BTEST( wall_flags_0(k,j,i), 0 ) &2258 )2259 IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp2260 ENDDO2261 ENDDO2262 ENDDO2263 2264 !2265 !-- Calculate tendencies for the next Runge-Kutta step2266 IF ( timestep_scheme(1:5) == 'runge' ) THEN2267 IF ( intermediate_timestep_count == 1 ) THEN2268 DO i = nxl, nxr2269 DO j = nys, nyn2270 DO k = nzb+1, nzt2271 tnc_m(k,j,i) = tend(k,j,i)2272 ENDDO2273 ENDDO2274 ENDDO2275 ELSEIF ( intermediate_timestep_count < &2276 intermediate_timestep_count_max ) THEN2277 DO i = nxl, nxr2278 DO j = nys, nyn2279 DO k = nzb+1, nzt2280 tnc_m(k,j,i) = -9.5625_wp * tend(k,j,i) &2281 + 5.3125_wp * tnc_m(k,j,i)2282 ENDDO2283 ENDDO2284 ENDDO2285 ENDIF2286 ENDIF2287 2288 CALL cpu_log( log_point(68), 'nc-equation', 'stop' )2289 2290 ENDIF2291 !2292 !-- If required, calculate prognostic equations for rain water content2293 !-- and rain drop concentration2294 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN2295 2296 CALL cpu_log( log_point(52), 'qr-equation', 'start' )2297 2298 !2299 !-- Calculate prognostic equation for rain water content2300 sbt = tsc(2)2301 IF ( scalar_advec == 'bc-scheme' ) THEN2302 2303 IF ( timestep_scheme(1:5) /= 'runge' ) THEN2304 !2305 !-- Bott-Chlond scheme always uses Euler time step. Thus:2306 sbt = 1.0_wp2307 ENDIF2308 tend = 0.0_wp2309 CALL advec_s_bc( qr, 'qr' )2310 2311 ENDIF2312 2313 !2314 !-- qr-tendency terms with no communication2315 IF ( scalar_advec /= 'bc-scheme' ) THEN2316 tend = 0.0_wp2317 IF ( timestep_scheme(1:5) == 'runge' ) THEN2318 IF ( ws_scheme_sca ) THEN2319 CALL advec_s_ws( qr, 'qr' )2320 ELSE2321 CALL advec_s_pw( qr )2322 ENDIF2323 ELSE2324 CALL advec_s_up( qr )2325 ENDIF2326 ENDIF2327 2328 CALL diffusion_s( qr, &2329 surf_def_h(0)%qrsws, surf_def_h(1)%qrsws, &2330 surf_def_h(2)%qrsws, &2331 surf_lsm_h%qrsws, surf_usm_h%qrsws, &2332 surf_def_v(0)%qrsws, surf_def_v(1)%qrsws, &2333 surf_def_v(2)%qrsws, surf_def_v(3)%qrsws, &2334 surf_lsm_v(0)%qrsws, surf_lsm_v(1)%qrsws, &2335 surf_lsm_v(2)%qrsws, surf_lsm_v(3)%qrsws, &2336 surf_usm_v(0)%qrsws, surf_usm_v(1)%qrsws, &2337 surf_usm_v(2)%qrsws, surf_usm_v(3)%qrsws )2338 2339 !2340 !-- Prognostic equation for rain water content2341 DO i = nxl, nxr2342 DO j = nys, nyn2343 DO k = nzb+1, nzt2344 qr_p(k,j,i) = qr(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &2345 tsc(3) * tqr_m(k,j,i) ) &2346 - tsc(5) * rdf_sc(k) * &2347 qr(k,j,i) &2348 ) &2349 * MERGE( 1.0_wp, 0.0_wp, &2350 BTEST( wall_flags_0(k,j,i), 0 ) &2351 )2352 IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp2353 ENDDO2354 ENDDO2355 ENDDO2356 2357 !2358 !-- Calculate tendencies for the next Runge-Kutta step2359 IF ( timestep_scheme(1:5) == 'runge' ) THEN2360 IF ( intermediate_timestep_count == 1 ) THEN2361 DO i = nxl, nxr2362 DO j = nys, nyn2363 DO k = nzb+1, nzt2364 tqr_m(k,j,i) = tend(k,j,i)2365 ENDDO2366 ENDDO2367 ENDDO2368 ELSEIF ( intermediate_timestep_count < &2369 intermediate_timestep_count_max ) THEN2370 DO i = nxl, nxr2371 DO j = nys, nyn2372 DO k = nzb+1, nzt2373 tqr_m(k,j,i) = -9.5625_wp * tend(k,j,i) &2374 + 5.3125_wp * tqr_m(k,j,i)2375 ENDDO2376 ENDDO2377 ENDDO2378 ENDIF2379 ENDIF2380 2381 CALL cpu_log( log_point(52), 'qr-equation', 'stop' )2382 CALL cpu_log( log_point(53), 'nr-equation', 'start' )2383 2384 !2385 !-- Calculate prognostic equation for rain drop concentration2386 sbt = tsc(2)2387 IF ( scalar_advec == 'bc-scheme' ) THEN2388 2389 IF ( timestep_scheme(1:5) /= 'runge' ) THEN2390 !2391 !-- Bott-Chlond scheme always uses Euler time step. Thus:2392 sbt = 1.0_wp2393 ENDIF2394 tend = 0.0_wp2395 CALL advec_s_bc( nr, 'nr' )2396 2397 ENDIF2398 2399 !2400 !-- nr-tendency terms with no communication2401 IF ( scalar_advec /= 'bc-scheme' ) THEN2402 tend = 0.0_wp2403 IF ( timestep_scheme(1:5) == 'runge' ) THEN2404 IF ( ws_scheme_sca ) THEN2405 CALL advec_s_ws( nr, 'nr' )2406 ELSE2407 CALL advec_s_pw( nr )2408 ENDIF2409 ELSE2410 CALL advec_s_up( nr )2411 ENDIF2412 ENDIF2413 2414 CALL diffusion_s( nr, &2415 surf_def_h(0)%nrsws, surf_def_h(1)%nrsws, &2416 surf_def_h(2)%nrsws, &2417 surf_lsm_h%nrsws, surf_usm_h%nrsws, &2418 surf_def_v(0)%nrsws, surf_def_v(1)%nrsws, &2419 surf_def_v(2)%nrsws, surf_def_v(3)%nrsws, &2420 surf_lsm_v(0)%nrsws, surf_lsm_v(1)%nrsws, &2421 surf_lsm_v(2)%nrsws, surf_lsm_v(3)%nrsws, &2422 surf_usm_v(0)%nrsws, surf_usm_v(1)%nrsws, &2423 surf_usm_v(2)%nrsws, surf_usm_v(3)%nrsws )2424 2425 !2426 !-- Prognostic equation for rain drop concentration2427 DO i = nxl, nxr2428 DO j = nys, nyn2429 DO k = nzb+1, nzt2430 nr_p(k,j,i) = nr(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + &2431 tsc(3) * tnr_m(k,j,i) ) &2432 - tsc(5) * rdf_sc(k) * &2433 nr(k,j,i) &2434 ) &2435 * MERGE( 1.0_wp, 0.0_wp, &2436 BTEST( wall_flags_0(k,j,i), 0 ) &2437 )2438 IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp2439 ENDDO2440 ENDDO2441 ENDDO2442 2443 !2444 !-- Calculate tendencies for the next Runge-Kutta step2445 IF ( timestep_scheme(1:5) == 'runge' ) THEN2446 IF ( intermediate_timestep_count == 1 ) THEN2447 DO i = nxl, nxr2448 DO j = nys, nyn2449 DO k = nzb+1, nzt2450 tnr_m(k,j,i) = tend(k,j,i)2451 ENDDO2452 ENDDO2453 ENDDO2454 ELSEIF ( intermediate_timestep_count < &2455 intermediate_timestep_count_max ) THEN2456 DO i = nxl, nxr2457 DO j = nys, nyn2458 DO k = nzb+1, nzt2459 tnr_m(k,j,i) = -9.5625_wp * tend(k,j,i) &2460 + 5.3125_wp * tnr_m(k,j,i)2461 ENDDO2462 ENDDO2463 ENDDO2464 ENDIF2465 ENDIF2466 2467 CALL cpu_log( log_point(53), 'nr-equation', 'stop' )2468 2469 ENDIF2470 2471 1880 ENDIF 2472 1881 !
Note: See TracChangeset
for help on using the changeset viewer.
