Ignore:
Timestamp:
Apr 8, 2019 4:53:48 PM (5 years ago)
Author:
knoop
Message:

Implemented non_transport_physics module interfaces

File:
1 edited

Legend:

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

    r3870 r3874  
    2525! -----------------
    2626! $Id$
     27! Implemented non_transport_physics module interfaces
     28!
     29! 3870 2019-04-08 13:44:34Z knoop
    2730! Moving prognostic equations of bcm into bulk_cloud_model_mod
    2831!
     
    360363           bcm_header, &
    361364           bcm_actions, &
    362            bcm_actions_micro, &
     365           bcm_non_transport_physics, &
    363366           bcm_prognostic_equations, &
    364367           bcm_3d_data_averaging, &
     
    420423    END INTERFACE bcm_actions
    421424
    422     INTERFACE bcm_actions_micro
    423        MODULE PROCEDURE bcm_actions_micro
    424        MODULE PROCEDURE bcm_actions_micro_ij
    425     END INTERFACE bcm_actions_micro
     425    INTERFACE bcm_non_transport_physics
     426       MODULE PROCEDURE bcm_non_transport_physics
     427       MODULE PROCEDURE bcm_non_transport_physics_ij
     428    END INTERFACE bcm_non_transport_physics
    426429
    427430    INTERFACE bcm_prognostic_equations
     
    11741177!> Control of microphysics for all grid points
    11751178!------------------------------------------------------------------------------!
    1176     SUBROUTINE bcm_actions_micro
    1177 
    1178        IMPLICIT NONE
    1179 
    1180        IF ( large_scale_forcing  .AND.  lsf_surf ) THEN
    1181 !
    1182 !--       Calculate vertical profile of the hydrostatic pressure (hyp)
    1183           hyp    = barometric_formula(zu, pt_surface * exner_function(surface_pressure * 100.0_wp), surface_pressure * 100.0_wp)
    1184           d_exner = exner_function_invers(hyp)
    1185           exner = 1.0_wp / exner_function_invers(hyp)
    1186           hyrho  = ideal_gas_law_rho_pt(hyp, pt_init)
    1187 !
    1188 !--       Compute reference density
    1189           rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp, pt_surface * exner_function(surface_pressure * 100.0_wp))
     1179    SUBROUTINE bcm_non_transport_physics
     1180
     1181
     1182       CALL cpu_log( log_point(51), 'microphysics', 'start' )
     1183
     1184       IF ( .NOT. microphysics_sat_adjust  .AND.         &
     1185            ( intermediate_timestep_count == 1  .OR.                              &
     1186              call_microphysics_at_all_substeps ) )                               &
     1187       THEN
     1188
     1189          IF ( large_scale_forcing  .AND.  lsf_surf ) THEN
     1190!
     1191!--          Calculate vertical profile of the hydrostatic pressure (hyp)
     1192             hyp    = barometric_formula(zu, pt_surface * exner_function(surface_pressure * 100.0_wp), surface_pressure * 100.0_wp)
     1193             d_exner = exner_function_invers(hyp)
     1194             exner = 1.0_wp / exner_function_invers(hyp)
     1195             hyrho  = ideal_gas_law_rho_pt(hyp, pt_init)
     1196!
     1197!--          Compute reference density
     1198             rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp, pt_surface * exner_function(surface_pressure * 100.0_wp))
     1199          ENDIF
     1200
     1201!
     1202!--       Compute length of time step
     1203          IF ( call_microphysics_at_all_substeps )  THEN
     1204             dt_micro = dt_3d * weight_pres(intermediate_timestep_count)
     1205          ELSE
     1206             dt_micro = dt_3d
     1207          ENDIF
     1208
     1209!
     1210!--       Reset precipitation rate
     1211          IF ( intermediate_timestep_count == 1 )  prr = 0.0_wp
     1212
     1213!
     1214!--       Compute cloud physics
     1215          IF ( microphysics_kessler )  THEN
     1216
     1217             CALL autoconversion_kessler
     1218             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud
     1219
     1220          ELSEIF ( microphysics_seifert )  THEN
     1221
     1222             CALL adjust_cloud
     1223             IF ( microphysics_morrison )  CALL activation
     1224             IF ( microphysics_morrison )  CALL condensation
     1225             CALL autoconversion
     1226             CALL accretion
     1227             CALL selfcollection_breakup
     1228             CALL evaporation_rain
     1229             CALL sedimentation_rain
     1230             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud
     1231
     1232          ENDIF
     1233
     1234          CALL calc_precipitation_amount
     1235
    11901236       ENDIF
    11911237
    1192 !
    1193 !--    Compute length of time step
    1194        IF ( call_microphysics_at_all_substeps )  THEN
    1195           dt_micro = dt_3d * weight_pres(intermediate_timestep_count)
    1196        ELSE
    1197           dt_micro = dt_3d
    1198        ENDIF
    1199 
    1200 !
    1201 !--    Reset precipitation rate
    1202        IF ( intermediate_timestep_count == 1 )  prr = 0.0_wp
    1203 
    1204 !
    1205 !--    Compute cloud physics
    1206        IF ( microphysics_kessler )  THEN
    1207 
    1208           CALL autoconversion_kessler
    1209           IF ( cloud_water_sedimentation )  CALL sedimentation_cloud
    1210 
    1211        ELSEIF ( microphysics_seifert )  THEN
    1212 
    1213           CALL adjust_cloud
    1214           IF ( microphysics_morrison )  CALL activation
    1215           IF ( microphysics_morrison )  CALL condensation
    1216           CALL autoconversion
    1217           CALL accretion
    1218           CALL selfcollection_breakup
    1219           CALL evaporation_rain
    1220           CALL sedimentation_rain
    1221           IF ( cloud_water_sedimentation )  CALL sedimentation_cloud
    1222 
    1223        ENDIF
    1224 
    1225        CALL calc_precipitation_amount
    1226 
    1227     END SUBROUTINE bcm_actions_micro
     1238       CALL cpu_log( log_point(51), 'microphysics', 'stop' )
     1239
     1240    END SUBROUTINE bcm_non_transport_physics
    12281241
    12291242
     
    12341247!------------------------------------------------------------------------------!
    12351248
    1236     SUBROUTINE bcm_actions_micro_ij( i, j )
    1237 
    1238        IMPLICIT NONE
     1249    SUBROUTINE bcm_non_transport_physics_ij( i, j )
     1250
    12391251
    12401252       INTEGER(iwp) ::  i                 !<
    12411253       INTEGER(iwp) ::  j                 !<
    12421254
    1243        IF ( large_scale_forcing  .AND.  lsf_surf ) THEN
    1244 !
    1245 !--       Calculate vertical profile of the hydrostatic pressure (hyp)
    1246           hyp    = barometric_formula(zu, pt_surface * exner_function(surface_pressure * 100.0_wp), surface_pressure * 100.0_wp)
    1247           d_exner = exner_function_invers(hyp)
    1248           exner = 1.0_wp / exner_function_invers(hyp)
    1249           hyrho  = ideal_gas_law_rho_pt(hyp, pt_init)
    1250 !
    1251 !--       Compute reference density
    1252           rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp, pt_surface * exner_function(surface_pressure * 100.0_wp))
     1255       IF ( .NOT. microphysics_sat_adjust  .AND.         &
     1256            ( intermediate_timestep_count == 1  .OR.                              &
     1257              call_microphysics_at_all_substeps ) )                               &
     1258       THEN
     1259
     1260          IF ( large_scale_forcing  .AND.  lsf_surf ) THEN
     1261!
     1262!--          Calculate vertical profile of the hydrostatic pressure (hyp)
     1263             hyp    = barometric_formula(zu, pt_surface * exner_function(surface_pressure * 100.0_wp), surface_pressure * 100.0_wp)
     1264             d_exner = exner_function_invers(hyp)
     1265             exner = 1.0_wp / exner_function_invers(hyp)
     1266             hyrho  = ideal_gas_law_rho_pt(hyp, pt_init)
     1267!
     1268!--          Compute reference density
     1269             rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp, pt_surface * exner_function(surface_pressure * 100.0_wp))
     1270          ENDIF
     1271
     1272!
     1273!--       Compute length of time step
     1274          IF ( call_microphysics_at_all_substeps )  THEN
     1275             dt_micro = dt_3d * weight_pres(intermediate_timestep_count)
     1276          ELSE
     1277             dt_micro = dt_3d
     1278          ENDIF
     1279!
     1280!--       Reset precipitation rate
     1281          IF ( intermediate_timestep_count == 1 )  prr(:,j,i) = 0.0_wp
     1282
     1283!
     1284!--       Compute cloud physics
     1285          IF( microphysics_kessler )  THEN
     1286
     1287             CALL autoconversion_kessler_ij( i,j )
     1288             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud_ij( i,j )
     1289
     1290          ELSEIF ( microphysics_seifert )  THEN
     1291
     1292             CALL adjust_cloud_ij( i,j )
     1293             IF ( microphysics_morrison ) CALL activation_ij( i,j )
     1294             IF ( microphysics_morrison ) CALL condensation_ij( i,j )
     1295             CALL autoconversion_ij( i,j )
     1296             CALL accretion_ij( i,j )
     1297             CALL selfcollection_breakup_ij( i,j )
     1298             CALL evaporation_rain_ij( i,j )
     1299             CALL sedimentation_rain_ij( i,j )
     1300             IF ( cloud_water_sedimentation )  CALL sedimentation_cloud_ij( i,j )
     1301
     1302          ENDIF
     1303
     1304          CALL calc_precipitation_amount_ij( i,j )
     1305
    12531306       ENDIF
    12541307
    1255 !
    1256 !--    Compute length of time step
    1257        IF ( call_microphysics_at_all_substeps )  THEN
    1258           dt_micro = dt_3d * weight_pres(intermediate_timestep_count)
    1259        ELSE
    1260           dt_micro = dt_3d
    1261        ENDIF
    1262 !
    1263 !--    Reset precipitation rate
    1264        IF ( intermediate_timestep_count == 1 )  prr(:,j,i) = 0.0_wp
    1265 
    1266 !
    1267 !--    Compute cloud physics
    1268        IF( microphysics_kessler )  THEN
    1269 
    1270           CALL autoconversion_kessler_ij( i,j )
    1271           IF ( cloud_water_sedimentation )  CALL sedimentation_cloud_ij( i,j )
    1272 
    1273        ELSEIF ( microphysics_seifert )  THEN
    1274 
    1275           CALL adjust_cloud_ij( i,j )
    1276           IF ( microphysics_morrison ) CALL activation_ij( i,j )
    1277           IF ( microphysics_morrison ) CALL condensation_ij( i,j )
    1278           CALL autoconversion_ij( i,j )
    1279           CALL accretion_ij( i,j )
    1280           CALL selfcollection_breakup_ij( i,j )
    1281           CALL evaporation_rain_ij( i,j )
    1282           CALL sedimentation_rain_ij( i,j )
    1283           IF ( cloud_water_sedimentation )  CALL sedimentation_cloud_ij( i,j )
    1284 
    1285        ENDIF
    1286 
    1287        CALL calc_precipitation_amount_ij( i,j )
    1288 
    1289     END SUBROUTINE bcm_actions_micro_ij
     1308    END SUBROUTINE bcm_non_transport_physics_ij
    12901309
    12911310
Note: See TracChangeset for help on using the changeset viewer.