Changeset 4027 for palm/trunk/SOURCE/bulk_cloud_model_mod.f90
- Timestamp:
- Jun 13, 2019 8:48:51 AM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/bulk_cloud_model_mod.f90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/bulk_cloud_model_mod.f90
r3931 r4027 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Added microphyics scheme 'morrision_no_rain' 28 ! 29 ! 3931 2019-04-24 16:34:28Z schwenkel 27 30 ! Added bcm_exchange_horiz which is called after non_transport_physics 28 31 ! … … 301 304 LOGICAL :: microphysics_morrison = .FALSE. !< use 2-moment Morrison (add. prog. eq. for nc and qc) 302 305 LOGICAL :: microphysics_seifert = .FALSE. !< use 2-moment Seifert and Beheng scheme 306 LOGICAL :: microphysics_morrison_no_rain = .FALSE. !< use 2-moment Morrison 303 307 LOGICAL :: precipitation = .FALSE. !< namelist parameter 304 308 … … 391 395 dt_precipitation, & 392 396 microphysics_morrison, & 397 microphysics_morrison_no_rain, & 393 398 microphysics_sat_adjust, & 394 399 microphysics_seifert, & … … 548 553 ! 549 554 !-- Check cloud scheme 555 !-- This scheme considers only saturation adjustment, 556 !-- i.e. water vapor surplus is converted into liquid 557 !-- water. No other microphysical processes are considered 550 558 IF ( cloud_scheme == 'saturation_adjust' ) THEN 551 559 microphysics_sat_adjust = .TRUE. … … 553 561 microphysics_kessler = .FALSE. 554 562 precipitation = .FALSE. 563 microphysics_morrison_no_rain = .FALSE. 564 ! 565 !-- This scheme includes all process of the seifert 566 !-- beheng scheme (2001,2006). Especially rain processes are 567 !-- considered with prognostic quantities of qr and nr. 568 !-- Cloud droplet concentration is assumed to be constant and 569 !-- qc is diagnostic. 570 !-- Technical remark: The switch 'microphysics_seifert' allocates 571 !-- fields of qr and nr and enables all rain processes. 555 572 ELSEIF ( cloud_scheme == 'seifert_beheng' ) THEN 556 573 microphysics_sat_adjust = .FALSE. … … 559 576 microphysics_morrison = .FALSE. 560 577 precipitation = .TRUE. 578 microphysics_morrison_no_rain = .FALSE. 579 ! 580 !-- The kessler scheme is a simplified scheme without any 581 !-- prognostic quantities for microphyical variables but 582 !-- considering autoconversion. 561 583 ELSEIF ( cloud_scheme == 'kessler' ) THEN 562 584 microphysics_sat_adjust = .FALSE. … … 565 587 microphysics_morrison = .FALSE. 566 588 precipitation = .TRUE. 589 microphysics_morrison_no_rain = .FALSE. 590 ! 591 !-- The morrison scheme is an extension of the seifer beheng scheme 592 !-- including also relevant processes for cloud droplet size particles 593 !-- such as activation and an diagnostic mehtod for diffusional growth. 594 !-- I.e. here all processes of Seifert and Beheng as well as of the 595 !-- morrision scheme are used. Therefore, ztis includes prognostic 596 !-- quantities for qc and nc. 597 !-- Technical remark: The switch 'microphysics_morrison' allocates 598 !-- fields of qc and nc and enables diagnostic diffusional growth and 599 !-- activation. 567 600 ELSEIF ( cloud_scheme == 'morrison' ) THEN 568 601 microphysics_sat_adjust = .FALSE. … … 571 604 microphysics_morrison = .TRUE. 572 605 precipitation = .TRUE. 606 microphysics_morrison_no_rain = .FALSE. 607 ! 608 !-- The 'morrision_no_rain' scheme includes only processes of morrision scheme 609 !-- without the rain processes of seifert beheng. Therfore, the prog. quantities 610 !-- of qr and nr remain unallocated. This might be appropiate for cloud in which 611 !-- the size distribution is narrow, e.g. fog. 612 ELSEIF ( cloud_scheme == 'morrison_no_rain' ) THEN 613 microphysics_sat_adjust = .FALSE. 614 microphysics_seifert = .FALSE. 615 microphysics_kessler = .FALSE. 616 microphysics_morrison = .TRUE. 617 microphysics_morrison_no_rain = .TRUE. 618 precipitation = .FALSE. 573 619 ELSE 574 620 message_string = 'unknown cloud microphysics scheme cloud_scheme ="' // & … … 1226 1272 ! 1227 1273 !-- Compute cloud physics 1274 !-- Here the the simple kessler scheme is used. 1228 1275 IF ( microphysics_kessler ) THEN 1229 1230 1276 CALL autoconversion_kessler 1231 1277 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1232 1233 ELSEIF ( microphysics_seifert ) THEN 1234 1278 1279 ! 1280 !-- Here the seifert beheng scheme is used. Cloud concentration is assumed to 1281 !-- a constant value an qc a diagnostic value. 1282 ELSEIF ( microphysics_seifert .AND. .NOT. microphysics_morrison ) THEN 1235 1283 CALL adjust_cloud 1236 IF ( microphysics_morrison ) CALL activation1237 IF ( microphysics_morrison ) CALL condensation1238 1284 CALL autoconversion 1239 1285 CALL accretion … … 1242 1288 CALL sedimentation_rain 1243 1289 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1290 1291 ! 1292 !-- Here the morrison scheme is used. No rain processes are considered and qr and nr 1293 !-- are not allocated 1294 ELSEIF ( microphysics_morrison_no_rain .AND. .NOT. microphysics_seifert ) THEN 1295 CALL activation 1296 CALL condensation 1297 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1298 1299 ! 1300 !-- Here the full morrison scheme is used and all processes of Seifert and Beheng are 1301 !-- included 1302 ELSEIF ( microphysics_morrison .AND. microphysics_seifert ) THEN 1303 CALL adjust_cloud 1304 CALL activation 1305 CALL condensation 1306 CALL autoconversion 1307 CALL accretion 1308 CALL selfcollection_breakup 1309 CALL evaporation_rain 1310 CALL sedimentation_rain 1311 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1244 1312 1245 1313 ENDIF … … 1296 1364 ! 1297 1365 !-- Compute cloud physics 1366 !-- Here the the simple kessler scheme is used. 1298 1367 IF( microphysics_kessler ) THEN 1299 1300 1368 CALL autoconversion_kessler_ij( i,j ) 1301 1369 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1302 1370 1303 ELSEIF ( microphysics_seifert ) THEN 1304 1371 ! 1372 !-- Here the seifert beheng scheme is used. Cloud concentration is assumed to 1373 !-- a constant value an qc a diagnostic value. 1374 ELSEIF ( microphysics_seifert .AND. .NOT. microphysics_morrison ) THEN 1305 1375 CALL adjust_cloud_ij( i,j ) 1306 IF ( microphysics_morrison ) CALL activation_ij( i,j )1307 IF ( microphysics_morrison ) CALL condensation_ij( i,j )1308 1376 CALL autoconversion_ij( i,j ) 1309 1377 CALL accretion_ij( i,j ) … … 1312 1380 CALL sedimentation_rain_ij( i,j ) 1313 1381 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1382 1383 ! 1384 !-- Here the morrison scheme is used. No rain processes are considered and qr and nr 1385 !-- are not allocated 1386 ELSEIF ( microphysics_morrison_no_rain .AND. .NOT. microphysics_seifert ) THEN 1387 CALL activation_ij( i,j ) 1388 CALL condensation_ij( i,j ) 1389 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1390 1391 ! 1392 !-- Here the full morrison scheme is used and all processes of Seifert and Beheng are 1393 !-- included 1394 ELSEIF ( microphysics_morrison .AND. microphysics_seifert ) THEN 1395 CALL adjust_cloud_ij( i,j ) 1396 CALL activation_ij( i,j ) 1397 CALL condensation_ij( i,j ) 1398 CALL autoconversion_ij( i,j ) 1399 CALL accretion_ij( i,j ) 1400 CALL selfcollection_breakup_ij( i,j ) 1401 CALL evaporation_rain_ij( i,j ) 1402 CALL sedimentation_rain_ij( i,j ) 1403 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1314 1404 1315 1405 ENDIF … … 3269 3359 ! 3270 3360 !-- Actual temperature: 3271 temp = t_l + lv_d_cp * ( qc(k,j,i) + qr(k,j,i) ) 3361 IF ( microphysics_seifert ) THEN 3362 temp = t_l + lv_d_cp * ( qc(k,j,i) + qr(k,j,i) ) 3363 ELSEIF ( microphysics_morrison_no_rain ) THEN 3364 temp = t_l + lv_d_cp * qc(k,j,i) 3365 ENDIF 3272 3366 3273 3367 g_fac = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) * & … … 3293 3387 !-- (see: Khairoutdinov + Kogan, 2000, Mon. Wea. Rev.,128) 3294 3388 cond = 2.0_wp * pi * nc_0 * g_fac * sat / hyrho(k) 3295 cond_max = q(k,j,i) - q_s - qc(k,j,i) - qr(k,j,i) 3389 IF ( microphysics_seifert ) THEN 3390 cond_max = q(k,j,i) - q_s - qc(k,j,i) - qr(k,j,i) 3391 ELSEIF ( microphysics_morrison_no_rain ) THEN 3392 cond_max = q(k,j,i) - q_s - qc(k,j,i) 3393 ENDIF 3296 3394 cond = MIN( cond, cond_max / dt_micro ) 3297 3395 … … 3348 3446 ! 3349 3447 !-- Actual temperature: 3350 temp = t_l + lv_d_cp * ( qc(k,j,i) + qr(k,j,i) ) 3448 IF ( microphysics_seifert ) THEN 3449 temp = t_l + lv_d_cp * ( qc(k,j,i) + qr(k,j,i) ) 3450 ELSEIF ( microphysics_morrison_no_rain ) THEN 3451 temp = t_l + lv_d_cp * qc(k,j,i) 3452 ENDIF 3351 3453 3352 3454 g_fac = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) * & … … 3372 3474 !-- (see: Khairoutdinov + Kogan, 2000, Mon. Wea. Rev.,128) 3373 3475 cond = 2.0_wp * pi * nc_0 * g_fac * sat / hyrho(k) 3374 cond_max = q(k,j,i) - q_s - qc(k,j,i) - qr(k,j,i) 3476 IF ( microphysics_seifert ) THEN 3477 cond_max = q(k,j,i) - q_s - qc(k,j,i) - qr(k,j,i) 3478 ELSEIF ( microphysics_morrison_no_rain ) THEN 3479 cond_max = q(k,j,i) - q_s - qc(k,j,i) 3480 ENDIF 3375 3481 cond = MIN( cond, cond_max / dt_micro ) 3376 3482 … … 4997 5103 !-- Not in case of microphysics_kessler or microphysics_sat_adjust 4998 5104 !-- since qr is unallocated 4999 IF ( .NOT. microphysics_kessler .AND. & 5000 .NOT. microphysics_sat_adjust ) THEN 5001 sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 5105 IF ( microphysics_seifert ) THEN 5106 sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 5107 ELSEIF ( microphysics_morrison_no_rain ) THEN 5108 sat = ( q(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 5002 5109 ENDIF 5003 5110 … … 5032 5139 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 5033 5140 5034 5035 !--Call calculation of supersaturation located5141 ! 5142 !-- Call calculation of supersaturation located 5036 5143 CALL supersaturation( i, j, k ) 5037 5144 5038 5039 !--Compute the liquid water content5145 ! 5146 !-- Compute the liquid water content 5040 5147 IF ( microphysics_seifert .AND. .NOT. microphysics_morrison ) & 5041 5148 THEN … … 5048 5155 ql(k,j,i) = qr(k,j,i) * flag 5049 5156 ENDIF 5050 ELSEIF ( microphysics_morrison ) THEN5157 ELSEIF ( microphysics_morrison .AND. microphysics_seifert ) THEN 5051 5158 ql(k,j,i) = qc(k,j,i) + qr(k,j,i) * flag 5159 ELSEIF ( microphysics_morrison .AND. .NOT. microphysics_seifert ) THEN 5160 ql(k,j,i) = qc(k,j,i) 5052 5161 ELSE 5053 5162 IF ( ( q(k,j,i) - q_s ) > 0.0_wp ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
