Changeset 3870 for palm/trunk/SOURCE/bulk_cloud_model_mod.f90
- Timestamp:
- Apr 8, 2019 1:44:34 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/bulk_cloud_model_mod.f90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
