Ignore:
Timestamp:
Apr 8, 2019 1:44:34 PM (2 years ago)
Author:
knoop
Message:

Moving prognostic equations of bcm into bulk_cloud_model_mod

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/bulk_cloud_model_mod.f90

    r3869 r3870  
    2525! -----------------
    2626! $Id$
     27! Moving prognostic equations of bcm into bulk_cloud_model_mod
     28!
     29! 3869 2019-04-08 11:54:20Z knoop
    2730! moving the furniture around ;-)
    2831!
     
    199202 MODULE bulk_cloud_model_mod
    200203
     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
    201217    USE arrays_3d,                                                             &
    202218        ONLY:  ddzu, diss, dzu, dzw, hyp, hyrho,                               &
     
    204220               precipitation_amount, prr, pt, d_exner, pt_init, q, ql, ql_1,   &
    205221               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
    207227
    208228    USE averaging,                                                             &
     
    219239               intermediate_timestep_count_max, large_scale_forcing,           &
    220240               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
    222243
    223244    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
    225249
    226250    USE grid_variables,                                                        &
     
    231255               wall_flags_0
    232256
    233     USE  kinds
     257    USE kinds
     258
     259    USE pegrid,                                                                &
     260        ONLY:  threads_per_task
    234261
    235262    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
    237264
    238265    USE surface_mod,                                                           &
    239266        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
    241269
    242270    IMPLICIT NONE
     
    332360           bcm_header, &
    333361           bcm_actions, &
     362           bcm_actions_micro, &
     363           bcm_prognostic_equations, &
    334364           bcm_3d_data_averaging, &
    335365           bcm_data_output_2d, &
     
    389419       MODULE PROCEDURE bcm_actions_ij
    390420    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
    391431
    392432    INTERFACE bcm_swap_timelevel
     
    807847       ENDIF
    808848
     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
    809902!
    810903!--    Initial assignment of the pointers
     
    10041097!> Control of microphysics for all grid points
    10051098!------------------------------------------------------------------------------!
    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
    10071177
    10081178       IMPLICIT NONE
     
    10551225       CALL calc_precipitation_amount
    10561226
    1057     END SUBROUTINE bcm_actions
     1227    END SUBROUTINE bcm_actions_micro
    10581228
    10591229
     
    10641234!------------------------------------------------------------------------------!
    10651235
    1066     SUBROUTINE bcm_actions_ij( i, j )
     1236    SUBROUTINE bcm_actions_micro_ij( i, j )
    10671237
    10681238       IMPLICIT NONE
     
    11171287       CALL calc_precipitation_amount_ij( i,j )
    11181288
    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
    11201917
    11211918
Note: See TracChangeset for help on using the changeset viewer.