Changeset 3445 for palm/trunk/SOURCE


Ignore:
Timestamp:
Oct 29, 2018 12:23:02 PM (5 years ago)
Author:
schwenkel
Message:

Minor bugfix and use of subroutine for supersaturation calculation in case of cache version

File:
1 edited

Legend:

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

    r3383 r3445  
    2525! -----------------
    2626! $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
    2731! Modularization of all bulk cloud physics code components
    28 !
    2932!
    3033! unused variables removed
     
    21632166
    21642167!
    2165 !--             Call calculation of supersaturation located
    2166 !--             in diagnostic_quantities_mod
     2168!--             Call calculation of supersaturation located in subroutine
    21672169                CALL supersaturation ( i, j, k )
    21682170!
     
    22672269                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    22682270!
    2269 !--             Call calculation of supersaturation located
    2270 !--             in diagnostic_quantities_mod
     2271!--             Call calculation of supersaturation
    22712272                CALL supersaturation ( i, j, k )
    22722273!
     
    26832684
    26842685!
    2685 !--                Call calculation of supersaturation located
    2686 !--                in diagnostic_quantities_mod
     2686!--                Call calculation of supersaturation 
    26872687                   CALL supersaturation ( i, j, k )
    26882688!
     
    32813281       REAL(wp)     ::  activ             !<
    32823282       REAL(wp)     ::  afactor           !<
    3283        REAL(wp)     ::  alpha             !<
    32843283       REAL(wp)     ::  beta_act          !<
    32853284       REAL(wp)     ::  bfactor           !<
    3286        REAL(wp)     ::  e_s               !<
    32873285       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
    32883286       REAL(wp)     ::  k_act             !<
    32893287       REAL(wp)     ::  n_act             !<
    32903288       REAL(wp)     ::  n_ccn             !<
    3291        REAL(wp)     ::  q_s               !<
    32923289       REAL(wp)     ::  s_0               !<
    3293        REAL(wp)     ::  sat               !<
    32943290       REAL(wp)     ::  sat_max           !<
    32953291       REAL(wp)     ::  sigma             !<
    32963292       REAL(wp)     ::  sigma_act         !<
    3297        REAL(wp)     ::  t_int             !<
    3298        REAL(wp)     ::  t_l               !<
    32993293
    33003294       DO  k = nzb+1, nzt
     
    33033297          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    33043298!
    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 )
    33263301!
    33273302!--       Prescribe parameters for activation
     
    33303305          activ  = 0.0_wp
    33313306
    3332           IF ( sat >= 0.0 .AND. .NOT. curvature_solution_effects_bulk )  THEN
     3307          IF ( sat > 0.0 .AND. .NOT. curvature_solution_effects_bulk )  THEN
    33333308!
    33343309!--          Compute the number of activated Aerosols
     
    33493324
    33503325             nc(k,j,i) = MIN( (nc(k,j,i) + activ * dt_micro), na_init)
    3351           ELSEIF ( sat >= 0.0 .AND. curvature_solution_effects_bulk )  THEN
     3326          ELSEIF ( sat > 0.0 .AND. curvature_solution_effects_bulk )  THEN
    33523327!
    33533328!--          Curvature effect (afactor) with surface tension
    33543329!--          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 )
    33573332!
    33583333!--          Solute effect (bfactor)
     
    34013376       INTEGER(iwp) ::  k                 !<
    34023377
    3403        REAL(wp)     ::  alpha             !<
    34043378       REAL(wp)     ::  cond              !<
    34053379       REAL(wp)     ::  cond_max          !<
    34063380       REAL(wp)     ::  dc                !<
    3407        REAL(wp)     ::  e_s               !<
    34083381       REAL(wp)     ::  evap              !<
    34093382       REAL(wp)     ::  flag              !< flag to indicate first grid level above surface
    34103383       REAL(wp)     ::  g_fac             !<
    34113384       REAL(wp)     ::  nc_0              !<
    3412        REAL(wp)     ::  q_s               !<
    3413        REAL(wp)     ::  sat               !<
    3414        REAL(wp)     ::  t_l               !<
    34153385       REAL(wp)     ::  temp              !<
    34163386       REAL(wp)     ::  xc                !<
     
    34223392          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
    34233393!
    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 )
    34423396!
    34433397!--       Actual temperature:
     
    37763730       INTEGER(iwp) ::  k                 !<
    37773731
    3778        REAL(wp)     ::  alpha             !<
    37793732       REAL(wp)     ::  dr                !<
    3780        REAL(wp)     ::  e_s               !<
    37813733       REAL(wp)     ::  evap              !<
    37823734       REAL(wp)     ::  evap_nr           !<
     
    37893741       REAL(wp)     ::  mu_r_5d2          !<
    37903742       REAL(wp)     ::  nr_0              !<
    3791        REAL(wp)     ::  q_s               !<
    3792        REAL(wp)     ::  sat               !<
    3793        REAL(wp)     ::  t_l               !<
    37943743       REAL(wp)     ::  temp              !<
    37953744       REAL(wp)     ::  xr                !<
     
    38023751          IF ( qr(k,j,i) > eps_sb )  THEN
    38033752!
    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 )
    38193755!
    38203756!--          Evaporation needs only to be calculated in subsaturated regions
     
    43044240   !
    43054241   !--          Call calculation of supersaturation located
    4306    !--          in diagnostic_quantities_mod
    43074242                CALL supersaturation( i, j, k )
    43084243
Note: See TracChangeset for help on using the changeset viewer.