Changeset 3870 for palm/trunk


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

Location:
palm/trunk/SOURCE
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/Makefile

    r3864 r3870  
    776776        modules.o
    777777advec_ws.o: \
    778         bulk_cloud_model_mod.o \
    779778        mod_kinds.o \
    780779        modules.o \
     
    815814        basic_constants_and_equations_mod.o \
    816815        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 \
    817821        mod_kinds.o \
    818822        modules.o \
  • palm/trunk/SOURCE/advec_ws.f90

    r3864 r3870  
    2525! -----------------
    2626! $Id$
     27! Moving initialization of bcm specific flux arrays into bulk_cloud_model_mod
     28!
     29! 3864 2019-04-05 09:01:56Z monakurppa
    2730! Remove tailing white spaces
    2831!
     
    325328
    326329       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,         &
    329332                  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,         &
    334337                  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,         &
    337340                  flux_s_v, flux_s_w
    338341
     
    346349       USE kinds
    347350
    348        USE bulk_cloud_model_mod,                                               &
    349            ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert
    350 
    351351       USE pegrid
    352352
     
    355355
    356356       USE statistics,                                                         &
    357            ONLY:  sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsncs_ws_l,&
    358                   sums_wsnrs_ws_l,sums_wspts_ws_l, sums_wsqcs_ws_l,            &
    359                   sums_wsqrs_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,             &
    360360                  sums_wssas_ws_l,  sums_wsss_ws_l, sums_wsus_ws_l,            &
    361361                  sums_wsvs_ws_l
     
    397397             sums_wsqs_ws_l = 0.0_wp
    398398          ENDIF
    399          
     399
    400400          IF ( passive_scalar )  THEN
    401401             ALLOCATE( sums_wsss_ws_l(nzb:nzt+1,0:threads_per_task-1) )
    402402             sums_wsss_ws_l = 0.0_wp
    403           ENDIF
    404 
    405           IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    406              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_wp
    409              sums_wsncs_ws_l = 0.0_wp
    410           ENDIF
    411 
    412           IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    413              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_wp
    416              sums_wsnrs_ws_l = 0.0_wp
    417403          ENDIF
    418404
     
    477463                          diss_l_q(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
    478464             ENDIF
    479              
     465
    480466             IF ( passive_scalar )  THEN
    481467                ALLOCATE( flux_s_s(nzb+1:nzt,0:threads_per_task-1),            &
     
    483469                ALLOCATE( flux_l_s(nzb+1:nzt,nys:nyn,0:threads_per_task-1),    &
    484470                          diss_l_s(nzb+1:nzt,nys:nyn,0:threads_per_task-1) )
    485              ENDIF
    486 
    487              IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    488                 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              ENDIF                 
    497 
    498              IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    499                 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) )
    507471             ENDIF
    508472
     
    11401104                  ws_scheme_sca, salsa
    11411105
    1142        USE kinds 
    1143 
    1144        USE bulk_cloud_model_mod,                                               &
    1145            ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert
     1106       USE kinds
    11461107
    11471108       USE salsa_util_mod,                                                     &
     
    11491110
    11501111       USE statistics,                                                         &
    1151            ONLY:  sums_us2_ws_l, sums_vs2_ws_l, sums_ws2_ws_l, sums_wsncs_ws_l,&
    1152                   sums_wsnrs_ws_l, sums_wspts_ws_l, sums_wsqcs_ws_l,           &
    1153                   sums_wsqrs_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,             &
    11541115                  sums_wssas_ws_l, sums_wsus_ws_l, sums_wsvs_ws_l
    11551116                   
     
    11771138          IF ( humidity       )  sums_wsqs_ws_l = 0.0_wp
    11781139          IF ( passive_scalar )  sums_wsss_ws_l = 0.0_wp
    1179           IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    1180              sums_wsqcs_ws_l = 0.0_wp
    1181              sums_wsncs_ws_l = 0.0_wp
    1182           ENDIF
    1183           IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    1184              sums_wsqrs_ws_l = 0.0_wp
    1185              sums_wsnrs_ws_l = 0.0_wp
    1186           ENDIF
    11871140          IF ( ocean_mode )  sums_wssas_ws_l = 0.0_wp
    11881141          IF ( salsa )       sums_salsa_ws_l = 0.0_wp
  • 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
  • palm/trunk/SOURCE/module_interface.f90

    r3864 r3870  
    146146               bcm_init,                                                       &
    147147               bcm_header,                                                     &
     148               bcm_actions,                                                    &
     149               bcm_prognostic_equations,                                       &
    148150               bcm_swap_timelevel,                                             &
    149151               bcm_3d_data_averaging,                                          &
     
    876878
    877879
     880    IF ( bulk_cloud_model    )  CALL bcm_actions( location )
    878881    IF ( gust_module_enabled )  CALL gust_actions( location )
    879882    IF ( user_module_enabled )  CALL user_actions( location )
     
    896899
    897900
     901    IF ( bulk_cloud_model    )  CALL bcm_actions( i, j, location )
    898902    IF ( gust_module_enabled )  CALL gust_actions( i, j, location )
    899903    IF ( user_module_enabled )  CALL user_actions( i, j, location )
     
    911915
    912916
     917    IF ( bulk_cloud_model    )  CALL bcm_prognostic_equations()
    913918    IF ( gust_module_enabled )  CALL gust_prognostic_equations()
    914919    IF ( ocean_mode          )  CALL ocean_prognostic_equations()
     
    933938
    934939
     940    IF ( bulk_cloud_model    )  CALL bcm_prognostic_equations( i, j, i_omp_start, tn )
    935941    IF ( gust_module_enabled )  CALL gust_prognostic_equations( i, j, i_omp_start, tn )
    936942    IF ( ocean_mode          )  CALL ocean_prognostic_equations( i, j, i_omp_start, tn )
  • palm/trunk/SOURCE/prognostic_equations.f90

    r3864 r3870  
    2525! -----------------
    2626! $Id$
     27! Moving prognostic equations of bcm into bulk_cloud_model_mod
     28!
     29! 3864 2019-04-05 09:01:56Z monakurppa
    2730! Modifications made for salsa:
    2831! - salsa_prognostic_equations moved to salsa_mod (and the call to
     
    332335 MODULE prognostic_equations_mod
    333336
    334 
    335337    USE advec_s_bc_mod,                                                        &
    336338        ONLY:  advec_s_bc
     
    364366
    365367    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                tnr_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,                         &
    376378               ug, u_init, u_p, v, vg, vpt, v_init, v_p, w, w_p
    377379
    378380    USE bulk_cloud_model_mod,                                                  &
    379381        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
    382383
    383384    USE buoyancy_mod,                                                          &
     
    663664       DO  i = nxlg, nxrg
    664665          DO  j = nysg, nyng
    665              CALL bcm_actions( i, j )
     666             CALL bcm_actions_micro( i, j )
    666667           ENDDO
    667668       ENDDO
     
    11041105             ENDIF
    11051106
    1106 !
    1107 !--          If required, calculate prognostic equations for cloud water content
    1108 !--          and cloud drop concentration
    1109              IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    1110 !
    1111 !--             Calculate prognostic equation for cloud water content
    1112                 tend(:,j,i) = 0.0_wp
    1113                 IF ( timestep_scheme(1:5) == 'runge' ) &
    1114                 THEN
    1115                    IF ( ws_scheme_sca )  THEN
    1116                       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                    ELSE
    1120                       CALL advec_s_pw( i, j, qc )
    1121                    ENDIF
    1122                 ELSE
    1123                    CALL advec_s_up( i, j, qc )
    1124                 ENDIF
    1125                 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 content
    1138                 DO  k = nzb+1, nzt
    1139                    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_wp
    1149                 ENDDO
    1150 !
    1151 !--             Calculate tendencies for the next Runge-Kutta step
    1152                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1153                    IF ( intermediate_timestep_count == 1 )  THEN
    1154                       DO  k = nzb+1, nzt
    1155                          tqc_m(k,j,i) = tend(k,j,i)
    1156                       ENDDO
    1157                    ELSEIF ( intermediate_timestep_count < &
    1158                             intermediate_timestep_count_max )  THEN
    1159                       DO  k = nzb+1, nzt
    1160                          tqc_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +           &
    1161                                            5.3125_wp * tqc_m(k,j,i)
    1162                       ENDDO
    1163                    ENDIF
    1164                 ENDIF
    1165 
    1166 !
    1167 !--             Calculate prognostic equation for cloud drop concentration.
    1168                 tend(:,j,i) = 0.0_wp
    1169                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1170                    IF ( ws_scheme_sca )  THEN
    1171                       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                    ELSE
    1175                       CALL advec_s_pw( i, j, nc )
    1176                    ENDIF
    1177                 ELSE
    1178                    CALL advec_s_up( i, j, nc )
    1179                 ENDIF
    1180                 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 concentration
    1193                 DO  k = nzb+1, nzt
    1194                    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_wp
    1204                 ENDDO
    1205 !
    1206 !--             Calculate tendencies for the next Runge-Kutta step
    1207                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1208                    IF ( intermediate_timestep_count == 1 )  THEN
    1209                       DO  k = nzb+1, nzt
    1210                          tnc_m(k,j,i) = tend(k,j,i)
    1211                       ENDDO
    1212                    ELSEIF ( intermediate_timestep_count < &
    1213                             intermediate_timestep_count_max )  THEN
    1214                       DO  k = nzb+1, nzt
    1215                          tnc_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +           &
    1216                                            5.3125_wp * tnc_m(k,j,i)
    1217                       ENDDO
    1218                    ENDIF
    1219                 ENDIF
    1220 
    1221              ENDIF
    1222 !
    1223 !--          If required, calculate prognostic equations for rain water content
    1224 !--          and rain drop concentration
    1225              IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    1226 !
    1227 !--             Calculate prognostic equation for rain water content
    1228                 tend(:,j,i) = 0.0_wp
    1229                 IF ( timestep_scheme(1:5) == 'runge' ) &
    1230                 THEN
    1231                    IF ( ws_scheme_sca )  THEN
    1232                       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                    ELSE
    1236                       CALL advec_s_pw( i, j, qr )
    1237                    ENDIF
    1238                 ELSE
    1239                    CALL advec_s_up( i, j, qr )
    1240                 ENDIF
    1241                 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 content
    1254                 DO  k = nzb+1, nzt
    1255                    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_wp
    1265                 ENDDO
    1266 !
    1267 !--             Calculate tendencies for the next Runge-Kutta step
    1268                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1269                    IF ( intermediate_timestep_count == 1 )  THEN
    1270                       DO  k = nzb+1, nzt
    1271                          tqr_m(k,j,i) = tend(k,j,i)
    1272                       ENDDO
    1273                    ELSEIF ( intermediate_timestep_count < &
    1274                             intermediate_timestep_count_max )  THEN
    1275                       DO  k = nzb+1, nzt
    1276                          tqr_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +           &
    1277                                            5.3125_wp * tqr_m(k,j,i)
    1278                       ENDDO
    1279                    ENDIF
    1280                 ENDIF
    1281 
    1282 !
    1283 !--             Calculate prognostic equation for rain drop concentration.
    1284                 tend(:,j,i) = 0.0_wp
    1285                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1286                    IF ( ws_scheme_sca )  THEN
    1287                       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                    ELSE
    1291                       CALL advec_s_pw( i, j, nr )
    1292                    ENDIF
    1293                 ELSE
    1294                    CALL advec_s_up( i, j, nr )
    1295                 ENDIF
    1296                 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 concentration
    1309                 DO  k = nzb+1, nzt
    1310                    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_wp
    1320                 ENDDO
    1321 !
    1322 !--             Calculate tendencies for the next Runge-Kutta step
    1323                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
    1324                    IF ( intermediate_timestep_count == 1 )  THEN
    1325                       DO  k = nzb+1, nzt
    1326                          tnr_m(k,j,i) = tend(k,j,i)
    1327                       ENDDO
    1328                    ELSEIF ( intermediate_timestep_count < &
    1329                             intermediate_timestep_count_max )  THEN
    1330                       DO  k = nzb+1, nzt
    1331                          tnr_m(k,j,i) =   -9.5625_wp * tend(k,j,i) +           &
    1332                                            5.3125_wp * tnr_m(k,j,i)
    1333                       ENDDO
    1334                    ENDIF
    1335                 ENDIF
    1336 
    1337              ENDIF
    1338 
    13391107          ENDIF
    13401108
     
    15431311       )  THEN
    15441312       CALL cpu_log( log_point(51), 'microphysics', 'start' )
    1545        CALL bcm_actions
     1313       CALL bcm_actions_micro
    15461314       CALL cpu_log( log_point(51), 'microphysics', 'stop' )
    15471315    ENDIF
     
    21101878       CALL cpu_log( log_point(29), 'q-equation', 'stop' )
    21111879
    2112 !
    2113 !--    If required, calculate prognostic equations for cloud water content
    2114 !--    and cloud drop concentration
    2115        IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    2116 
    2117           CALL cpu_log( log_point(67), 'qc-equation', 'start' )
    2118 
    2119 !
    2120 !--       Calculate prognostic equation for cloud water content
    2121           sbt = tsc(2)
    2122           IF ( scalar_advec == 'bc-scheme' )  THEN
    2123 
    2124              IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2125 !
    2126 !--             Bott-Chlond scheme always uses Euler time step. Thus:
    2127                 sbt = 1.0_wp
    2128              ENDIF
    2129              tend = 0.0_wp
    2130              CALL advec_s_bc( qc, 'qc' )
    2131 
    2132           ENDIF
    2133 
    2134 !
    2135 !--       qc-tendency terms with no communication
    2136           IF ( scalar_advec /= 'bc-scheme' )  THEN
    2137              tend = 0.0_wp
    2138              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2139                 IF ( ws_scheme_sca )  THEN
    2140                    CALL advec_s_ws( qc, 'qc' )
    2141                 ELSE
    2142                    CALL advec_s_pw( qc )
    2143                 ENDIF
    2144              ELSE
    2145                 CALL advec_s_up( qc )
    2146              ENDIF
    2147           ENDIF
    2148 
    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 content
    2162           DO  i = nxl, nxr
    2163              DO  j = nys, nyn
    2164                 DO  k = nzb+1, nzt
    2165                    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_wp
    2174                 ENDDO
    2175              ENDDO
    2176           ENDDO
    2177 
    2178 !
    2179 !--       Calculate tendencies for the next Runge-Kutta step
    2180           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2181              IF ( intermediate_timestep_count == 1 )  THEN
    2182                 DO  i = nxl, nxr
    2183                    DO  j = nys, nyn
    2184                       DO  k = nzb+1, nzt
    2185                          tqc_m(k,j,i) = tend(k,j,i)
    2186                       ENDDO
    2187                    ENDDO
    2188                 ENDDO
    2189              ELSEIF ( intermediate_timestep_count < &
    2190                       intermediate_timestep_count_max )  THEN
    2191                 DO  i = nxl, nxr
    2192                    DO  j = nys, nyn
    2193                       DO  k = nzb+1, nzt
    2194                          tqc_m(k,j,i) =   -9.5625_wp * tend(k,j,i)             &
    2195                                          + 5.3125_wp * tqc_m(k,j,i)
    2196                       ENDDO
    2197                    ENDDO
    2198                 ENDDO
    2199              ENDIF
    2200           ENDIF
    2201 
    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 concentration
    2207           sbt = tsc(2)
    2208           IF ( scalar_advec == 'bc-scheme' )  THEN
    2209 
    2210              IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2211 !
    2212 !--             Bott-Chlond scheme always uses Euler time step. Thus:
    2213                 sbt = 1.0_wp
    2214              ENDIF
    2215              tend = 0.0_wp
    2216              CALL advec_s_bc( nc, 'nc' )
    2217 
    2218           ENDIF
    2219 
    2220 !
    2221 !--       nc-tendency terms with no communication
    2222           IF ( scalar_advec /= 'bc-scheme' )  THEN
    2223              tend = 0.0_wp
    2224              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2225                 IF ( ws_scheme_sca )  THEN
    2226                    CALL advec_s_ws( nc, 'nc' )
    2227                 ELSE
    2228                    CALL advec_s_pw( nc )
    2229                 ENDIF
    2230              ELSE
    2231                 CALL advec_s_up( nc )
    2232              ENDIF
    2233           ENDIF
    2234 
    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 concentration
    2248           DO  i = nxl, nxr
    2249              DO  j = nys, nyn
    2250                 DO  k = nzb+1, nzt
    2251                    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_wp
    2260                 ENDDO
    2261              ENDDO
    2262           ENDDO
    2263 
    2264 !
    2265 !--       Calculate tendencies for the next Runge-Kutta step
    2266           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2267              IF ( intermediate_timestep_count == 1 )  THEN
    2268                 DO  i = nxl, nxr
    2269                    DO  j = nys, nyn
    2270                       DO  k = nzb+1, nzt
    2271                          tnc_m(k,j,i) = tend(k,j,i)
    2272                       ENDDO
    2273                    ENDDO
    2274                 ENDDO
    2275              ELSEIF ( intermediate_timestep_count < &
    2276                       intermediate_timestep_count_max )  THEN
    2277                 DO  i = nxl, nxr
    2278                    DO  j = nys, nyn
    2279                       DO  k = nzb+1, nzt
    2280                          tnc_m(k,j,i) =  -9.5625_wp * tend(k,j,i)             &
    2281                                          + 5.3125_wp * tnc_m(k,j,i)
    2282                       ENDDO
    2283                    ENDDO
    2284                 ENDDO
    2285              ENDIF
    2286           ENDIF
    2287 
    2288           CALL cpu_log( log_point(68), 'nc-equation', 'stop' )
    2289 
    2290        ENDIF
    2291 !
    2292 !--    If required, calculate prognostic equations for rain water content
    2293 !--    and rain drop concentration
    2294        IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    2295 
    2296           CALL cpu_log( log_point(52), 'qr-equation', 'start' )
    2297 
    2298 !
    2299 !--       Calculate prognostic equation for rain water content
    2300           sbt = tsc(2)
    2301           IF ( scalar_advec == 'bc-scheme' )  THEN
    2302 
    2303              IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2304 !
    2305 !--             Bott-Chlond scheme always uses Euler time step. Thus:
    2306                 sbt = 1.0_wp
    2307              ENDIF
    2308              tend = 0.0_wp
    2309              CALL advec_s_bc( qr, 'qr' )
    2310 
    2311           ENDIF
    2312 
    2313 !
    2314 !--       qr-tendency terms with no communication
    2315           IF ( scalar_advec /= 'bc-scheme' )  THEN
    2316              tend = 0.0_wp
    2317              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2318                 IF ( ws_scheme_sca )  THEN
    2319                    CALL advec_s_ws( qr, 'qr' )
    2320                 ELSE
    2321                    CALL advec_s_pw( qr )
    2322                 ENDIF
    2323              ELSE
    2324                 CALL advec_s_up( qr )
    2325              ENDIF
    2326           ENDIF
    2327 
    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 content
    2341           DO  i = nxl, nxr
    2342              DO  j = nys, nyn
    2343                 DO  k = nzb+1, nzt
    2344                    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_wp
    2353                 ENDDO
    2354              ENDDO
    2355           ENDDO
    2356 
    2357 !
    2358 !--       Calculate tendencies for the next Runge-Kutta step
    2359           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2360              IF ( intermediate_timestep_count == 1 )  THEN
    2361                 DO  i = nxl, nxr
    2362                    DO  j = nys, nyn
    2363                       DO  k = nzb+1, nzt
    2364                          tqr_m(k,j,i) = tend(k,j,i)
    2365                       ENDDO
    2366                    ENDDO
    2367                 ENDDO
    2368              ELSEIF ( intermediate_timestep_count < &
    2369                       intermediate_timestep_count_max )  THEN
    2370                 DO  i = nxl, nxr
    2371                    DO  j = nys, nyn
    2372                       DO  k = nzb+1, nzt
    2373                          tqr_m(k,j,i) =   -9.5625_wp * tend(k,j,i)             &
    2374                                          + 5.3125_wp * tqr_m(k,j,i)
    2375                       ENDDO
    2376                    ENDDO
    2377                 ENDDO
    2378              ENDIF
    2379           ENDIF
    2380 
    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 concentration
    2386           sbt = tsc(2)
    2387           IF ( scalar_advec == 'bc-scheme' )  THEN
    2388 
    2389              IF ( timestep_scheme(1:5) /= 'runge' )  THEN
    2390 !
    2391 !--             Bott-Chlond scheme always uses Euler time step. Thus:
    2392                 sbt = 1.0_wp
    2393              ENDIF
    2394              tend = 0.0_wp
    2395              CALL advec_s_bc( nr, 'nr' )
    2396 
    2397           ENDIF
    2398 
    2399 !
    2400 !--       nr-tendency terms with no communication
    2401           IF ( scalar_advec /= 'bc-scheme' )  THEN
    2402              tend = 0.0_wp
    2403              IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2404                 IF ( ws_scheme_sca )  THEN
    2405                    CALL advec_s_ws( nr, 'nr' )
    2406                 ELSE
    2407                    CALL advec_s_pw( nr )
    2408                 ENDIF
    2409              ELSE
    2410                 CALL advec_s_up( nr )
    2411              ENDIF
    2412           ENDIF
    2413 
    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 concentration
    2427           DO  i = nxl, nxr
    2428              DO  j = nys, nyn
    2429                 DO  k = nzb+1, nzt
    2430                    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_wp
    2439                 ENDDO
    2440              ENDDO
    2441           ENDDO
    2442 
    2443 !
    2444 !--       Calculate tendencies for the next Runge-Kutta step
    2445           IF ( timestep_scheme(1:5) == 'runge' )  THEN
    2446              IF ( intermediate_timestep_count == 1 )  THEN
    2447                 DO  i = nxl, nxr
    2448                    DO  j = nys, nyn
    2449                       DO  k = nzb+1, nzt
    2450                          tnr_m(k,j,i) = tend(k,j,i)
    2451                       ENDDO
    2452                    ENDDO
    2453                 ENDDO
    2454              ELSEIF ( intermediate_timestep_count < &
    2455                       intermediate_timestep_count_max )  THEN
    2456                 DO  i = nxl, nxr
    2457                    DO  j = nys, nyn
    2458                       DO  k = nzb+1, nzt
    2459                          tnr_m(k,j,i) =  -9.5625_wp * tend(k,j,i)             &
    2460                                          + 5.3125_wp * tnr_m(k,j,i)
    2461                       ENDDO
    2462                    ENDDO
    2463                 ENDDO
    2464              ENDIF
    2465           ENDIF
    2466 
    2467           CALL cpu_log( log_point(53), 'nr-equation', 'stop' )
    2468 
    2469        ENDIF
    2470 
    24711880    ENDIF
    24721881!
Note: See TracChangeset for help on using the changeset viewer.