Changeset 3445
- Timestamp:
- Oct 29, 2018 12:23:02 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/bulk_cloud_model_mod.f90
r3383 r3445 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Minor bugfix and use of subroutine for supersaturation calculation in case 28 ! of cache version 29 ! 30 ! 3383 2018-10-19 14:22:58Z knoop 27 31 ! Modularization of all bulk cloud physics code components 28 !29 32 ! 30 33 ! unused variables removed … … 2163 2166 2164 2167 ! 2165 !-- Call calculation of supersaturation located 2166 !-- in diagnostic_quantities_mod 2168 !-- Call calculation of supersaturation located in subroutine 2167 2169 CALL supersaturation ( i, j, k ) 2168 2170 ! … … 2267 2269 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 2268 2270 ! 2269 !-- Call calculation of supersaturation located 2270 !-- in diagnostic_quantities_mod 2271 !-- Call calculation of supersaturation 2271 2272 CALL supersaturation ( i, j, k ) 2272 2273 ! … … 2683 2684 2684 2685 ! 2685 !-- Call calculation of supersaturation located 2686 !-- in diagnostic_quantities_mod 2686 !-- Call calculation of supersaturation 2687 2687 CALL supersaturation ( i, j, k ) 2688 2688 ! … … 3281 3281 REAL(wp) :: activ !< 3282 3282 REAL(wp) :: afactor !< 3283 REAL(wp) :: alpha !<3284 3283 REAL(wp) :: beta_act !< 3285 3284 REAL(wp) :: bfactor !< 3286 REAL(wp) :: e_s !<3287 3285 REAL(wp) :: flag !< flag to indicate first grid level above surface 3288 3286 REAL(wp) :: k_act !< 3289 3287 REAL(wp) :: n_act !< 3290 3288 REAL(wp) :: n_ccn !< 3291 REAL(wp) :: q_s !<3292 3289 REAL(wp) :: s_0 !< 3293 REAL(wp) :: sat !<3294 3290 REAL(wp) :: sat_max !< 3295 3291 REAL(wp) :: sigma !< 3296 3292 REAL(wp) :: sigma_act !< 3297 REAL(wp) :: t_int !<3298 REAL(wp) :: t_l !<3299 3293 3300 3294 DO k = nzb+1, nzt … … 3303 3297 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 3304 3298 ! 3305 !-- Actual liquid water temperature: 3306 t_l = exner(k) * pt(k,j,i) 3307 3308 ! 3309 !-- Calculate actual temperature 3310 t_int = pt(k,j,i) * exner_function( hyp(k) ) 3311 ! 3312 !-- Saturation vapor pressure at t_l: 3313 e_s = 610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / & 3314 ( t_l - 35.86_wp ) & 3315 ) 3316 ! 3317 !-- Computation of saturation mixing ratio: 3318 q_s = rd_d_rv * e_s / ( hyp(k) - e_s ) 3319 alpha = rd_d_rv * lv_d_rd * lv_d_cp / ( t_l * t_l ) 3320 q_s = q_s * ( 1.0_wp + alpha * q(k,j,i) ) / & 3321 ( 1.0_wp + alpha * q_s ) 3322 3323 !-- Supersaturation: 3324 sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 3325 3299 !-- Call calculation of supersaturation 3300 CALL supersaturation ( i, j, k ) 3326 3301 ! 3327 3302 !-- Prescribe parameters for activation … … 3330 3305 activ = 0.0_wp 3331 3306 3332 IF ( sat > =0.0 .AND. .NOT. curvature_solution_effects_bulk ) THEN3307 IF ( sat > 0.0 .AND. .NOT. curvature_solution_effects_bulk ) THEN 3333 3308 ! 3334 3309 !-- Compute the number of activated Aerosols … … 3349 3324 3350 3325 nc(k,j,i) = MIN( (nc(k,j,i) + activ * dt_micro), na_init) 3351 ELSEIF ( sat > =0.0 .AND. curvature_solution_effects_bulk ) THEN3326 ELSEIF ( sat > 0.0 .AND. curvature_solution_effects_bulk ) THEN 3352 3327 ! 3353 3328 !-- Curvature effect (afactor) with surface tension 3354 3329 !-- parameterization by Straka (2009) 3355 sigma = 0.0761_wp - 0.000155_wp * ( t_ int- 273.15_wp )3356 afactor = 2.0_wp * sigma / ( rho_l * r_v * t_ int)3330 sigma = 0.0761_wp - 0.000155_wp * ( t_l - 273.15_wp ) 3331 afactor = 2.0_wp * sigma / ( rho_l * r_v * t_l ) 3357 3332 ! 3358 3333 !-- Solute effect (bfactor) … … 3401 3376 INTEGER(iwp) :: k !< 3402 3377 3403 REAL(wp) :: alpha !<3404 3378 REAL(wp) :: cond !< 3405 3379 REAL(wp) :: cond_max !< 3406 3380 REAL(wp) :: dc !< 3407 REAL(wp) :: e_s !<3408 3381 REAL(wp) :: evap !< 3409 3382 REAL(wp) :: flag !< flag to indicate first grid level above surface 3410 3383 REAL(wp) :: g_fac !< 3411 3384 REAL(wp) :: nc_0 !< 3412 REAL(wp) :: q_s !<3413 REAL(wp) :: sat !<3414 REAL(wp) :: t_l !<3415 3385 REAL(wp) :: temp !< 3416 3386 REAL(wp) :: xc !< … … 3422 3392 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 3423 3393 ! 3424 !-- Actual liquid water temperature: 3425 t_l = exner(k) * pt(k,j,i) 3426 ! 3427 !-- Saturation vapor pressure at t_l: 3428 e_s = 610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / & 3429 ( t_l - 35.86_wp ) & 3430 ) 3431 ! 3432 !-- Computation of saturation mixing ratio: 3433 q_s = rd_d_rv * e_s / ( hyp(k) - e_s ) 3434 alpha = rd_d_rv * lv_d_rd * lv_d_cp / ( t_l * t_l ) 3435 q_s = q_s * ( 1.0_wp + alpha * q(k,j,i) ) / & 3436 ( 1.0_wp + alpha * q_s ) 3437 3438 !-- Supersaturation: 3439 sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 3440 3441 3394 !-- Call calculation of supersaturation 3395 CALL supersaturation ( i, j, k ) 3442 3396 ! 3443 3397 !-- Actual temperature: … … 3776 3730 INTEGER(iwp) :: k !< 3777 3731 3778 REAL(wp) :: alpha !<3779 3732 REAL(wp) :: dr !< 3780 REAL(wp) :: e_s !<3781 3733 REAL(wp) :: evap !< 3782 3734 REAL(wp) :: evap_nr !< … … 3789 3741 REAL(wp) :: mu_r_5d2 !< 3790 3742 REAL(wp) :: nr_0 !< 3791 REAL(wp) :: q_s !<3792 REAL(wp) :: sat !<3793 REAL(wp) :: t_l !<3794 3743 REAL(wp) :: temp !< 3795 3744 REAL(wp) :: xr !< … … 3802 3751 IF ( qr(k,j,i) > eps_sb ) THEN 3803 3752 ! 3804 !-- Actual liquid water temperature: 3805 t_l = exner(k) * pt(k,j,i) 3806 ! 3807 !-- Saturation vapor pressure at t_l: 3808 e_s = 610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / & 3809 ( t_l - 35.86_wp ) & 3810 ) 3811 ! 3812 !-- Computation of saturation mixing ratio: 3813 q_s = rd_d_rv * e_s / ( hyp(k) - e_s ) 3814 alpha = rd_d_rv * lv_d_rd * lv_d_cp / ( t_l * t_l ) 3815 q_s = q_s * ( 1.0_wp + alpha * q(k,j,i) ) / ( 1.0_wp + alpha * q_s ) 3816 ! 3817 !-- Supersaturation: 3818 sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 3753 !-- Call calculation of supersaturation 3754 CALL supersaturation ( i, j, k ) 3819 3755 ! 3820 3756 !-- Evaporation needs only to be calculated in subsaturated regions … … 4304 4240 ! 4305 4241 !-- Call calculation of supersaturation located 4306 !-- in diagnostic_quantities_mod4307 4242 CALL supersaturation( i, j, k ) 4308 4243
Note: See TracChangeset
for help on using the changeset viewer.