From c1aa687cd9082cd1e2b5dec8a1fdc91abda33947 Mon Sep 17 00:00:00 2001 From: Huan Guo Date: Thu, 29 Oct 2020 17:31:08 -0400 Subject: [PATCH 1/9] add MG2 microphysics --- atmos_param/aerosol_cloud/aerosol_cloud.F90 | 239 +- atmos_param/lscloud_driver/lscloud_driver.F90 | 326 +- atmos_param/lscloud_driver/lscloud_netcdf.F90 | 808 +++- atmos_param/lscloud_driver/lscloud_types.F90 | 134 +- atmos_param/macrophysics/tiedtke_macro.F90 | 5 +- .../microphysics/ls_cloud_microphysics.F90 | 445 +- atmos_param/microphysics/micro_mg2.F90 | 4294 +++++++++++++++++ atmos_param/microphysics/micro_mg2_utils.F90 | 1708 +++++++ .../moist_processes/moist_processes.F90 | 17 +- atmos_param/physics_driver/physics_driver.F90 | 13 + atmos_param/physics_driver/physics_types.F90 | 1 + .../tracer_driver/aer_ccn_act/ice_nucl.F90 | 183 +- 12 files changed, 7911 insertions(+), 262 deletions(-) create mode 100644 atmos_param/microphysics/micro_mg2.F90 create mode 100644 atmos_param/microphysics/micro_mg2_utils.F90 diff --git a/atmos_param/aerosol_cloud/aerosol_cloud.F90 b/atmos_param/aerosol_cloud/aerosol_cloud.F90 index 5a63c9ad..7572e409 100644 --- a/atmos_param/aerosol_cloud/aerosol_cloud.F90 +++ b/atmos_param/aerosol_cloud/aerosol_cloud.F90 @@ -27,7 +27,8 @@ MODULE aerosol_cloud_mod USE aer_ccn_act_mod, ONLY : aer_ccn_act_wpdf_m, & aer_ccn_act_init, aer_ccn_act_end USE ice_nucl_mod, ONLY : ice_nucl_wpdf, ice_nucl_wpdf_init, & - ice_nucl_wpdf_end + ice_nucl_wpdf_end, ice_nucl_wpdf_Fan + USE lscloud_types_mod, ONLY : lscloud_types_init, & diag_id_type, diag_pt_type, & atmos_state_type, lscloud_nml_type,& @@ -90,13 +91,19 @@ MODULE aerosol_cloud_mod integer :: var_limit_opt = 1 integer :: up_strat_opt = 1 -namelist / aerosol_cloud_nml / rh_act_opt, sea_salt_scale_onl, & - reproduce_rk, var_limit_ice, & - var_limit, var_limit_opt, up_strat_opt, & - cf_thresh_nucl, treat_nitrate_as_sulfate - +logical :: use_Fan2019_ice_nucl = .false. +logical :: do_sum_homo_het_Fan = .true. ! h1g, 2020-06-01 +logical :: include_all_dust_bins = .false. ! h1g, 2020-06-01 +logical :: include_Ni_bc = .false. ! h1g, 2020-07-03 +logical :: include_Ni_sulf = .false. ! h1g, 2020-07-03 +namelist / aerosol_cloud_nml / rh_act_opt, sea_salt_scale_onl, & + reproduce_rk, var_limit_ice, & + var_limit, var_limit_opt, up_strat_opt, & + cf_thresh_nucl, treat_nitrate_as_sulfate, & + use_Fan2019_ice_nucl, do_sum_homo_het_Fan,& ! h1g, 2020-06-01 + include_all_dust_bins, include_Ni_bc, include_Ni_sulf ! h1g, 2020-07-03 !------------------------------------------------------------------------- real, parameter :: d622 = rdgas / rvgas @@ -123,7 +130,7 @@ MODULE aerosol_cloud_mod real :: sea_salt_scale real :: om_to_oc logical :: do_pdf_clouds -logical :: do_mg_microphys, do_mg_ncar_microphys, do_ncar_microphys +logical :: do_mg_microphys, do_mg_ncar_microphys, do_ncar_microphys, do_ncar_MG2 logical :: total_activation logical :: debug @@ -166,6 +173,9 @@ subroutine aerosol_cloud_init (Constants_lsc, Nml_lsc, Nml_mp, Exch_ctrl) do_mg_microphys = Constants_lsc%do_mg_microphys do_mg_ncar_microphys = Constants_lsc%do_mg_ncar_microphys do_ncar_microphys = Constants_lsc%do_ncar_microphys + + do_ncar_MG2 =Constants_lsc%do_ncar_MG2 + total_activation = Constants_lsc%total_activation !------------------------------------------------------------------------- @@ -342,6 +352,8 @@ subroutine determine_activated_aerosol ( & eslt, esit, qvsl, qvsi, qs_d, qvt INTEGER :: i, j, k + real :: crystal_tmp, ni_dust_tmp + !------------------------------------------------------------------------- ! do the following calculations if droplet number is being predicted: @@ -384,6 +396,9 @@ subroutine determine_activated_aerosol ( & ! downward, the rotstayn-klein microphysics is active, and pdf_clouds ! are not activated; in such a case, no particles are activated. !------------------------------------------------------------------------- + if (mpp_pe() == mpp_root_pe()) & + print*, ' total_activation = ', total_activation + call mpp_clock_begin (aero_loop2) if (var_limit_opt == 1) then ! cjg do k = 1,kdim @@ -393,6 +408,7 @@ subroutine determine_activated_aerosol ( & (do_mg_microphys) .or. & (do_ncar_microphys) .or. & (do_mg_ncar_microphys) .or. & + ( do_ncar_MG2 ) .or. & ! cjg: total activation for RK (total_activation) .or. & (up_strat(i,j,k) >= 0.0) ) then @@ -446,6 +462,34 @@ subroutine determine_activated_aerosol ( & !------------------------------------------------------------------------- call mpp_clock_begin (aero_loop3) if (do_ice_num) then + +!---> h1g, 2020-06-01 + if ( .not. do_ice_nucl_wpdf ) then + do k = 1,kdim + do j = 1,jdim + do i = 1,idim + wp2i(i,j,k) = 0.0 + if (use_Fan2019_ice_nucl) then +!------------------------------------------------------------------------- +! call ice_nucl_wpdf to obtain number of activated ice crystals. +!------------------------------------------------------------------------- + call ice_nucl_wpdf_Fan ( & + Input_mp%tin(i,j,k), & + Input_mp%pfull(i,j,k), & + up_strat(i,j,k), wp2i(i,j,k), & + Particles%concen_dust_sub(i,j,k), & + Particles%crystal1(i,j,k), & !Particles%crystal1(i,j,k): homogeneous nucleated ice + Ni_dust(i,j,k) ) + if ( do_sum_homo_het_Fan ) & + Particles%crystal1(i,j,k) = Particles%crystal1(i,j,k) + Ni_dust(i,j,k) + endif + enddo + enddo + enddo + endif +!<--- h1g, 2020-06-01 + + if (do_ice_nucl_wpdf) THEN do k = 1,kdim do j = 1,jdim @@ -465,64 +509,140 @@ subroutine determine_activated_aerosol ( & wp2i(i,j,k) = wp2(i,j,k) END IF + + if (use_Fan2019_ice_nucl) then +!------------------------------------------------------------------------- +! call ice_nucl_wpdf to obtain number of activated ice crystals. +!------------------------------------------------------------------------- + call ice_nucl_wpdf_Fan ( & + Input_mp%tin(i,j,k), & + Input_mp%pfull(i,j,k), & + up_strat(i,j,k), wp2i(i,j,k), & + Particles%concen_dust_sub(i,j,k), & + Particles%crystal1(i,j,k), &!Particles%crystal1(i,j,k): homogeneous nucleated ice + Ni_dust(i,j,k) ) + if ( do_sum_homo_het_Fan ) & + Particles%crystal1(i,j,k) = Particles%crystal1(i,j,k) + Ni_dust(i,j,k) + !------------------------------------------------------------------------ ! define the saturation specific humidities over liquid and ice. !------------------------------------------------------------------------ - eslt(i,j,k) = polysvp_l(Input_mp%tin(i,j,k)) - qs_d(i,j,k) = Input_mp%pfull(i,j,k) - d378*eslt(i,j,k) - qs_d(i,j,k) = max(qs_d(i,j,k),eslt(i,j,k)) - qvsl(i,j,k) = 0.622 *eslt(i,j,k)/qs_d(i,j,k) + eslt(i,j,k) = polysvp_l(Input_mp%tin(i,j,k)) + qs_d(i,j,k) = Input_mp%pfull(i,j,k) - d378*eslt(i,j,k) + qs_d(i,j,k) = max(qs_d(i,j,k),eslt(i,j,k)) + qvsl(i,j,k) = 0.622 *eslt(i,j,k)/qs_d(i,j,k) - esit(i,j,k) = polysvp_i(Input_mp%tin(i,j,k)) - qs_d(i,j,k) = Input_mp%pfull(i,j,k) - d378*esit(i,j,k) - qs_d(i,j,k) = max(qs_d(i,j,k),esit(i,j,k)) - qvsi(i,j,k) = 0.622 *esit(i,j,k)/qs_d(i,j,k) + esit(i,j,k) = polysvp_i(Input_mp%tin(i,j,k)) + qs_d(i,j,k) = Input_mp%pfull(i,j,k) - d378*esit(i,j,k) + qs_d(i,j,k) = max(qs_d(i,j,k),esit(i,j,k)) + qvsi(i,j,k) = 0.622 *esit(i,j,k)/qs_d(i,j,k) !------------------------------------------------------------------------ ! define the relative humidities wrt ice and liquid to be used in the ! calculation of ice nuclei activation. it may vary based on the nml ! variable rh_act_opt. !------------------------------------------------------------------------ - IF (rh_act_opt .EQ. 1) THEN - qvt(i,j,k) = Input_mp%qin(i,j,k) - cf(i,j,k) = 0. - ELSE - cf(i,j,k) = qa_upd(i,j,k) + & + IF (rh_act_opt .EQ. 1) THEN + qvt(i,j,k) = Input_mp%qin(i,j,k) + cf(i,j,k) = 0. + ELSE + cf(i,j,k) = qa_upd(i,j,k) + & C2ls_mp%convective_humidity_area(i,j,k) - IF (cf(i,j,k) .LT. cf_thresh_nucl) THEN - qvt(i,j,k) = (Input_mp%qin(i,j,k) - & + IF (cf(i,j,k) .LT. cf_thresh_nucl) THEN + qvt(i,j,k) = (Input_mp%qin(i,j,k) - & cf(i,j,k)*Atmos_State%qs(i,j,k))/ & (1. - cf(i,j,k)) + ELSE + qvt(i,j,k) = Input_mp%qin(i,j,k) + ENDIF + END IF + + if (qvt(i,j,k) .LE. 0.0) then + qvt(i,j,k) = MAX(Input_mp%qin(i,j,k), qmin) + endif + u_i(i,j,k) = qvt(i,j,k)/qvsi(i,j,k) + u_l(i,j,k) = qvt(i,j,k)/qvsl(i,j,k) + +!------------------------------------------------------------------------- +! call ice_nucl_wpdf to obtain number of activated ice crystals. +!------------------------------------------------------------------------- + call ice_nucl_wpdf ( & + Input_mp%tin(i,j,k), u_i(i,j,k), u_l(i,j,k),& + up_strat(i,j,k), wp2i(i,j,k), & + Input_mp%zfull(i,j,k), & + Particles%totalmass1(i,j,k,:), & + Particles%imass1(i,j,k,:), n_totmass, n_imass, & + crystal_tmp, & + Particles%drop1(i,j,k), Particles%hom(i,j,k), & + Atmos_state%rh_crit(i,j,k), & + Atmos_state%rh_crit_min(i,j,k), ni_sulf(i,j,k), & + ni_dust_tmp, ni_bc(i,j,k)) + + + if ( include_Ni_bc ) & + Particles%crystal1(i,j,k) = Particles%crystal1(i,j,k) + ni_bc(i,j,k) + if ( include_Ni_sulf ) & + Particles%crystal1(i,j,k) = Particles%crystal1(i,j,k) + ni_sulf(i,j,k) + + else +!------------------------------------------------------------------------ +! define the saturation specific humidities over liquid and ice. +!------------------------------------------------------------------------ + eslt(i,j,k) = polysvp_l(Input_mp%tin(i,j,k)) + qs_d(i,j,k) = Input_mp%pfull(i,j,k) - d378*eslt(i,j,k) + qs_d(i,j,k) = max(qs_d(i,j,k),eslt(i,j,k)) + qvsl(i,j,k) = 0.622 *eslt(i,j,k)/qs_d(i,j,k) + + esit(i,j,k) = polysvp_i(Input_mp%tin(i,j,k)) + qs_d(i,j,k) = Input_mp%pfull(i,j,k) - d378*esit(i,j,k) + qs_d(i,j,k) = max(qs_d(i,j,k),esit(i,j,k)) + qvsi(i,j,k) = 0.622 *esit(i,j,k)/qs_d(i,j,k) + +!------------------------------------------------------------------------ +! define the relative humidities wrt ice and liquid to be used in the +! calculation of ice nuclei activation. it may vary based on the nml +! variable rh_act_opt. +!------------------------------------------------------------------------ + IF (rh_act_opt .EQ. 1) THEN + qvt(i,j,k) = Input_mp%qin(i,j,k) + cf(i,j,k) = 0. ELSE - qvt(i,j,k) = Input_mp%qin(i,j,k) - ENDIF - END IF + cf(i,j,k) = qa_upd(i,j,k) + & + C2ls_mp%convective_humidity_area(i,j,k) + IF (cf(i,j,k) .LT. cf_thresh_nucl) THEN + qvt(i,j,k) = (Input_mp%qin(i,j,k) - & + cf(i,j,k)*Atmos_State%qs(i,j,k))/ & + (1. - cf(i,j,k)) + ELSE + qvt(i,j,k) = Input_mp%qin(i,j,k) + ENDIF + END IF - if (qvt(i,j,k) .LE. 0.0) then - qvt(i,j,k) = MAX(Input_mp%qin(i,j,k), qmin) - endif - u_i(i,j,k) = qvt(i,j,k)/qvsi(i,j,k) - u_l(i,j,k) = qvt(i,j,k)/qvsl(i,j,k) + if (qvt(i,j,k) .LE. 0.0) then + qvt(i,j,k) = MAX(Input_mp%qin(i,j,k), qmin) + endif + u_i(i,j,k) = qvt(i,j,k)/qvsi(i,j,k) + u_l(i,j,k) = qvt(i,j,k)/qvsl(i,j,k) !-------------------------------------------------------------------------- ! if debugging is active and the relative humidity exceeds 200%, output ! relevant variables. !-------------------------------------------------------------------------- - if (debug .and. Input_mp%tin(i,j,k) .lt. 260. .and. & + if (debug .and. Input_mp%tin(i,j,k) .lt. 260. .and. & u_i(i,j,k) .gt. 200. ) then - call aerosol_cloud_debug1 ( & - i, j, k, u_i(i,j,k), Atmos_state%qs(i,j,k), & - qvsi(i,j,k), qvt(i,j,k), Input_mp%qin(i,j,k), & - cf(i,j,k), & - C2ls_mp%convective_humidity_area(i,j,k), & - qa_upd(i,j,k), & - C2ls_mp%convective_humidity_ratio(i,j,k) ) - endif + call aerosol_cloud_debug1 ( & + i, j, k, u_i(i,j,k), Atmos_state%qs(i,j,k), & + qvsi(i,j,k), qvt(i,j,k), Input_mp%qin(i,j,k), & + cf(i,j,k), & + C2ls_mp%convective_humidity_area(i,j,k), & + qa_upd(i,j,k), & + C2ls_mp%convective_humidity_ratio(i,j,k) ) + endif !------------------------------------------------------------------------- ! call ice_nucl_wpdf to obtain number of activated ice crystals. !------------------------------------------------------------------------- - call ice_nucl_wpdf ( & + call ice_nucl_wpdf ( & Input_mp%tin(i,j,k), u_i(i,j,k), u_l(i,j,k),& up_strat(i,j,k), wp2i(i,j,k), & Input_mp%zfull(i,j,k), & @@ -533,14 +653,16 @@ subroutine determine_activated_aerosol ( & Atmos_state%rh_crit(i,j,k), & Atmos_state%rh_crit_min(i,j,k), ni_sulf(i,j,k), & ni_dust(i,j,k), ni_bc(i,j,k)) - else - ni_sulf(i,j,k) = 0. - ni_dust(i,j,k) = 0. - ni_bc (i,j,k) = 0. - cf(i,j,k) = missing_value - u_i(i,j,k) = missing_value - u_l(i,j,k) = missing_value - endif + endif !use_Fan2019_ice_nucl + + else + ni_sulf(i,j,k) = 0. + ni_dust(i,j,k) = 0. + ni_bc (i,j,k) = 0. + cf(i,j,k) = missing_value + u_i(i,j,k) = missing_value + u_l(i,j,k) = missing_value + endif ! Input_mp%tin(i,j,k) .LT. tfreeze - 5. !------------------------------------------------------------------------- ! define the critical relative humidity that was used for ice nuclei @@ -574,6 +696,7 @@ subroutine determine_activated_aerosol ( & end do end do end do + END IF ! do_ice_nucl_wpdf !------------------------------------------------------------------------- ! define various desired diagnostics. @@ -629,7 +752,6 @@ subroutine determine_activated_aerosol ( & if ( diag_id%rhlin > 0 ) diag_4d(:,:,:,diag_pt%rhlin) = u_l - END IF ! do_ice_nucl_wpdf END IF ! do_ice_num if(diag_id%potential_droplets > 0) & @@ -891,6 +1013,13 @@ subroutine aerosol_effects (idim,jdim,kdim,n_diag_4d, pthickness, & do i=1,idim imass1(i,j,k,11) = Aerosol%aerosol(i,j,k,na)/ & pthickness(i,j,k) +!--> h1g, 2020-06-01 + if ( do_dust_berg .and. include_all_dust_bins ) then + concen_dust_sub(i,j,k) = concen_dust_sub(i,j,k) + & + Aerosol%aerosol(i,j,k,na) + endif +!<-- h1g, 2020-06-01 + end do end do end do @@ -901,6 +1030,14 @@ subroutine aerosol_effects (idim,jdim,kdim,n_diag_4d, pthickness, & do i=1,idim imass1(i,j,k,12) = Aerosol%aerosol(i,j,k,na)/ & pthickness(i,j,k) + +!--> h1g, 2020-06-01 + if ( do_dust_berg .and. include_all_dust_bins ) then + concen_dust_sub(i,j,k) = concen_dust_sub(i,j,k) + & + Aerosol%aerosol(i,j,k,na) + endif +!<-- h1g, 2020-06-01 + end do end do end do @@ -1039,12 +1176,8 @@ subroutine aerosol_effects (idim,jdim,kdim,n_diag_4d, pthickness, & endif ! (do_liq_num) !---------------------------------------------------------------------- - - end subroutine aerosol_effects - !######################################################################### - END MODULE aerosol_cloud_mod diff --git a/atmos_param/lscloud_driver/lscloud_driver.F90 b/atmos_param/lscloud_driver/lscloud_driver.F90 index b348aed5..0b95adb3 100644 --- a/atmos_param/lscloud_driver/lscloud_driver.F90 +++ b/atmos_param/lscloud_driver/lscloud_driver.F90 @@ -212,7 +212,7 @@ module lscloud_driver_mod integer :: kord = 7 logical :: pdf_org = .true. logical :: use_cf_metadata = .false. - +logical :: do_liq_num_fill = .true. namelist / lscloud_driver_nml / do_legacy_strat_cloud, Dmin, cfact, & microphys_scheme, macrophys_scheme, & @@ -221,7 +221,8 @@ module lscloud_driver_mod super_ice_opt, do_ice_nucl_wpdf, & do_pdf_clouds, betaP, qthalfwidth, & nsublevels, kmap, kord, pdf_org, & - use_cf_metadata + use_cf_metadata, & + do_liq_num_fill ! h1g, 2020-03-19 @@ -255,8 +256,8 @@ module lscloud_driver_mod id_lsc_precip, id_lsc_freq, & id_lscale_rain3d, id_lscale_snow3d, id_lscale_precip3d -integer :: id_qvout, id_qaout, id_qlout, id_qiout -integer :: id_qnout, id_qniout +integer :: id_qvout, id_qaout, id_qlout, id_qiout, id_qrout, id_qsout, id_qgout +integer :: id_qnout, id_qniout, id_qnrout, id_qnsout integer :: id_f_snow_berg, id_f_snow_berg_cond, id_f_snow_berg_wtd integer, dimension(:), allocatable :: id_wet_deposition @@ -288,7 +289,7 @@ module lscloud_driver_mod real :: dtcloud, inv_dtcloud logical :: do_predicted_ice_number -integer :: nsphum, nql, nqi, nqa, nqn, nqni, nqr, nqs, nqg +integer :: nsphum, nql, nqi, nqa, nqn, nqni, nqr, nqs, nqg, nqnr, nqns integer :: nso2, nso4 integer :: num_prog_tracers logical :: debug @@ -368,7 +369,9 @@ subroutine lscloud_driver_init (id, jd, kd, axes, Time, & nqni = Physics_control%nqni nqr = Physics_control%nqr nqs = Physics_control%nqs - nqg = Physics_control%nqg + nqg = Physics_control%nqg + nqnr = Physics_control%nqnr + nqns = Physics_control%nqns num_prog_tracers = Physics_control%num_prog_tracers !------------------------------------------------------------------------- @@ -626,6 +629,7 @@ subroutine lscloud_driver_init (id, jd, kd, axes, Time, & Constants_lsc%do_mg_microphys = .false. Constants_lsc%do_mg_ncar_microphys = .false. Constants_lsc%do_ncar_microphys = .false. + Constants_lsc%do_ncar_MG2 = .false. do_predicted_ice_number = .false. Constants_lsc%do_lin_cld_microphys = .false. else if (trim(microphys_scheme) == 'morrison_gettelman') then @@ -633,6 +637,7 @@ subroutine lscloud_driver_init (id, jd, kd, axes, Time, & Constants_lsc%do_mg_microphys = .true. Constants_lsc%do_mg_ncar_microphys = .false. Constants_lsc%do_ncar_microphys = .false. + Constants_lsc%do_ncar_MG2 = .false. do_predicted_ice_number = .true. Constants_lsc%do_lin_cld_microphys = .false. else if (trim(microphys_scheme) == 'mg_ncar') then @@ -640,6 +645,7 @@ subroutine lscloud_driver_init (id, jd, kd, axes, Time, & Constants_lsc%do_mg_microphys = .false. Constants_lsc%do_mg_ncar_microphys = .true. Constants_lsc%do_ncar_microphys = .false. + Constants_lsc%do_ncar_MG2 = .false. do_predicted_ice_number = .true. Constants_lsc%do_lin_cld_microphys = .false. else if (trim(microphys_scheme) == 'ncar') then @@ -647,6 +653,15 @@ subroutine lscloud_driver_init (id, jd, kd, axes, Time, & Constants_lsc%do_mg_microphys = .false. Constants_lsc%do_mg_ncar_microphys = .false. Constants_lsc%do_ncar_microphys = .true. + Constants_lsc%do_ncar_MG2 = .false. + do_predicted_ice_number = .true. + Constants_lsc%do_lin_cld_microphys = .false. + else if (trim(microphys_scheme) == 'mg2') then + Constants_lsc%do_rk_microphys = .false. + Constants_lsc%do_mg_microphys = .false. + Constants_lsc%do_mg_ncar_microphys = .false. + Constants_lsc%do_ncar_microphys = .false. + Constants_lsc%do_ncar_MG2 = .true. do_predicted_ice_number = .true. Constants_lsc%do_lin_cld_microphys = .false. else if (trim(microphys_scheme) == 'lin') then @@ -654,6 +669,7 @@ subroutine lscloud_driver_init (id, jd, kd, axes, Time, & Constants_lsc%do_mg_microphys = .false. Constants_lsc%do_mg_ncar_microphys = .false. Constants_lsc%do_ncar_microphys = .false. + Constants_lsc%do_ncar_MG2 = .false. Constants_lsc%do_lin_cld_microphys = .true. ! this version of lin could not be active with prog drop number (and thus ! with predicted ice number) @@ -750,6 +766,7 @@ subroutine lscloud_driver_init (id, jd, kd, axes, Time, & Constants_lsc%do_mg_microphys = .false. Constants_lsc%do_mg_ncar_microphys = .false. Constants_lsc%do_ncar_microphys = .false. + Constants_lsc%do_ncar_MG2 = .false. do_predicted_ice_number = .false. Constants_lsc%do_lin_cld_microphys = .false. Constants_lsc%dqa_activation = .false. @@ -853,7 +870,7 @@ end subroutine lscloud_driver_time_vary !######################################################################### -subroutine lscloud_driver (is, ie, js, je, Time, dt, Input_mp, & +subroutine lscloud_driver (is, ie, js, je, Time, dt, lon, lat, Input_mp, & rdiag, Tend_mp, C2ls_mp, Output_mp, & Removal_mp, Cld_props, Aerosol) @@ -889,6 +906,8 @@ subroutine lscloud_driver (is, ie, js, je, Time, dt, Input_mp, & integer, intent(in) :: is,ie,js,je type(time_type), intent(in) :: Time real, intent(in) :: dt +real, intent(in), dimension(:,:) :: lon, lat + type(mp_input_type), intent(inout) :: Input_mp type(mp_tendency_type), intent(inout) :: Tend_mp type(mp_conv2ls_type), intent(inout) :: C2ls_mp @@ -1040,7 +1059,7 @@ subroutine lscloud_driver (is, ie, js, je, Time, dt, Input_mp, & ! fields. start clock to time this subroutine. !---------------------------------------------------------------------- call mpp_clock_begin (realiz_clock) - call impose_realizability ( & + call impose_realizability ( & Atmos_state, Cloud_state, Tend_mp%qtnd, Tend_mp%ttnd, & Lsdiag_mp%diag_4d, Lsdiag_mp_control%diag_id, & Lsdiag_mp_control%diag_pt) @@ -1144,7 +1163,7 @@ subroutine lscloud_driver (is, ie, js, je, Time, dt, Input_mp, & !--------------------------------------------------------------------- call mpp_clock_begin (ls_microphysics_clock) call ls_cloud_microphysics & - (is, ie, js, je, Time, dt, & + (is, ie, js, je, Time, dt, lon, lat, & Input_mp, Output_mp, C2ls_mp, Tend_mp, Lsdiag_mp, & Lsdiag_mp_control, & Atmos_state, Cloud_state, Particles, Precip_state, & @@ -1590,6 +1609,26 @@ subroutine diag_field_init (axes, Time) 'qlout', axes(1:3), Time, 'ql after strat_cloud', 'kg/kg', & missing_value=missing_value ) + id_qrout = register_diag_field ( mod_name, & + 'qrout', axes(1:3), Time, 'qr after strat_cloud', 'kg/kg', & + missing_value=missing_value ) + + id_qsout = register_diag_field ( mod_name, & + 'qsout', axes(1:3), Time, 'qs after strat_cloud', 'kg/kg', & + missing_value=missing_value ) + + id_qnrout = register_diag_field ( mod_name, & + 'qnrout', axes(1:3), Time, 'qnr after strat_cloud', '#/kg', & + missing_value=missing_value ) + + id_qnsout = register_diag_field ( mod_name, & + 'qnsout', axes(1:3), Time, 'qns after strat_cloud', '#/kg', & + missing_value=missing_value ) + + id_qgout = register_diag_field ( mod_name, & + 'qgout', axes(1:3), Time, 'qg after strat_cloud', 'kg/kg', & + missing_value=missing_value ) + id_qiout = register_diag_field ( mod_name, & 'qiout', axes(1:3), Time, 'qi after strat_cloud', 'kg/kg', & missing_value=missing_value ) @@ -1859,24 +1898,45 @@ subroutine lscloud_alloc ( & allocate (Cloud_state%qa_upd (idim, jdim, kdim) ) allocate (Cloud_state%qn_upd (idim, jdim, kdim) ) allocate (Cloud_state%qni_upd (idim, jdim, kdim) ) + allocate (Cloud_state%qr_upd (idim, jdim, kdim) ) + allocate (Cloud_state%qs_upd (idim, jdim, kdim) ) + allocate (Cloud_state%qnr_upd (idim, jdim, kdim) ) + allocate (Cloud_state%qns_upd (idim, jdim, kdim) ) + allocate (Cloud_state%ql_mean (idim, jdim, kdim) ) allocate (Cloud_state%qi_mean (idim, jdim, kdim) ) allocate (Cloud_state%qa_mean (idim, jdim, kdim) ) allocate (Cloud_state%qn_mean (idim, jdim, kdim) ) allocate (Cloud_state%qni_mean (idim, jdim, kdim) ) + allocate (Cloud_state%qr_mean (idim, jdim, kdim) ) + allocate (Cloud_state%qs_mean (idim, jdim, kdim) ) + allocate (Cloud_state%qnr_mean (idim, jdim, kdim) ) + allocate (Cloud_state%qns_mean (idim, jdim, kdim) ) + allocate (Cloud_state%ql_in (idim, jdim, kdim) ) + allocate (Cloud_state%qr_in (idim, jdim, kdim) ) allocate (Cloud_state%qi_in (idim, jdim, kdim) ) + allocate (Cloud_state%qs_in (idim, jdim, kdim) ) + allocate (Cloud_state%qg_in (idim, jdim, kdim) ) allocate (Cloud_state%qa_in (idim, jdim, kdim) ) allocate (Cloud_state%qn_in (idim, jdim, kdim) ) allocate (Cloud_state%qni_in (idim, jdim, kdim) ) + allocate (Cloud_state%qnr_in (idim, jdim, kdim) ) + allocate (Cloud_state%qns_in (idim, jdim, kdim) ) + allocate (Cloud_state%SL_out (idim, jdim, kdim) ) allocate (Cloud_state%SI_out (idim, jdim, kdim) ) allocate (Cloud_state%SA_out (idim, jdim, kdim) ) allocate (Cloud_state%SN_out (idim, jdim, kdim) ) allocate (Cloud_state%SNi_out (idim, jdim, kdim) ) + allocate (Cloud_state%SR_out (idim, jdim, kdim) ) + allocate (Cloud_state%SS_out (idim, jdim, kdim) ) + allocate (Cloud_state%SNR_out (idim, jdim, kdim) ) + allocate (Cloud_state%SNS_out (idim, jdim, kdim) ) + allocate (Cloud_state%qcvar_clubb (idim, jdim, kdim) ) allocate (Cloud_state%relvarn (idim, jdim, kdim) ) @@ -1888,23 +1948,48 @@ subroutine lscloud_alloc ( & Cloud_state%qa_upd = 0. Cloud_state%qn_upd = 0. Cloud_state%qni_upd = 0. + Cloud_state%qr_upd = 0. + Cloud_state%qs_upd = 0. + Cloud_state%qnr_upd = 0. + Cloud_state%qns_upd = 0. Cloud_state%ql_mean = 0. Cloud_state%qi_mean = 0. Cloud_state%qa_mean = 0. Cloud_state%qn_mean = 0. Cloud_state%qni_mean = 0. + Cloud_state%qr_mean = 0. + Cloud_state%qs_mean = 0. + Cloud_state%qnr_mean = 0. + Cloud_state%qns_mean = 0. + + if (nql == NO_TRACER) then Cloud_state%ql_in = 0. else Cloud_state%ql_in = Input_mp%tracer(:,:,:,nql) endif + if (nqr == NO_TRACER) then + Cloud_state%qr_in = 0. + else + Cloud_state%qr_in = Input_mp%tracer(:,:,:,nqr) + endif if (nqi == NO_TRACER) then Cloud_state%qi_in = 0. else Cloud_state%qi_in = Input_mp%tracer(:,:,:,nqi) endif + if (nqs == NO_TRACER) then + Cloud_state%qs_in = 0. + else + Cloud_state%qs_in = Input_mp%tracer(:,:,:,nqs) + endif + if (nqg == NO_TRACER) then + Cloud_state%qg_in = 0. + else + Cloud_state%qg_in = Input_mp%tracer(:,:,:,nqg) + endif if (nqa == NO_TRACER) then Cloud_state%qa_in = 0. else @@ -1915,21 +2000,34 @@ subroutine lscloud_alloc ( & else Cloud_state%qn_in = Input_mp%tracer(:,:,:,nqn) end if - if (nqni == NO_TRACER) then Cloud_state%qni_in = 0. else Cloud_state%qni_in = Input_mp%tracer(:,:,:,nqni) end if + if (nqnr == NO_TRACER) then + Cloud_state%qnr_in = 0. + else + Cloud_state%qnr_in = Input_mp%tracer(:,:,:,nqnr) + endif + if (nqns == NO_TRACER) then + Cloud_state%qns_in = 0. + else + Cloud_state%qns_in = Input_mp%tracer(:,:,:,nqns) + endif Cloud_state%SL_out = 0. Cloud_state%SI_out = 0. Cloud_state%SA_out = 0. Cloud_state%SN_out = 0. Cloud_state%SNi_out = 0. + Cloud_state%SR_out = 0. + Cloud_state%SS_out = 0. + Cloud_state%SNR_out = 0. + Cloud_state%SNS_out = 0. Cloud_state%qcvar_clubb = 0. - Cloud_state%relvarn = 0. + Cloud_state%relvarn = qcvar Cloud_state%qa_upd_0 = 0. Cloud_state%SA_0 = 0. @@ -1975,7 +2073,8 @@ subroutine impose_realizability ( & ! local variables: logical, dimension(size(ST_out,1), size(ST_out,2), & - size(ST_out,3)) :: ql_too_small, qi_too_small + size(ST_out,3)) :: ql_too_small, qi_too_small, qr_too_small, & + qs_too_small, qg_too_small integer :: idim,jdim,kdim integer :: i,j,k @@ -2054,6 +2153,14 @@ subroutine impose_realizability ( & qi_too_small = (Cloud_state%qi_in .le. qmin .or. & Cloud_state%qa_in .le. qmin) endif +! --> h1g, 2019-09-19 + if( Constants_lsc%do_ncar_MG2 ) then + qr_too_small = (Cloud_state%qr_in .le. qmin .or. & + Cloud_state%qnr_in .le. qmin) + qs_too_small = (Cloud_state%qs_in .le. qmin .or. & + Cloud_state%qns_in .le. qmin) + endif +! <-- h1g, 2019-09-19 else if (do_liq_num) then ql_too_small = (Cloud_state%ql_in .le. qmin .or. & @@ -2116,7 +2223,7 @@ subroutine impose_realizability ( & ! predicted. if droplet number is not being predicted, values were ! set at allocation. !------------------------------------------------------------------------ - if (do_liq_num) then + if (do_liq_num .and. do_liq_num_fill ) then call adjust_particle_number (ql_too_small, Cloud_state%SN_out, & cloud_state%qn_in, Cloud_state%qn_upd) @@ -2187,6 +2294,67 @@ subroutine impose_realizability ( & call mpp_clock_end (lscloud_debug_clock) endif + + if ( Constants_lsc%do_ncar_MG2 ) then +!------------------------------------------------------------------------ +! call subroutine adjust_condensate to conservatively fill qr if needed. +!------------------------------------------------------------------------ + call adjust_condensate (qr_too_small, Cloud_state%SR_out, & + SQ_out, ST_out, Cloud_state%qr_in, HLV, Cloud_state%qr_upd) +!------------------------------------------------------------------------ +! save diagnostics defining the rain filling amount. +!------------------------------------------------------------------------ + if ( diag_id%qrdt_fill + diag_id%qr_fill_col > 0 ) then + where (qr_too_small ) + diag_4d(:,:,:,diag_pt%qrdt_fill) = & + -1.*Cloud_state%qr_in*inv_dtcloud + endwhere + end if + if ( diag_id%qdt_liquid_init > 0 ) then + where (qr_too_small ) + diag_4d(:,:,:,diag_pt%qdt_liquid_init) = diag_4d(:,:,:,diag_pt%qdt_liquid_init)+ & + Cloud_state%qr_in*inv_dtcloud + endwhere + end if + + call adjust_particle_number (qr_too_small, Cloud_state%SNR_out, & + Cloud_state%qnr_in, Cloud_state%qnr_upd) + if ( diag_id%qnrdt_fill + diag_id%qnr_fill_col > 0 ) then + where (qr_too_small ) + diag_4d(:,:,:,diag_pt%qnrdt_fill) = & + -1.*Cloud_state%qnr_in*inv_dtcloud + endwhere + end if + + +!------------------------------------------------------------------------ +! call subroutine adjust_condensate to conservatively fill qs if needed. +!------------------------------------------------------------------------ + call adjust_condensate (qs_too_small, Cloud_state%SS_out, & + SQ_out, ST_out, CLoud_state%qs_in, HLS, Cloud_state%qs_upd) + + if ( diag_id%qsdt_fill + diag_id%qs_fill_col > 0 ) then + where (qs_too_small ) + diag_4d(:,:,:,diag_pt%qsdt_fill) = & + -1.*Cloud_state%qs_in*inv_dtcloud + endwhere + end if + if ( diag_id%qdt_ice_init > 0 ) then + where (qs_too_small ) + diag_4d(:,:,:,diag_pt%qdt_ice_init) = diag_4d(:,:,:,diag_pt%qdt_ice_init)+ & + Cloud_state%qs_in*inv_dtcloud + endwhere + end if + call adjust_particle_number (qs_too_small, Cloud_state%SNS_out, & + Cloud_state%qns_in, Cloud_state%qns_upd) + if ( diag_id%qnsdt_fill + diag_id%qns_fill_col > 0 ) then + where (qs_too_small ) + diag_4d(:,:,:,diag_pt%qnsdt_fill) = & + -1.*Cloud_state%qns_in*inv_dtcloud + endwhere + end if + + endif ! do_ncar_MG2 !----------------------------------------------------------------------- @@ -2505,6 +2673,7 @@ subroutine detailed_diagnostics ( & + diag_4d(:,:,:,diag_pt%qldt_accrs) & + diag_4d(:,:,:,diag_pt%qldt_bergs) & + diag_4d(:,:,:,diag_pt%qldt_HM_splinter) & + + diag_4d(:,:,:,diag_pt%qldt_tiny) & ! h1g, 2020-06-25 - diag_4d(:,:,:,diag_pt%qidt_melt2 ) & - diag_4d(:,:,:,diag_pt%qidt_accrs) & - diag_4d(:,:,:,diag_pt%qdt_cleanup_liquid) & @@ -2531,6 +2700,8 @@ subroutine detailed_diagnostics ( & + diag_4d(:,:,:,diag_pt%qidt_accr) & + diag_4d(:,:,:,diag_pt%qidt_accrs) & + diag_4d(:,:,:,diag_pt%ice_adj ) & + + diag_4d(:,:,:,diag_pt%qidt_tiny) & ! h1g, 2020-06-25 + + diag_4d(:,:,:,diag_pt%qidt_rain2ice) & ! h1g, 2020-06-26 - diag_4d(:,:,:,diag_pt%qdt_cleanup_ice) & ) endif @@ -2556,6 +2727,7 @@ subroutine detailed_diagnostics ( & + diag_4d(:,:,:,diag_pt%qndt_size_adj) & + diag_4d(:,:,:,diag_pt%qndt_fill2) & + diag_4d(:,:,:,diag_pt%qndt_contact_frz) & + + diag_4d(:,:,:,diag_pt%qndt_tiny) & ! h1g, 2020-06-25 + diag_4d(:,:,:,diag_pt%qndt_cleanup) & + diag_4d(:,:,:,diag_pt%qndt_cleanup2) & ) @@ -2569,6 +2741,8 @@ subroutine detailed_diagnostics ( & + diag_4d(:,:,:,diag_pt%qnidt_nerosi) & + diag_4d(:,:,:,diag_pt%qnidt_nprci) & + diag_4d(:,:,:,diag_pt%qnidt_nprai) & + + diag_4d(:,:,:,diag_pt%qnidt_auto) & ! h1g, 2020-06-29 + + diag_4d(:,:,:,diag_pt%qnidt_accr) & ! h1g, 2020-06-29 + diag_4d(:,:,:,diag_pt%qnidt_nucclim1) & + diag_4d(:,:,:,diag_pt%qnidt_nucclim2) & + diag_4d(:,:,:,diag_pt%qnidt_sedi ) & @@ -2578,6 +2752,9 @@ subroutine detailed_diagnostics ( & + diag_4d(:,:,:,diag_pt%qnidt_super ) & + diag_4d(:,:,:,diag_pt%qnidt_ihom ) & + diag_4d(:,:,:,diag_pt%qnidt_destr ) & + + diag_4d(:,:,:,diag_pt%qnidt_tiny) & ! h1g, 2020-06-25 + + diag_4d(:,:,:,diag_pt%qnidt_rain2ice) & ! h1g, 2020-06-29 + - diag_4d(:,:,:,diag_pt%qndt_contact_frz) & ! h1g, 2020-06-29 + diag_4d(:,:,:,diag_pt%qnidt_cleanup) & + diag_4d(:,:,:,diag_pt%qnidt_cleanup2) & + diag_4d(:,:,:,diag_pt%qnidt_nsacwi) & @@ -2989,6 +3166,23 @@ subroutine update_fields_and_tendencies ( & Tend_mp%q_tnd(:,:,:,nql) Input_mp%tracer(:,:,:,nqi) = Input_mp%tracer(:,:,:,nqi) + & Tend_mp%q_tnd(:,:,:,nqi) +!--> h1g, 2019-08-27 --- + if( nqr /= NO_TRACER) & + Input_mp%tracer(:,:,:,nqr) = Input_mp%tracer(:,:,:,nqr) + & + Tend_mp%q_tnd(:,:,:,nqr) + if( nqs /= NO_TRACER) & + Input_mp%tracer(:,:,:,nqs) = Input_mp%tracer(:,:,:,nqs) + & + Tend_mp%q_tnd(:,:,:,nqs) + if( nqg /= NO_TRACER) & + Input_mp%tracer(:,:,:,nqg) = Input_mp%tracer(:,:,:,nqg) + & + Tend_mp%q_tnd(:,:,:,nqg) + if( nqnr /= NO_TRACER) & + Input_mp%tracer(:,:,:,nqnr) = Input_mp%tracer(:,:,:,nqnr) + & + Tend_mp%q_tnd(:,:,:,nqnr) + if( nqns /= NO_TRACER) & + Input_mp%tracer(:,:,:,nqns) = Input_mp%tracer(:,:,:,nqns) + & + Tend_mp%q_tnd(:,:,:,nqns) +!<-- h1g, 2019-08-27 ---- Input_mp%tracer(:,:,:,nqa) = Input_mp%tracer(:,:,:,nqa) + & Tend_mp%q_tnd(:,:,:,nqa) if (do_liq_num) & @@ -3012,6 +3206,24 @@ subroutine update_fields_and_tendencies ( & Time, is, js, 1) used = send_data (id_qlout, Input_mp%tracer(:,:,:,nql), & Time, is, js, 1) + if ( nqr /= NO_TRACER ) & + used = send_data (id_qrout, Input_mp%tracer(:,:,:,nqr), & + Time, is, js, 1) + if ( nqs /= NO_TRACER ) & + used = send_data (id_qsout, Input_mp%tracer(:,:,:,nqs), & + Time, is, js, 1) + if ( nqg /= NO_TRACER ) & + used = send_data (id_qgout, Input_mp%tracer(:,:,:,nqg), & + Time, is, js, 1) +!--> h1g, 2019-08-27 --- + if ( nqnr /= NO_TRACER ) & + used = send_data (id_qnrout, Input_mp%tracer(:,:,:,nqnr), & + Time, is, js, 1) + if ( nqns /= NO_TRACER ) & + used = send_data (id_qnsout, Input_mp%tracer(:,:,:,nqns), & + Time, is, js, 1) +!<-- h1g, 2019-08-27 ---- + used = send_data (id_qiout, Input_mp%tracer(:,:,:,nqi), & Time, is, js, 1) @@ -3034,6 +3246,19 @@ subroutine update_fields_and_tendencies ( & if (doing_prog_clouds) then Tend_mp%q_tnd(:,:,:,nql) = Tend_mp%q_tnd(:,:,:,nql)*dtinv Tend_mp%q_tnd(:,:,:,nqi) = Tend_mp%q_tnd(:,:,:,nqi)*dtinv + +!<-- h1g, 2019-08-27 ---- + if ( nqr /= NO_TRACER ) & + Tend_mp%q_tnd(:,:,:,nqr) = Tend_mp%q_tnd(:,:,:,nqr)*dtinv + if ( nqs /= NO_TRACER ) & + Tend_mp%q_tnd(:,:,:,nqs) = Tend_mp%q_tnd(:,:,:,nqs)*dtinv + if ( nqg /= NO_TRACER ) & + Tend_mp%q_tnd(:,:,:,nqg) = Tend_mp%q_tnd(:,:,:,nqg)*dtinv + if ( nqnr /= NO_TRACER ) & + Tend_mp%q_tnd(:,:,:,nqnr)= Tend_mp%q_tnd(:,:,:,nqnr)*dtinv + if ( nqns /= NO_TRACER ) & + Tend_mp%q_tnd(:,:,:,nqns)= Tend_mp%q_tnd(:,:,:,nqns)*dtinv +!<-- h1g, 2019-08-27 ---- Tend_mp%q_tnd(:,:,:,nqa) = Tend_mp%q_tnd(:,:,:,nqa)*dtinv if (do_liq_num) Tend_mp%q_tnd(:,:,:,nqn) = & Tend_mp%q_tnd(:,:,:,nqn)*dtinv @@ -3054,6 +3279,28 @@ subroutine update_fields_and_tendencies ( & Tend_mp%q_tnd(:,:,:,nql) Output_mp%rdt(:,:,:,nqi) = Output_mp%rdt(:,:,:,nqi) + & Tend_mp%q_tnd(:,:,:,nqi) + +!<-- h1g, 2019-08-27 ---- + if ( nqr /= NO_TRACER ) & + Output_mp%rdt(:,:,:,nqr) = Output_mp%rdt(:,:,:,nqr) + & + Tend_mp%q_tnd(:,:,:,nqr) + if ( nqs /= NO_TRACER ) & + Output_mp%rdt(:,:,:,nqs) = Output_mp%rdt(:,:,:,nqs) + & + Tend_mp%q_tnd(:,:,:,nqs) + if ( nqg /= NO_TRACER ) & + Output_mp%rdt(:,:,:,nqg) = Output_mp%rdt(:,:,:,nqg) + & + Tend_mp%q_tnd(:,:,:,nqg) +! if (mpp_pe() == mpp_root_pe() ) & +! write(*,*) 'before Output_mp nqr,nqs,nqg: ', nqr,nqs,nqg,NO_TRACER + + if ( nqnr /= NO_TRACER ) & + Output_mp%rdt(:,:,:,nqnr) = Output_mp%rdt(:,:,:,nqnr) + & + Tend_mp%q_tnd(:,:,:,nqnr) + if ( nqns /= NO_TRACER ) & + Output_mp%rdt(:,:,:,nqns) = Output_mp%rdt(:,:,:,nqns) + & + Tend_mp%q_tnd(:,:,:,nqns) +!<-- h1g, 2019-08-27 ---- + Output_mp%rdt(:,:,:,nqa) = Output_mp%rdt(:,:,:,nqa) + & Tend_mp%q_tnd(:,:,:,nqa) if (do_liq_num) & @@ -3072,6 +3319,7 @@ subroutine update_fields_and_tendencies ( & !---------------------------------------------------------------------- if (doing_prog_clouds) then Cld_props%cloud_area = Input_mp%tracer(:,:,:,nqa) + Cld_props%liquid_amt = Input_mp%tracer(:,:,:,nql) Cld_props%ice_amt = Input_mp%tracer(:,:,:,nqi) if (do_liq_num) & @@ -3098,8 +3346,6 @@ subroutine update_fields_and_tendencies ( & !---------------------------------------------------------------------- - - end subroutine update_fields_and_tendencies @@ -3135,6 +3381,12 @@ subroutine compute_ls_wetdep ( & integer :: kx logical :: used +!--> h1g, 2019-11-22 + integer :: i,j,k, ix, jx + ix= size(Input_mp%t,1) + jx= size(Input_mp%t,2) +!<-- h1g, 2019-11-22 + kx = size(Input_mp%t,3) !--------------------------------------------------------------------- @@ -3143,13 +3395,22 @@ subroutine compute_ls_wetdep ( & !--------------------------------------------------------------------- Tend_mp%qtnd_wet = Tend_mp%qtnd if (doing_prog_clouds) then - Tend_mp%qtnd_wet = Tend_mp%qtnd_wet + Tend_mp%q_tnd(:,:,:,nql) + & - Tend_mp%q_tnd(:,:,:,nqi) +!bqx + if (Constants_lsc%do_lin_cld_microphys) then + Tend_mp%qtnd_wet = Tend_mp%qtnd_wet + Tend_mp%q_tnd(:,:,:,nql) + & + Tend_mp%q_tnd(:,:,:,nqr) + & + Tend_mp%q_tnd(:,:,:,nqi) + & + Tend_mp%q_tnd(:,:,:,nqs) + & + Tend_mp%q_tnd(:,:,:,nqg) + else + Tend_mp%qtnd_wet = Tend_mp%qtnd_wet + Tend_mp%q_tnd(:,:,:,nql) + & + Tend_mp%q_tnd(:,:,:,nqi) + endif !----------------------------------------------------------------------- ! sum up the precipitation formed over timestep. !----------------------------------------------------------------------- - if (Constants_lsc%do_lin_cld_microphys) then + if (Constants_lsc%do_lin_cld_microphys .or. Constants_lsc%do_ncar_MG2 ) then C2ls_mp%cloud_wet = Input_mp%tracer(:,:,:,nqr) + & Input_mp%tracer(:,:,:,nqs) + & Input_mp%tracer(:,:,:,nqg) @@ -3205,9 +3466,14 @@ subroutine compute_ls_wetdep ( & n /= nqi .and. & n /= nqa .and. & n /= nqn .and. & - n /= nqni & + n /= nqni .and. & + n /= nqr .and. & + n /= nqs .and. & + n /= nqg & ) then Tend_mp%wetdeptnd(:,:,:) = 0.0 + + call wet_deposition ( & n, Input_mp%t, Input_mp%pfull, Input_mp%phalf, & Input_mp%zfull, Input_mp%zhalf, Precip_state%surfrain, & @@ -3224,7 +3490,6 @@ subroutine compute_ls_wetdep ( & !----------------------------------------------------------------------- Output_mp%rdt (:,:,:,n) = Output_mp%rdt(:,:,:,n) - & Tend_mp%wetdeptnd(:,:,:) - !----------------------------------------------------------------------- ! add the large-scale wet deposition tendency for the tracer to the ! previously-obtained convective wet deposition tendency @@ -3504,21 +3769,42 @@ subroutine lscloud_dealloc (Atmos_state, Particles, Cloud_State, & deallocate (Cloud_state%qa_upd ) deallocate (Cloud_state%qn_upd ) deallocate (Cloud_state%qni_upd ) + deallocate (Cloud_state%qr_upd ) + deallocate (Cloud_state%qs_upd ) + deallocate (Cloud_state%qnr_upd ) + deallocate (Cloud_state%qns_upd ) + deallocate (Cloud_state%ql_mean ) deallocate (Cloud_state%qi_mean ) deallocate (Cloud_state%qa_mean ) deallocate (Cloud_state%qn_mean ) deallocate (Cloud_state%qni_mean) + deallocate (Cloud_state%qr_mean ) + deallocate (Cloud_state%qs_mean ) + deallocate (Cloud_state%qnr_mean) + deallocate (Cloud_state%qns_mean) + deallocate (Cloud_state%ql_in ) + deallocate (Cloud_state%qr_in ) deallocate (Cloud_state%qi_in ) + deallocate (Cloud_state%qs_in ) + deallocate (Cloud_state%qg_in ) deallocate (Cloud_state%qa_in ) deallocate (Cloud_state%qn_in ) deallocate (Cloud_state%qni_in ) + deallocate (Cloud_state%qnr_in ) + deallocate (Cloud_state%qns_in ) + deallocate (Cloud_state%SL_out ) deallocate (Cloud_state%SI_out ) deallocate (Cloud_state%SA_out ) deallocate (Cloud_state%SN_out ) deallocate (Cloud_state%SNi_out ) + deallocate (Cloud_state%SR_out ) + deallocate (Cloud_state%SS_out ) + deallocate (Cloud_state%SNR_out ) + deallocate (Cloud_state%SNS_out ) + deallocate (Cloud_state%qcvar_clubb ) deallocate (Cloud_state%relvarn ) deallocate (Cloud_state%qa_upd_0) diff --git a/atmos_param/lscloud_driver/lscloud_netcdf.F90 b/atmos_param/lscloud_driver/lscloud_netcdf.F90 index a208ff2c..98291ffe 100644 --- a/atmos_param/lscloud_driver/lscloud_netcdf.F90 +++ b/atmos_param/lscloud_driver/lscloud_netcdf.F90 @@ -229,7 +229,7 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & Time, is, js, 1) used = send_data & (diag_id%a_snow_clr, diag_4d_kp1(:,:,:,diag_pt%a_snow_clr),& - Time, is, js, 1) + Time, is, js, 1) used = send_data & (diag_id%snow_cld, diag_4d_kp1(:,:,:,diag_pt%snow_cld), & Time, is, js, 1) @@ -278,6 +278,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qldt_fill, diag_4d(:,:,:,diag_pt%qldt_fill), & Time, is, js, 1) + used = send_data & + (diag_id%qldt_tiny, diag_4d(:,:,:,diag_pt%qldt_tiny), & + Time, is, js, 1) used = send_data & (diag_id%qldt_berg, diag_4d(:,:,:,diag_pt%qldt_berg), & Time, is, js, 1) @@ -315,6 +318,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qndt_fill, diag_4d(:,:,:,diag_pt%qndt_fill), & Time, is, js, 1) + used = send_data & + (diag_id%qndt_tiny, diag_4d(:,:,:,diag_pt%qndt_tiny), & + Time, is, js, 1) used = send_data & (diag_id%qndt_destr, diag_4d(:,:,:,diag_pt%qndt_destr), & Time, is, js, 1) @@ -370,6 +376,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qnidt_fill, diag_4d(:,:,:,diag_pt%qnidt_fill), & Time, is, js, 1) + used = send_data & + (diag_id%qnidt_tiny, diag_4d(:,:,:,diag_pt%qnidt_tiny), & + Time, is, js, 1) used = send_data & (diag_id%qnidt_nnuccd, diag_4d(:,:,:,diag_pt%qnidt_nnuccd), & Time, is, js, 1) @@ -379,6 +388,12 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qnidt_nerosi, diag_4d(:,:,:,diag_pt%qnidt_nerosi), & Time, is, js, 1) + used = send_data & + (diag_id%qnidt_auto, diag_4d(:,:,:,diag_pt%qnidt_auto), & + Time, is, js, 1) + used = send_data & + (diag_id%qnidt_accr, diag_4d(:,:,:,diag_pt%qnidt_accr), & + Time, is, js, 1) used = send_data & (diag_id%qnidt_nprci, diag_4d(:,:,:,diag_pt%qnidt_nprci), & Time, is, js, 1) @@ -412,6 +427,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qnidt_ihom, diag_4d(:,:,:,diag_pt%qnidt_ihom), & Time, is, js, 1) + used = send_data & + (diag_id%qnidt_rain2ice, diag_4d(:,:,:,diag_pt%qnidt_rain2ice), & + Time, is, js, 1) used = send_data & (diag_id%qnidt_destr, diag_4d(:,:,:,diag_pt%qnidt_destr), & Time, is, js, 1) @@ -525,6 +543,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qidt_fill, diag_4d(:,:,:,diag_pt%qidt_fill), & Time, is, js, 1) + used = send_data & + (diag_id%qidt_tiny, diag_4d(:,:,:,diag_pt%qidt_tiny), & + Time, is, js, 1) used = send_data & (diag_id%qidt_auto, diag_4d(:,:,:,diag_pt%qidt_auto), & Time, is, js, 1) @@ -534,6 +555,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qidt_accrs, diag_4d(:,:,:,diag_pt%qidt_accrs), & Time, is, js, 1) + used = send_data & + (diag_id%qidt_rain2ice, diag_4d(:,:,:,diag_pt%qidt_rain2ice), & + Time, is, js, 1) !----------------------------------------------------------------------- ! 15) variables associated with cloud area tendency: @@ -668,6 +692,53 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & diag_4d(:,:,:,diag_pt%qldt_HM_splinter), & Time, is, js, 1) +!------------------------------------------------------------------------ +! variables with MG2 +!------------------------------------------------------------------------ + used = send_data ( diag_id%SR3d, diag_4d(:,:,:,diag_pt%SR3d), & + Time, is, js, 1) + used = send_data ( diag_id%SNR3d, diag_4d(:,:,:,diag_pt%SNR3d), & + Time, is, js, 1) + used = send_data ( diag_id%SS3d, diag_4d(:,:,:,diag_pt%SS3d), & + Time, is, js, 1) + used = send_data ( diag_id%SNS3d, diag_4d(:,:,:,diag_pt%SNS3d), & + Time, is, js, 1) + + + used = send_data ( diag_id%rain_inst, diag_4d(:,:,:,diag_pt%rain_inst), & + Time, is, js, 1) + used = send_data ( diag_id%rain_sedi, diag_4d(:,:,:,diag_pt%rain_sedi), & + Time, is, js, 1) + used = send_data ( diag_id%rain_num_inst, diag_4d(:,:,:,diag_pt%rain_num_inst), & + Time, is, js, 1) + used = send_data ( diag_id%rain_num_sedi, diag_4d(:,:,:,diag_pt%rain_num_sedi), & + Time, is, js, 1) + used = send_data ( diag_id%rain_num_adj, diag_4d(:,:,:,diag_pt%rain_num_adj), & + Time, is, js, 1) + used = send_data ( diag_id%rain_num2snow, diag_4d(:,:,:,diag_pt%rain_num2snow), & + Time, is, js, 1) + used = send_data ( diag_id%rain_num_evap, diag_4d(:,:,:,diag_pt%rain_num_evap), & + Time, is, js, 1) + used = send_data ( diag_id%rain_num_freez, diag_4d(:,:,:,diag_pt%rain_num_freez), & + Time, is, js, 1) + used = send_data ( diag_id%rain_num_selfcoll, diag_4d(:,:,:,diag_pt%rain_num_selfcoll), & + Time, is, js, 1) + + + used = send_data ( diag_id%snow_inst, diag_4d(:,:,:,diag_pt%snow_inst), & + Time, is, js, 1) + used = send_data ( diag_id%snow_sedi, diag_4d(:,:,:,diag_pt%snow_sedi), & + Time, is, js, 1) + used = send_data ( diag_id%snow_num_inst, diag_4d(:,:,:,diag_pt%snow_num_inst), & + Time, is, js, 1) + used = send_data ( diag_id%snow_num_sedi, diag_4d(:,:,:,diag_pt%snow_num_sedi), & + Time, is, js, 1) + used = send_data ( diag_id%snow_num_melt, diag_4d(:,:,:,diag_pt%snow_num_melt), & + Time, is, js, 1) + used = send_data ( diag_id%snow_num_adj, diag_4d(:,:,:,diag_pt%snow_num_adj), & + Time, is, js, 1) + + !----------------------------------------------------------------------- ! 17) variables associated with budget verification: !----------------------------------------------------------------------- @@ -685,24 +756,50 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & Time, is, js, 1) used = send_data ( diag_id%SNi_imb, diag_4d(:,:,:,diag_pt%SNi_imb), & Time, is, js, 1) + used = send_data ( diag_id%rain_imb, diag_4d(:,:,:,diag_pt%rain_imb),& + Time, is, js, 1) used = send_data ( diag_id%cld_liq_imb, & diag_4d(:,:,:,diag_pt%cld_liq_imb), & Time, is, js, 1) + used = send_data ( diag_id%snow_imb, & + diag_4d(:,:,:,diag_pt%snow_imb), & + Time, is, js, 1) used = send_data ( diag_id%cld_ice_imb, & diag_4d(:,:,:,diag_pt%cld_ice_imb), & Time, is, js, 1) !----------------------------------------------------------------------- -! 18) variables associated CMIP diagnostics +! 18) variables associated prognostic precipitation !----------------------------------------------------------------------- - if (query_cmip_diag_id(diag_id%cdnc)) then - used = send_cmip_data_3d ( diag_id%cdnc, & - 1.e06*diag_4d(:,:,:,diag_pt%droplets), & - Time, is, js, 1, mask=diag_4d(:,:,:,diag_pt%droplets) > 0.0) - endif + used = send_data & + (diag_id%qrdt_fill, diag_4d(:,:,:,diag_pt%qrdt_fill), & + Time, is, js, 1) + used = send_data & + (diag_id%qnrdt_fill, diag_4d(:,:,:,diag_pt%qnrdt_fill), & + Time, is, js, 1) + used = send_data & + (diag_id%qrdt_tiny, diag_4d(:,:,:,diag_pt%qrdt_tiny), & + Time, is, js, 1) + used = send_data & + (diag_id%qnrdt_tiny, diag_4d(:,:,:,diag_pt%qnrdt_tiny), & + Time, is, js, 1) + + used = send_data & + (diag_id%qsdt_fill, diag_4d(:,:,:,diag_pt%qsdt_fill), & + Time, is, js, 1) + used = send_data & + (diag_id%qnsdt_fill, diag_4d(:,:,:,diag_pt%qnsdt_fill), & + Time, is, js, 1) + used = send_data & + (diag_id%qsdt_tiny, diag_4d(:,:,:,diag_pt%qsdt_tiny), & + Time, is, js, 1) + used = send_data & + (diag_id%qnsdt_tiny, diag_4d(:,:,:,diag_pt%qnsdt_tiny), & + Time, is, js, 1) + !----------------------------------------------------------------------- -! 18) variables associated CMIP diagnostics +! 19) variables associated CMIP diagnostics !----------------------------------------------------------------------- if (query_cmip_diag_id(diag_id%cdnc)) then used = send_cmip_data_3d ( diag_id%cdnc, & @@ -806,6 +903,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%ql_fill_col, diag_3d(:,:, diag_pt%qldt_fill), & Time, is, js) + used = send_data & + (diag_id%ql_tiny_col, diag_3d(:,:, diag_pt%qldt_tiny), & + Time, is, js) used = send_data & (diag_id%liq_adj_col, diag_3d(:,:, diag_pt%liq_adj), & Time, is, js) @@ -834,6 +934,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qn_fill_col, diag_3d(:,:, diag_pt%qndt_fill), & Time, is, js) + used = send_data & + (diag_id%qn_tiny_col, diag_3d(:,:, diag_pt%qndt_tiny), & + Time, is, js) used = send_data & (diag_id%qn_berg_col, diag_3d(:,:, diag_pt%qndt_berg), & Time, is, js) @@ -912,6 +1015,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qi_fill_col, diag_3d(:,:, diag_pt%qidt_fill), & Time, is, js) + used = send_data & + (diag_id%qi_tiny_col, diag_3d(:,:, diag_pt%qidt_tiny), & + Time, is, js) used = send_data & (diag_id%qi_dep_col, diag_3d(:,:, diag_pt%qidt_dep), & Time, is, js) @@ -945,6 +1051,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qi_accrs_col, diag_3d(:,:, diag_pt%qidt_accrs), & Time, is, js) + used = send_data & + (diag_id%qi_rain2ice_col, diag_3d(:,:, diag_pt%qidt_rain2ice), & + Time, is, js) !----------------------------------------------------------------------- ! 15) variables associated with cloud area time tendency: @@ -1033,6 +1142,18 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data (diag_id%ql_HM_splinter_col, & diag_3d(:,:,diag_pt%qldt_HM_splinter), Time, is, js ) +!------------------------------------------------------------------------ +! variables with MG2 +!------------------------------------------------------------------------ + used = send_data ( diag_id%SR2d, diag_3d(:,:,diag_pt%SR3d), & + Time, is, js ) + used = send_data ( diag_id%SNR2d, diag_3d(:,:,diag_pt%SNR3d), & + Time, is, js ) + used = send_data ( diag_id%SS2d, diag_3d(:,:,diag_pt%SS3d), & + Time, is, js ) + used = send_data ( diag_id%SNS2d, diag_3d(:,:,diag_pt%SNS3d), & + Time, is, js ) + !----------------------------------------------------------------------- ! 17) variables associated with budget verification: !----------------------------------------------------------------------- @@ -1069,6 +1190,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qni_fill_col, diag_3d(:,:,diag_pt%qnidt_fill), & Time, is, js) + used = send_data & + (diag_id%qni_tiny_col, diag_3d(:,:,diag_pt%qnidt_tiny), & + Time, is, js) used = send_data & (diag_id%qni_nnuccd_col, diag_3d(:,:,diag_pt%qnidt_nnuccd), & Time, is, js) @@ -1078,6 +1202,12 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qni_nerosi_col, diag_3d(:,:,diag_pt%qnidt_nerosi), & Time, is, js) + used = send_data & + (diag_id%qni_auto_col, diag_3d(:,:,diag_pt%qnidt_auto), & + Time, is, js) + used = send_data & + (diag_id%qni_accr_col, diag_3d(:,:,diag_pt%qnidt_accr), & + Time, is, js) used = send_data & (diag_id%qni_nprci_col, diag_3d(:,:,diag_pt%qnidt_nprci), & Time, is, js) @@ -1111,6 +1241,9 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & used = send_data & (diag_id%qni_ihom_col, diag_3d(:,:,diag_pt%qnidt_ihom), & Time, is, js) + used = send_data & + (diag_id%qni_rain2ice_col, diag_3d(:,:,diag_pt%qnidt_rain2ice), & + Time, is, js) used = send_data & (diag_id%qni_destr_col, diag_3d(:,:,diag_pt%qnidt_destr), & Time, is, js) @@ -1127,6 +1260,69 @@ subroutine lscloud_netcdf (diag_id, diag_pt, diag_4d, diag_4d_kp1, & diag_3d(:,:,diag_pt%qnidt_cleanup2), & Time, is, js) + +!----------------------------------------------------------------------- +! 18) variables associated with prognostic precipitation: +!----------------------------------------------------------------------- + used = send_data & + (diag_id%qr_fill_col, diag_3d(:,:,diag_pt%qrdt_fill), & + Time, is, js ) + used = send_data & + (diag_id%qnr_fill_col, diag_3d(:,:,diag_pt%qnrdt_fill), & + Time, is, js ) + used = send_data & + (diag_id%qr_tiny_col, diag_3d(:,:,diag_pt%qrdt_tiny), & + Time, is, js ) + used = send_data & + (diag_id%qnr_tiny_col, diag_3d(:,:,diag_pt%qnrdt_tiny), & + Time, is, js ) + + used = send_data & + (diag_id%qs_fill_col, diag_3d(:,:,diag_pt%qsdt_fill), & + Time, is, js ) + used = send_data & + (diag_id%qns_fill_col, diag_3d(:,:,diag_pt%qnsdt_fill), & + Time, is, js ) + used = send_data & + (diag_id%qs_tiny_col, diag_3d(:,:,diag_pt%qsdt_tiny), & + Time, is, js ) + used = send_data & + (diag_id%qns_tiny_col, diag_3d(:,:,diag_pt%qnsdt_tiny), & + Time, is, js ) + + + used = send_data ( diag_id%rain_inst_col, diag_3d(:,:,diag_pt%rain_inst), & + Time, is, js ) + used = send_data ( diag_id%rain_sedi_col, diag_3d(:,:,diag_pt%rain_sedi), & + Time, is, js ) + used = send_data ( diag_id%rain_num_inst_col, diag_3d(:,:,diag_pt%rain_num_inst), & + Time, is, js ) + used = send_data ( diag_id%rain_num_sedi_col, diag_3d(:,:,diag_pt%rain_num_sedi), & + Time, is, js ) + used = send_data ( diag_id%rain_num_adj_col, diag_3d(:,:,diag_pt%rain_num_adj), & + Time, is, js ) + used = send_data ( diag_id%rain_num2snow_col, diag_3d(:,:,diag_pt%rain_num2snow), & + Time, is, js ) + used = send_data ( diag_id%rain_num_evap_col, diag_3d(:,:,diag_pt%rain_num_evap), & + Time, is, js ) + used = send_data ( diag_id%rain_num_freez_col, diag_3d(:,:,diag_pt%rain_num_freez), & + Time, is, js ) + used = send_data ( diag_id%rain_num_selfcoll_col, diag_3d(:,:,diag_pt%rain_num_selfcoll), & + Time, is, js ) + + + used = send_data ( diag_id%snow_inst_col, diag_3d(:,:,diag_pt%snow_inst), & + Time, is, js ) + used = send_data ( diag_id%snow_sedi_col, diag_3d(:,:,diag_pt%snow_sedi), & + Time, is, js ) + used = send_data ( diag_id%snow_num_inst_col, diag_3d(:,:,diag_pt%snow_num_inst), & + Time, is, js ) + used = send_data ( diag_id%snow_num_sedi_col, diag_3d(:,:,diag_pt%snow_num_sedi), & + Time, is, js ) + used = send_data ( diag_id%snow_num_melt_col, diag_3d(:,:,diag_pt%snow_num_melt), & + Time, is, js ) + used = send_data ( diag_id%snow_num_adj_col, diag_3d(:,:,diag_pt%snow_num_adj), & + Time, is, js ) !------------------------------------------------------------------------ @@ -1414,6 +1610,12 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'Liquid water specific humidity tendency -- & &pre-microphysics filler', & 'kg/kg/sec', missing_value=missing_value) + diag_id%qldt_tiny = register_diag_field (mod_name, & + 'qldt_tiny', axes(1:3), Time, & + 'Liquid water specific humidity tendency -- & + & in-microphysics substep (tiny or negative) liquid water filler', & + 'kg/kg/sec', missing_value=missing_value) + diag_id%qldt_berg = register_diag_field (mod_name, & 'qldt_berg', axes(1:3), Time, & 'Liq water specific humidity tendency from Bergeron process',& @@ -1477,6 +1679,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qndt_fill', axes(1:3), Time, & 'Cloud droplet number tendency from filler', '#/kg/sec', & missing_value=missing_value) + diag_id%qndt_tiny = register_diag_field (mod_name, & + 'qndt_tiny', axes(1:3), Time, & + 'Cloud droplet number tendency from microphysics sub-step filler', '#/kg/sec', & + missing_value=missing_value) diag_id%qndt_destr = register_diag_field (mod_name, & 'qndt_destr', axes(1:3), Time, & 'Cloud droplet number tendency from cloud destruction', & @@ -1559,7 +1765,11 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_id%qnidt_fill = register_diag_field (mod_name, & 'qnidt_fill', axes(1:3), Time, & 'Ice particle number tendency from filler', '#/kg/sec', & - missing_value=missing_value) + missing_value=missing_value) + diag_id%qnidt_tiny = register_diag_field (mod_name, & + 'qnidt_tiny', axes(1:3), Time, & + 'Ice particle number tendency from microphysics substep filler', '#/kg/sec', & + missing_value=missing_value) diag_id%qnidt_nnuccd = register_diag_field (mod_name, & 'qnidt_nnuccd', axes(1:3), Time, & 'Ice particle number tendency from nucleation', '#/kg/sec', & @@ -1572,6 +1782,14 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qnidt_nerosi', axes(1:3), Time, & 'Ice particle number tendency from erosion', '#/kg/sec', & missing_value=missing_value) + diag_id%qnidt_auto = register_diag_field (mod_name, & + 'qnidt_auto', axes(1:3), Time, & + 'Ice particle number tendency from autoconversion', & + '#/kg/sec', missing_value=missing_value) + diag_id%qnidt_accr = register_diag_field (mod_name, & + 'qnidt_accr', axes(1:3), Time, & + 'Ice particle number tendency from accretion by snow', & + '#/kg/sec', missing_value=missing_value) diag_id%qnidt_nprci = register_diag_field (mod_name, & 'qnidt_nprci', axes(1:3), Time, & 'Ice particle number tendency from autoconversion', & @@ -1611,7 +1829,11 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_id%qnidt_ihom = register_diag_field (mod_name, & 'qnidt_ihom', axes(1:3), Time, & 'Ice particle number tendency from homogeneous freezing', & - '#/kg/sec', missing_value=missing_value) + '#/kg/sec', missing_value=missing_value) + diag_id%qnidt_rain2ice = register_diag_field (mod_name, & + 'qnidt_rain2ice', axes(1:3), Time, & + 'Ice particle number tendency from converting rain to ice', & + '#/kg/sec', missing_value=missing_value) diag_id%qnidt_destr = register_diag_field (mod_name, & 'qnidt_destr', axes(1:3), Time, & 'Ice particle number tendency from cloud destruction', & @@ -1754,6 +1976,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qidt_fill', axes(1:3), Time, & 'Ice water specific humidity tendency -- pre-microphysics & & filler', 'kg/kg/sec', missing_value=missing_value) + diag_id%qidt_tiny = register_diag_field (mod_name, & + 'qidt_tiny', axes(1:3), Time, & + 'Ice water specific humidity tendency -- in microphysics substep & + & filler', 'kg/kg/sec', missing_value=missing_value) diag_id%qidt_auto = register_diag_field (mod_name, & 'qidt_auto', axes(1:3), Time, & 'Ice water specific humidity tendency from autoconversion & @@ -1766,6 +1992,11 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qidt_accrs', axes(1:3), Time, & 'Ice wat spec hum tend from selfcollection (1 class scheme)',& 'kg/kg/sec', missing_value=missing_value) + diag_id%qidt_rain2ice = register_diag_field (mod_name, & + 'qidt_rain2ice', axes(1:3), Time, & + 'Ice wat spec hum tend from freezing rain to form ice ',& + 'kg/kg/sec', missing_value=missing_value) + !----------------------------------------------------------------------- ! 15) variables associated with cloud area time tendency: @@ -1935,11 +2166,98 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'srfrain_freez', axes(1:3), Time, & 'rain water sink from freezing', & 'kg/kg/sec', missing_value=missing_value) + + diag_id%rain_inst= register_diag_field ( mod_name, & + 'rain_inst', axes(1:3), Time, & + 'rain water instantaneous freezing/melting ', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%rain_sedi= register_diag_field ( mod_name, & + 'rain_sedi', axes(1:3), Time, & + 'rain water sedimentation ', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%rain_num_inst= register_diag_field ( mod_name, & + 'rain_num_inst', axes(1:3), Time, & + 'rain number instantaneous freezing/melting ', & + '#/kg/sec', missing_value=missing_value) + + diag_id%rain_num_sedi= register_diag_field ( mod_name, & + 'rain_num_sedi', axes(1:3), Time, & + 'rain number sedimentation ', & + '#/kg/sec', missing_value=missing_value) + diag_id%rain_num_adj= register_diag_field ( mod_name, & + 'rain_num_adj', axes(1:3), Time, & + 'rain number change due to rain size adjustment ', & + '#/kg/sec', missing_value=missing_value) + diag_id%rain_num2snow= register_diag_field ( mod_name, & + 'rain_num2snow', axes(1:3), Time, & + 'rain number change due to rain freezing to snow ', & + '#/kg/sec', missing_value=missing_value) + diag_id%rain_num_evap= register_diag_field ( mod_name, & + 'rain_num_evap', axes(1:3), Time, & + 'rain number change due to rain evaporation ', & + '#/kg/sec', missing_value=missing_value) + diag_id%rain_num_freez= register_diag_field ( mod_name, & + 'rain_num_freez', axes(1:3), Time, & + 'rain number change due to rain homogeneous freezing ', & + '#/kg/sec', missing_value=missing_value) + diag_id%rain_num_selfcoll= register_diag_field ( mod_name, & + 'rain_num_selfcoll', axes(1:3), Time, & + 'rain number change due to rain self collection ', & + '#/kg/sec', missing_value=missing_value) + + + diag_id%snow_inst= register_diag_field ( mod_name, & + 'snow_inst', axes(1:3), Time, & + 'snow instantaneous freezing/melting ', & + 'kg/kg/sec', missing_value=missing_value) + diag_id%snow_sedi= register_diag_field ( mod_name, & + 'snow_sedi', axes(1:3), Time, & + 'snow sedimentation ', & + 'kg/kg/sec', missing_value=missing_value) + diag_id%snow_num_inst= register_diag_field ( mod_name, & + 'snow_num_inst', axes(1:3), Time, & + 'snow number instantaneous freezing/melting ', & + '#/kg/sec', missing_value=missing_value) + diag_id%snow_num_sedi= register_diag_field ( mod_name, & + 'snow_num_sedi', axes(1:3), Time, & + 'snow number sedimentation ', & + '#/kg/sec', missing_value=missing_value) + diag_id%snow_num_melt= register_diag_field ( mod_name, & + 'snow_num_melt', axes(1:3), Time, & + 'snow number melt ', & + '#/kg/sec', missing_value=missing_value) + diag_id%snow_num_adj= register_diag_field ( mod_name, & + 'snow_num_adj', axes(1:3), Time, & + 'snow number change due to snow size adjustment ', & + '#/kg/sec', missing_value=missing_value) + diag_id%SI3d = register_diag_field ( mod_name, & 'SI3d', axes(1:3), Time, & 'Total Ice water specific humidity tendency ', & 'kg/kg/sec', missing_value=missing_value) + diag_id%SR3d = register_diag_field ( mod_name, & + 'SR3d', axes(1:3), Time, & + 'Total Rain Water specific humidity tendency ', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%SNR3d = register_diag_field ( mod_name, & + 'SNR3d', axes(1:3), Time, & + 'Total Rain drop number specific humidity tendency ', & + '#/kg/sec', missing_value=missing_value) + + diag_id%SS3d = register_diag_field ( mod_name, & + 'SS3d', axes(1:3), Time, & + 'Total Snow Water specific humidity tendency ', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%SNS3d = register_diag_field ( mod_name, & + 'SNS3d', axes(1:3), Time, & + 'Total Snow particle number specific humidity tendency ', & + 'kg/kg/sec', missing_value=missing_value) + !------------------------------------------------------------------------ ! 17) variables associated with budget analysis !------------------------------------------------------------------------ @@ -1971,17 +2289,102 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'SNi_imb', axes(1:3), Time, & 'difference between qni tendency and sum of individ terms', & '#/kg/sec', missing_value=missing_value) + diag_id%rain_imb = register_diag_field ( mod_name, & + 'rain_imb', axes(1:3), Time, & + 'difference between rain rate at sfc and sum of & + &individ terms', 'kg/kg/sec', missing_value=missing_value) diag_id%cld_liq_imb = register_diag_field ( mod_name, & 'cld_liq_imb', axes(1:3), Time, & 'difference between ql fallout rate at sfc and sum of & &individ terms', 'kg/kg/sec', missing_value=missing_value) + diag_id%snow_imb = register_diag_field ( mod_name, & + 'snow_imb', axes(1:3), Time, & + 'difference between snow rate at sfc and sum of & + &individ terms', 'kg/kg/sec', missing_value=missing_value) diag_id%cld_ice_imb = register_diag_field ( mod_name, & 'cld_ice_imb', axes(1:3), Time, & 'difference between qi fallout rate at sfc and sum of & &individ terms', 'kg/kg/sec', missing_value=missing_value) !------------------------------------------------------------------------ - ! 18) variables associated CMIP diagnostics + ! 18) variables associated prognostic precipitation + !------------------------------------------------------------------------ + diag_id%qrdt_fill = register_diag_field (mod_name, & + 'qrdt_fill', axes(1:3), Time, & + 'Rain water specific humidity tendency -- & + &pre-microphysics filler', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%qnrdt_fill = register_diag_field (mod_name, & + 'qnrdt_fill', axes(1:3), Time, & + 'Rain drop number concentration tendency -- & + &pre-microphysics filler', & + '#/kg/sec', missing_value=missing_value) + + diag_id%qrdt_tiny = register_diag_field (mod_name, & + 'qrdt_tiny', axes(1:3), Time, & + 'Rain water specific humidity tendency -- & + &in-microphysics sub-step filler', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%qnrdt_tiny = register_diag_field (mod_name, & + 'qnrdt_tiny', axes(1:3), Time, & + 'Rain drop number concentration tendency -- & + &in-microphysics sub-step filler', & + '#/kg/sec', missing_value=missing_value) + + diag_id%qsdt_fill = register_diag_field (mod_name, & + 'qsdt_fill', axes(1:3), Time, & + 'Snow specific humidity tendency -- & + &pre-microphysics filler', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%qnsdt_fill = register_diag_field (mod_name, & + 'qnsdt_fill', axes(1:3), Time, & + 'Snow number concentration tendency -- & + &pre-microphysics filler', & + '#/kg/sec', missing_value=missing_value) + + diag_id%qsdt_tiny = register_diag_field (mod_name, & + 'qsdt_tiny', axes(1:3), Time, & + 'Snow specific humidity tendency -- & + &in-microphysics substep filler', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%qnsdt_tiny = register_diag_field (mod_name, & + 'qnsdt_tiny', axes(1:3), Time, & + 'Snow number concentration tendency -- & + &in-microphysics substep filler', & + '#/kg/sec', missing_value=missing_value) + + diag_id%qrdt_destr = register_diag_field (mod_name, & + 'qrdt_destr', axes(1:3), Time, & + 'Rain water specific humidity tendency -- & + &after microphysics destruction', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%qnrdt_destr = register_diag_field (mod_name, & + 'qnrdt_destr', axes(1:3), Time, & + 'Rain drop number concentration tendency -- & + &after microphysics destruction', & + '#/kg/sec', missing_value=missing_value) + + diag_id%qsdt_destr = register_diag_field (mod_name, & + 'qsdt_destr', axes(1:3), Time, & + 'Snow specific humidity tendency -- & + &after microphysics destruction', & + 'kg/kg/sec', missing_value=missing_value) + + diag_id%qnsdt_destr = register_diag_field (mod_name, & + 'qnsdt_destr', axes(1:3), Time, & + 'Snow number concentration tendency -- & + &after microphysics destruction', & + '#/kg/sec', missing_value=missing_value) + + + + !------------------------------------------------------------------------ + ! 19) variables associated CMIP diagnostics !------------------------------------------------------------------------ diag_id%cdnc = register_cmip_diag_field_3d ( mod_name, 'cdnc', Time, & 'Cloud Droplet Number Concentration', 'm-3', mask_variant=.true., & @@ -2092,6 +2495,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'ql_fill_col', axes(1:2), Time, & 'Column integrated pre-microphysics liquid filler', & 'kg/m2/sec', missing_value=missing_value) + diag_id%ql_tiny_col = register_diag_field (mod_name, & + 'ql_tiny_col', axes(1:2), Time, & + 'Column integrated in-microphysics substep (tiny or negative) liquid filler', & + 'kg/m2/sec', missing_value=missing_value) diag_id%liq_adj_col = register_diag_field (mod_name, & 'liq_adj_col', axes(1:2), Time, & 'Column integrated liquid water specific humidity & @@ -2139,6 +2546,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qn_fill_col', axes(1:2), Time, & 'Column integrated drop number filler', '#/m2/sec', & missing_value=missing_value) + diag_id%qn_tiny_col = register_diag_field (mod_name, & + 'qn_tiny_col', axes(1:2), Time, & + 'Column integrated drop number in-microphysics substep filler', '#/m2/sec', & + missing_value=missing_value) diag_id%qn_destr_col = register_diag_field (mod_name, & 'qn_destr_col', axes(1:2), Time, & 'Column integrated drop number destruction', '#/m2/sec', & @@ -2233,6 +2644,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qi_fill_col', axes(1:2), Time, & 'Column integrated pre-microphysics ice filler', 'kg/m2/sec',& missing_value=missing_value) + diag_id%qi_tiny_col = register_diag_field (mod_name, & + 'qi_tiny_col', axes(1:2), Time, & + 'Column integrated in microphysics substep ice filler', 'kg/m2/sec',& + missing_value=missing_value) diag_id%qi_dep_col = register_diag_field (mod_name, & 'qi_dep_col', axes(1:2), Time, & 'Column integrated large-scale deposition', 'kg/m2/sec', & @@ -2278,6 +2693,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qi_accrs_col', axes(1:2), Time, & 'Column integrated self collection (one class scheme)', & 'kg/m2/sec', missing_value=missing_value) + diag_id%qi_rain2ice_col = register_diag_field (mod_name, & + 'qi_rain2ice_col', axes(1:2), Time, & + 'Column integrated ice from freezing rain ', & + 'kg/m2/sec', missing_value=missing_value) !----------------------------------------------------------------------- ! 15) variables associated with cloud area time tendency: @@ -2353,6 +2772,24 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'SNI2d', axes(1:2), Time, & 'Column integrated total ice crystal number tendency', & '#/m2/sec', missing_value=missing_value) + + diag_id%SR2d = register_diag_field ( mod_name, & + 'SR2d', axes(1:2), Time, & + 'Column integrated total Rain Water specific humidity', & + 'kg/m2/sec', missing_value=missing_value) + diag_id%SNR2d = register_diag_field ( mod_name, & + 'SNR2d', axes(1:2), Time, & + 'Column integrated total Rain drop number specific humidity', & + '#/m2/sec', missing_value=missing_value) + diag_id%SS2d = register_diag_field ( mod_name, & + 'SS2d', axes(1:2), Time, & + 'Column integrated total snow specific humidity', & + 'kg/m2/sec', missing_value=missing_value) + diag_id%SNS2d = register_diag_field ( mod_name, & + 'SNS2d', axes(1:2), Time, & + 'Column integrated total snow particle number specific humidity', & + '#/m2/sec', missing_value=missing_value) + diag_id%srfrain_accrs_col= register_diag_field ( mod_name, & 'srfrain_accrs_col', axes(1:2), Time, & 'Column integrated rain water sink from collection by snow', & @@ -2534,7 +2971,11 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_id%qni_fill_col = register_diag_field (mod_name, & 'qni_fill_col', axes(1:2), Time, & 'Column integrated ice particle number tendency from filler',& - '#/m2/sec', missing_value=missing_value) + '#/m2/sec', missing_value=missing_value) + diag_id%qni_tiny_col = register_diag_field (mod_name, & + 'qni_tiny_col', axes(1:2), Time, & + 'Column integrated ice particle number tendency from microphysics substep filler',& + '#/m2/sec', missing_value=missing_value) diag_id%qni_nnuccd_col = register_diag_field (mod_name, & 'qni_nnuccd_col', axes(1:2), Time, & 'Column integrated ice particle number tendency from & @@ -2547,6 +2988,14 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qni_nerosi_col', axes(1:2), Time, & 'Column integrated ice particle number tendency from & &erosion', '#/m2/sec', missing_value=missing_value) + diag_id%qni_auto_col = register_diag_field (mod_name, & + 'qni_auto_col', axes(1:2), Time, & + 'Column integrated ice particle number tendency from & + &autoconversion', '#/m2/sec', missing_value=missing_value) + diag_id%qni_accr_col = register_diag_field (mod_name, & + 'qni_accr_col', axes(1:2), Time, & + 'Column integrated ice particle number tendency from & + &accretion by snow', '#/m2/sec', missing_value=missing_value) diag_id%qni_nprci_col = register_diag_field (mod_name, & 'qni_nprci_col', axes(1:2), Time, & 'Column integrated ice particle number tendency from & @@ -2588,7 +3037,11 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'qni_ihom_col', axes(1:2), Time, & 'Column integrated ice particle number tendency from & &homogeneous freezing', '#/m2/sec', & - missing_value=missing_value) + missing_value=missing_value) + diag_id%qni_rain2ice_col = register_diag_field (mod_name, & + 'qni_rain2ice_col', axes(1:2), Time, & + 'Column integrated ice particle number tendency from & + &converting rain to ice', '#/m2/sec', missing_value=missing_value) diag_id%qni_destr_col = register_diag_field (mod_name, & 'qni_destr_col', axes(1:2), Time, & 'Column integrated ice particle number tendency from cloud & @@ -2606,6 +3059,144 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & 'Column integrated ice particle number tendency from HM & &ice multiplication', '#/m2/sec', missing_value=missing_value) +!------------------------------------------------------------------------ +! 18) variables associated with prognostic precipitation: +!------------------------------------------------------------------------ + diag_id%rain_inst_col= register_diag_field ( mod_name, & + 'rain_inst_col', axes(1:2), Time, & + 'Column integrated rain water instantaneous freezing/melting ', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%rain_sedi_col= register_diag_field ( mod_name, & + 'rain_sedi_col', axes(1:2), Time, & + 'Column integrated rain water sedimentation ', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%rain_num_inst_col= register_diag_field ( mod_name, & + 'rain_num_inst_col', axes(1:2), Time, & + 'Column integrated rain number instantaneous freezing/melting ', & + '#/m2/sec', missing_value=missing_value) + + diag_id%rain_num_sedi_col= register_diag_field ( mod_name, & + 'rain_num_sedi_col', axes(1:2), Time, & + 'Column integrated rain number sedimentation ', & + '#/m2/sec', missing_value=missing_value) + + diag_id%rain_num_adj_col= register_diag_field ( mod_name, & + 'rain_num_adj_col', axes(1:2), Time, & + 'Column integrated rain number changes due to rain size adjustment ', & + '#/m2/sec', missing_value=missing_value) + + diag_id%rain_num2snow_col= register_diag_field ( mod_name, & + 'rain_num2snow_col', axes(1:2), Time, & + 'Column integrated rain number changes due to rain freezing to snow', & + '#/m2/sec', missing_value=missing_value) + diag_id%rain_num_evap_col= register_diag_field ( mod_name, & + 'rain_num_evap_col', axes(1:2), Time, & + 'Column integrated rain number changes due to rain evaporation', & + '#/m2/sec', missing_value=missing_value) + + diag_id%rain_num_freez_col= register_diag_field ( mod_name, & + 'rain_num_freez_col', axes(1:2), Time, & + 'Column integrated rain number changes due to rain homogeneous freezing', & + '#/m2/sec', missing_value=missing_value) + diag_id%rain_num_selfcoll_col= register_diag_field ( mod_name, & + 'rain_num_selfcoll_col', axes(1:2), Time, & + 'Column integrated rain number changes due to rain number self-collection', & + '#/m2/sec', missing_value=missing_value) + + + + diag_id%snow_inst_col= register_diag_field ( mod_name, & + 'snow_inst_col', axes(1:2), Time, & + 'Column integrated snow instantaneous freezing/melting ', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%snow_sedi_col= register_diag_field ( mod_name, & + 'snow_sedi_col', axes(1:2), Time, & + 'Column integrated snow sedimentation ', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%snow_num_inst_col= register_diag_field ( mod_name, & + 'snow_num_inst_col', axes(1:2), Time, & + 'Column integrated snow number instantaneous freezing/melting ', & + '#/m2/sec', missing_value=missing_value) + + diag_id%snow_num_sedi_col= register_diag_field ( mod_name, & + 'snow_num_sedi_col', axes(1:2), Time, & + 'Column integrated snow number sedimentation ', & + '#/m2/sec', missing_value=missing_value) + diag_id%snow_num_melt_col= register_diag_field ( mod_name, & + 'snow_num_melt_col', axes(1:2), Time, & + 'Column integrated snow number melting ', & + '#/m2/sec', missing_value=missing_value) + + diag_id%snow_num_adj_col= register_diag_field ( mod_name, & + 'snow_num_adj_col', axes(1:2), Time, & + 'Column integrated snow number changes due to snow size adjustment ', & + '#/m2/sec', missing_value=missing_value) + + diag_id%qr_fill_col = register_diag_field (mod_name, & + 'qr_fill_col', axes(1:2), Time, & + 'Column integrated pre-microphysics rain filler', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%qnr_fill_col = register_diag_field (mod_name, & + 'qnr_fill_col', axes(1:2), Time, & + 'Column integrated pre-microphysics rain drop number filler', & + '#/m2/sec', missing_value=missing_value) + + diag_id%qr_tiny_col = register_diag_field (mod_name, & + 'qr_tiny_col', axes(1:2), Time, & + 'Column integrated in-microphysics substep rain filler', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%qnr_tiny_col = register_diag_field (mod_name, & + 'qnr_tiny_col', axes(1:2), Time, & + 'Column integrated in-microphysics substep rain drop number filler', & + '#/m2/sec', missing_value=missing_value) + + diag_id%qs_fill_col = register_diag_field (mod_name, & + 'qs_fill_col', axes(1:2), Time, & + 'Column integrated pre-microphysics snow filler', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%qns_fill_col = register_diag_field (mod_name, & + 'qns_fill_col', axes(1:2), Time, & + 'Column integrated pre-microphysics snow particle number filler', & + '#/m2/sec', missing_value=missing_value) + + diag_id%qs_tiny_col = register_diag_field (mod_name, & + 'qs_tiny_col', axes(1:2), Time, & + 'Column integrated in-microphysics substep snow filler', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%qns_tiny_col = register_diag_field (mod_name, & + 'qns_tiny_col', axes(1:2), Time, & + 'Column integrated in-microphysics substep snow particle number filler', & + '#/m2/sec', missing_value=missing_value) + + diag_id%qr_destr_col = register_diag_field (mod_name, & + 'qr_destr_col', axes(1:2), Time, & + 'Column integrated after microphysics rain destruction', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%qnr_destr_col = register_diag_field (mod_name, & + 'qnr_destr_col', axes(1:2), Time, & + 'Column integrated after microphysics rain drop number destruction', & + '#/m2/sec', missing_value=missing_value) + + diag_id%qs_destr_col = register_diag_field (mod_name, & + 'qs_destr_col', axes(1:2), Time, & + 'Column integrated after microphysics snow destruction', & + 'kg/m2/sec', missing_value=missing_value) + + diag_id%qns_destr_col = register_diag_field (mod_name, & + 'qns_destr_col', axes(1:2), Time, & + 'Column integrated after microphysics snow particle number destruction', & + '#/m2/sec', missing_value=missing_value) + + !------------------------------------------------------------------------ ! determine the number of activated diagnostic variables on both ! full and half levels in the vertical. thesde values will be used @@ -2848,6 +3439,11 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_pt%qldt_fill = n_diag_4d n_diag_4d = n_diag_4d + 1 end if + if (diag_id%qldt_tiny + diag_id%ql_tiny_col > 0) then + diag_pt%qldt_tiny = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + if (diag_id%qldt_berg + diag_id%ql_berg_col > 0) then diag_pt%qldt_berg = n_diag_4d n_diag_4d = n_diag_4d + 1 @@ -2901,6 +3497,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_pt%qndt_fill = n_diag_4d n_diag_4d = n_diag_4d + 1 end if + if (diag_id%qndt_tiny + diag_id%qn_tiny_col > 0) then + diag_pt%qndt_tiny = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if if (diag_id%qndt_destr + diag_id%qn_destr_col > 0) then diag_pt%qndt_destr = n_diag_4d n_diag_4d = n_diag_4d + 1 @@ -2978,6 +3578,11 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_pt%qnidt_fill = n_diag_4d n_diag_4d = n_diag_4d + 1 end if + if (diag_id%qnidt_tiny + diag_id%qni_tiny_col > 0) then + diag_pt%qnidt_tiny = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + if (diag_id%qnidt_nnuccd + diag_id%qni_nnuccd_col > 0) then diag_pt%qnidt_nnuccd = n_diag_4d n_diag_4d = n_diag_4d + 1 @@ -2990,6 +3595,14 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_pt%qnidt_nerosi = n_diag_4d n_diag_4d = n_diag_4d + 1 end if + if (diag_id%qnidt_auto + diag_id%qni_auto_col > 0) then + diag_pt%qnidt_auto = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + if (diag_id%qnidt_accr + diag_id%qni_accr_col > 0) then + diag_pt%qnidt_accr = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if if (diag_id%qnidt_nprci + diag_id%qni_nprci_col > 0) then diag_pt%qnidt_nprci = n_diag_4d n_diag_4d = n_diag_4d + 1 @@ -3030,6 +3643,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_pt%qnidt_ihom = n_diag_4d n_diag_4d = n_diag_4d + 1 end if + if (diag_id%qnidt_rain2ice + diag_id%qni_rain2ice_col > 0) then + diag_pt%qnidt_rain2ice = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if if (diag_id%qnidt_destr + diag_id%qni_destr_col > 0) then diag_pt%qnidt_destr = n_diag_4d n_diag_4d = n_diag_4d + 1 @@ -3170,6 +3787,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_pt%qidt_fill = n_diag_4d n_diag_4d = n_diag_4d + 1 end if + if (diag_id%qidt_tiny + diag_id%qi_tiny_col > 0) then + diag_pt%qidt_tiny = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if if (diag_id%qidt_auto + diag_id%qi_auto_col > 0) then diag_pt%qidt_auto = n_diag_4d n_diag_4d = n_diag_4d + 1 @@ -3182,6 +3803,10 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_pt%qidt_accrs = n_diag_4d n_diag_4d = n_diag_4d + 1 end if + if (diag_id%qidt_rain2ice + diag_id%qi_rain2ice_col > 0) then + diag_pt%qidt_rain2ice = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if !----------------------------------------------------------------------- ! 15) variables associated with cloud area time tendency: @@ -3255,6 +3880,25 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & diag_pt%SNI3d = n_diag_4d n_diag_4d = n_diag_4d + 1 end if + + if (diag_id%SR3d + diag_id%SR2d > 0) then + diag_pt%SR3d = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + if (diag_id%SNR3d + diag_id%SNR2d > 0) then + diag_pt%SNR3d = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + if (diag_id%SS3d + diag_id%SS2d > 0) then + diag_pt%SS3d = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + if (diag_id%SNS3d + diag_id%SNS2d > 0) then + diag_pt%SNS3d = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qndt_contact_frz + diag_id%qn_contact_frz_col > 0) then diag_pt%qndt_contact_frz = n_diag_4d n_diag_4d = n_diag_4d + 1 @@ -3418,6 +4062,144 @@ subroutine diag_field_init (axes, Time, diag_id, diag_pt, n_diag_4d, & n_diag_4d = n_diag_4d + 1 end if +!------------------------------------------------------------------------ +! 18) variables associated with prognostic precipitation +!------------------------------------------------------------------------ + if (diag_id%qrdt_fill + diag_id%qr_fill_col > 0) then + diag_pt%qrdt_fill = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qnrdt_fill + diag_id%qnr_fill_col > 0) then + diag_pt%qnrdt_fill = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qrdt_tiny + diag_id%qr_tiny_col > 0) then + diag_pt%qrdt_tiny = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qnrdt_tiny + diag_id%qnr_tiny_col > 0) then + diag_pt%qnrdt_tiny = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qsdt_fill + diag_id%qs_fill_col > 0) then + diag_pt%qsdt_fill = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qnsdt_fill + diag_id%qns_fill_col > 0) then + diag_pt%qnsdt_fill = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qsdt_tiny + diag_id%qs_tiny_col > 0) then + diag_pt%qsdt_tiny = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qnsdt_tiny + diag_id%qns_tiny_col > 0) then + diag_pt%qnsdt_tiny = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qrdt_destr + diag_id%qr_destr_col > 0) then + diag_pt%qrdt_destr = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qnrdt_destr + diag_id%qnr_destr_col > 0) then + diag_pt%qnrdt_destr = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qsdt_destr + diag_id%qs_destr_col > 0) then + diag_pt%qsdt_destr = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%qnsdt_destr + diag_id%qns_destr_col > 0) then + diag_pt%qnsdt_destr = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_inst + diag_id%rain_inst_col > 0) then + diag_pt%rain_inst = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_sedi + diag_id%rain_sedi_col > 0) then + diag_pt%rain_sedi = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_num_inst + diag_id%rain_num_inst_col > 0) then + diag_pt%rain_num_inst = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_num_sedi + diag_id%rain_num_sedi_col > 0) then + diag_pt%rain_num_sedi = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_num_adj + diag_id%rain_num_adj_col > 0) then + diag_pt%rain_num_adj = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_num2snow + diag_id%rain_num2snow_col > 0) then + diag_pt%rain_num2snow = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_num_evap + diag_id%rain_num_evap_col > 0) then + diag_pt%rain_num_evap = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_num_freez + diag_id%rain_num_freez_col > 0) then + diag_pt%rain_num_freez = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%rain_num_selfcoll + diag_id%rain_num_selfcoll_col > 0) then + diag_pt%rain_num_selfcoll = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + + if (diag_id%snow_inst + diag_id%snow_inst_col > 0) then + diag_pt%snow_inst = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%snow_sedi + diag_id%snow_sedi_col > 0) then + diag_pt%snow_sedi = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%snow_num_inst + diag_id%snow_num_inst_col > 0) then + diag_pt%snow_num_inst = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%snow_num_sedi + diag_id%snow_num_sedi_col > 0) then + diag_pt%snow_num_sedi = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%snow_num_melt + diag_id%snow_num_melt_col > 0) then + diag_pt%snow_num_melt = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if + + if (diag_id%snow_num_adj + diag_id%snow_num_adj_col > 0) then + diag_pt%snow_num_adj = n_diag_4d + n_diag_4d = n_diag_4d + 1 + end if !---------------------------------------------------------------------- diff --git a/atmos_param/lscloud_driver/lscloud_types.F90 b/atmos_param/lscloud_driver/lscloud_types.F90 index 2e6d60d9..1582654d 100644 --- a/atmos_param/lscloud_driver/lscloud_types.F90 +++ b/atmos_param/lscloud_driver/lscloud_types.F90 @@ -42,35 +42,49 @@ module lscloud_types_mod ! cloud liquid variables integer :: SL3d, qldt_cond, qldt_evap, qldt_eros, qldt_berg, qldt_freez,& - liq_adj, qldt_rime, qldt_accr, qldt_auto, qldt_fill, & + liq_adj, qldt_rime, qldt_accr, qldt_auto, qldt_fill, qldt_tiny, & qldt_destr, qldt_freez2, qldt_sedi, qldt_accrs, qldt_bergs, & qldt_HM_splinter, SL_imb integer :: SL2d, ql_cond_col, ql_evap_col, ql_eros_col, ql_berg_col, & ql_freez_col, liq_adj_col, ql_rime_col, ql_accr_col, & - ql_auto_col, ql_fill_col, ql_destr_col, ql_freez2_col, & + ql_auto_col, ql_fill_col, ql_tiny_col, ql_destr_col, ql_freez2_col, & ql_sedi_col, ql_accrs_col, ql_bergs_col, ql_HM_splinter_col, & SL_imb_col ! cloud ice variables integer :: SI3d, qidt_dep, qidt_subl, qidt_fall, qidt_eros, qidt_melt, & - qidt_melt2, qidt_fill, qidt_destr, qidt_qvdep, qidt_auto, & - qidt_accr, qidt_accrs, ice_adj, SI_imb + qidt_melt2, qidt_fill, qidt_tiny, qidt_destr, qidt_qvdep, qidt_auto, & + qidt_accr, qidt_accrs, ice_adj, qidt_rain2ice, SI_imb integer :: SI2d, qi_dep_col, qi_subl_col, qi_fall_col, qi_eros_col, & - qi_melt_col, qi_melt2_col, qi_fill_col, qi_destr_col, & + qi_melt_col, qi_melt2_col, qi_fill_col, qi_tiny_col, qi_destr_col, & qi_qvdep_col, qi_auto_col, qi_accr_col, qi_accrs_col, & - ice_adj_col, SI_imb_col + ice_adj_col, qi_rain2ice_col, SI_imb_col + +! rain variables + integer :: qrdt_fill, qr_fill_col, qrdt_destr, qr_destr_col, qrdt_tiny, qr_tiny_col + +! snow variables + integer :: qsdt_fill, qs_fill_col, qsdt_destr, qs_destr_col, qsdt_tiny, qs_tiny_col + +! rain number variables + integer :: qnrdt_fill, qnr_fill_col, qnrdt_destr, qnr_destr_col, qnrdt_tiny, qnr_tiny_col + +! snow number variables + integer :: qnsdt_fill, qns_fill_col, qnsdt_destr, qns_destr_col, qnsdt_tiny, qns_tiny_col + + integer :: SR3d, SR2d, SNR3d, SNR2d, SS3d, SS2d, SNS3d, SNS2d ! cloud droplet variables integer :: droplets_col250, gb_droplets_col, potential_droplets, & droplets, droplets_wtd, ql_wt, droplets_col, rvolume - integer :: SN3d, qndt_cond , qndt_evap, qndt_fill, qndt_berg, qndt_rime, & !h1g, 2014-07-24 + integer :: SN3d, qndt_cond , qndt_evap, qndt_fill, qndt_tiny, qndt_berg, qndt_rime, & !h1g, 2014-07-24 qndt_destr, qndt_super, qndt_freez, qndt_sacws, qndt_sacws_o, & qndt_eros, qndt_pra, qndt_auto, qndt_nucclim, qndt_sedi, & qndt_melt, qndt_ihom, qndt_size_adj, qndt_fill2, & qndt_contact_frz, qndt_cleanup, qndt_cleanup2, SN_imb - integer :: SN2d, qn_cond_col, qn_evap_col, qn_fill_col, qn_berg_col, qn_rime_col, & !h1g, 2014-07-24 + integer :: SN2d, qn_cond_col, qn_evap_col, qn_fill_col, qn_tiny_col, qn_berg_col, qn_rime_col, & !h1g, 2014-07-24 qn_destr_col, qn_super_col, qn_freez_col, qn_sacws_col, & qn_sacws_o_col, qn_eros_col, qn_pra_col, qn_auto_col, & qn_nucclim_col, qn_sedi_col, qn_melt_col, qn_ihom_col, & @@ -80,17 +94,17 @@ module lscloud_types_mod ! cloud ice particle variables integer :: nice, nice_col, gb_nice_col, potential_crystals - integer :: SNi3d, qnidt_fill, qnidt_nnuccd, qnidt_nsubi, & - qnidt_nerosi, qnidt_nprci, qnidt_nprai, & + integer :: SNi3d, qnidt_fill, qnidt_tiny, qnidt_nnuccd, qnidt_nsubi, & + qnidt_nerosi, qnidt_auto, qnidt_accr, qnidt_nprci, qnidt_nprai, & qnidt_nucclim1, qnidt_nucclim2, qnidt_sedi, & qnidt_melt, qnidt_size_adj, qnidt_fill2, & - qnidt_super, qnidt_ihom, qnidt_destr, & + qnidt_super, qnidt_ihom, qnidt_destr, qnidt_rain2ice, & qnidt_cleanup, qnidt_cleanup2, qnidt_nsacwi, SNi_imb - integer :: SNi2d, qni_fill_col, qni_nnuccd_col, qni_nsubi_col, & - qni_nerosi_col, qni_nprci_col, qni_nprai_col, & + integer :: SNi2d, qni_fill_col, qni_tiny_col, qni_nnuccd_col, qni_nsubi_col, & + qni_nerosi_col, qni_auto_col, qni_accr_col, qni_nprci_col, qni_nprai_col, & qni_nucclim1_col, qni_nucclim2_col, qni_sedi_col, & qni_melt_col, qni_size_adj_col, qni_fill2_col, & - qni_super_col, qni_ihom_col, qni_destr_col, & + qni_super_col, qni_ihom_col, qni_destr_col, qni_rain2ice_col, & qni_cleanup_col, qni_cleanup2_col, & qni_nsacwi_col, SNi_imb_col @@ -105,17 +119,31 @@ module lscloud_types_mod integer :: rain3d, qrout, rain_clr, rain_cld, a_rain_clr, a_rain_cld, & rain_evap, rain_freeze, srfrain_accrs, srfrain_freez, & - srfrain_evap, rain_evap_col, rain_freeze_col, & + srfrain_evap, rain_inst, rain_sedi, & + rain_evap_col, rain_freeze_col, & srfrain_accrs_col, srfrain_freez_col, srfrain_evap_col, & - rain_mass_conv, rain_imb, cld_liq_imb, & + rain_inst_col, rain_sedi_col, & + rain_mass_conv, rain_imb, rain_imb_col, cld_liq_imb, & cld_liq_imb_col, neg_rain, qrout_col +! rain number diagnostics + integer :: rain_num_inst, rain_num_sedi, rain_num_adj, rain_num2snow, & + rain_num_evap, rain_num_freez, rain_num_selfcoll, & + rain_num_inst_col, rain_num_sedi_col, rain_num_adj_col, rain_num2snow_col, & + rain_num_evap_col, rain_num_freez_col,rain_num_selfcoll_col + ! snow diagnostics integer :: snow3d, qsout, snow_clr, snow_cld, a_snow_clr, a_snow_cld, & - snow_melt, snow_melt_col, snow_mass_conv, sedi_ice, snow_imb, & - cld_ice_imb, cld_ice_imb_col, neg_snow, qsout_col - + snow_melt, snow_inst, snow_sedi, & + snow_melt_col, snow_mass_conv, sedi_ice, snow_imb, & + snow_inst_col, snow_sedi_col, & + snow_imb_col, cld_ice_imb, cld_ice_imb_col, neg_snow, qsout_col + +! snow number diagnostics + integer :: snow_num_inst, snow_num_sedi, snow_num_melt, snow_num_adj, & + snow_num_inst_col, snow_num_sedi_col, snow_num_melt_col, snow_num_adj_col + ! total precip diagnostics @@ -128,12 +156,12 @@ module lscloud_types_mod ! vapor diagnostics - integer :: SQ3d, qdt_liquid_init, qdt_ice_init, qdt_rain_evap, & + integer :: SQ3d, qdt_liquid_init, qdt_ice_init, qdt_tiny, qdt_rain_evap, & qdt_cond, qdt_deposition, qdt_eros_l, qdt_eros_i, & qdt_qv_on_qi, qdt_sedi_ice2vapor, qdt_sedi_liquid2vapor, & qdt_super_sat_rm, qdt_destr, qdt_cleanup_liquid, & qdt_cleanup_ice, qdt_snow_sublim, qdt_snow2vapor, SQ_imb - integer :: SQ2d, q_liquid_init_col, q_ice_init_col, q_rain_evap_col, & + integer :: SQ2d, q_liquid_init_col, q_ice_init_col, q_tiny_col, q_rain_evap_col, & q_cond_col, q_deposition_col, q_eros_l_col, q_eros_i_col, & q_qv_on_qi_col, q_sedi_ice2vapor_col, q_sedi_liquid2vapor_col,& q_super_sat_rm_col, q_destr_col, q_cleanup_liquid_col, & @@ -166,21 +194,36 @@ module lscloud_types_mod ! cloud liquid variables integer :: SL3d, qldt_cond, qldt_evap, qldt_eros, qldt_berg, qldt_freez,& - liq_adj, qldt_rime, qldt_accr, qldt_auto, qldt_fill, & + liq_adj, qldt_rime, qldt_accr, qldt_auto, qldt_fill, qldt_tiny, & qldt_destr, qldt_freez2, qldt_sedi, qldt_accrs, qldt_bergs, & qldt_HM_splinter, SL_imb ! cloud ice variables integer :: SI3d, qidt_dep, qidt_subl, qidt_fall, qidt_eros, qidt_melt, & - qidt_melt2, qidt_fill, qidt_destr, qidt_qvdep, qidt_auto, & - qidt_accr, qidt_accrs, ice_adj, SI_imb + qidt_melt2, qidt_fill, qidt_tiny, qidt_destr, qidt_qvdep, qidt_auto, & + qidt_accr, qidt_accrs, ice_adj, qidt_rain2ice, SI_imb + +! rain variables + integer :: qrdt_fill, qrdt_destr, qrdt_tiny + +! snow variables + integer :: qsdt_fill, qsdt_destr, qsdt_tiny + +! rain number variables + integer :: qnrdt_fill, qnrdt_destr, qnrdt_tiny + +! snow number variables + integer :: qnsdt_fill, qnsdt_destr, qnsdt_tiny + + integer :: SR3d, SR2d, SNR3d, SNR2d, SS3d, SS2d, SNS3d, SNS2d + ! cloud droplet variables integer :: droplets_col250, gb_droplets_col, potential_droplets, & droplets, droplets_wtd, ql_wt, droplets_col, rvolume - integer :: SN3d, qndt_cond , qndt_evap, qndt_fill, qndt_berg, qndt_rime, & !h1g, 2014-07-24 + integer :: SN3d, qndt_cond , qndt_evap, qndt_fill, qndt_tiny, qndt_berg, qndt_rime, & !h1g, 2014-07-24 qndt_destr, qndt_super, qndt_freez, qndt_sacws, qndt_sacws_o, & qndt_eros, qndt_pra, qndt_auto, qndt_nucclim, qndt_sedi, & qndt_melt, qndt_ihom, qndt_size_adj, qndt_fill2, & @@ -189,11 +232,11 @@ module lscloud_types_mod ! cloud ice particle variables integer :: nice, nice_col, gb_nice_col, potential_crystals - integer :: SNi3d, qnidt_fill, qnidt_nnuccd, qnidt_nsubi, & - qnidt_nerosi, qnidt_nprci, qnidt_nprai, & + integer :: SNi3d, qnidt_fill, qnidt_tiny, qnidt_nnuccd, qnidt_nsubi, & + qnidt_nerosi, qnidt_auto, qnidt_accr, qnidt_nprci, qnidt_nprai, & qnidt_nucclim1, qnidt_nucclim2, qnidt_sedi, & qnidt_melt, qnidt_size_adj, qnidt_fill2, & - qnidt_super, qnidt_ihom, qnidt_destr, & + qnidt_super, qnidt_ihom, qnidt_destr, qnidt_rain2ice, & qnidt_cleanup, qnidt_cleanup2, qnidt_nsacwi, SNi_imb ! aerosol diagnostics @@ -204,17 +247,26 @@ module lscloud_types_mod ndust4, ndust5, dust_berg_flag, subgrid_w_variance ! rain diagnostics - integer :: rain3d, qrout, rain_clr, rain_cld, a_rain_clr, a_rain_cld, & rain_evap, rain_freeze, srfrain_accrs, srfrain_freez, & + rain_inst, rain_sedi, & srfrain_evap, rain_mass_conv, rain_imb, cld_liq_imb, neg_rain -! snow diagnostics +! rain number diagnostics + integer :: rain_num_inst, rain_num_sedi, rain_num_adj, rain_num2snow, & + rain_num_evap, rain_num_freez, rain_num_selfcoll +! snow diagnostics integer :: snow3d, qsout, snow_clr, snow_cld, a_snow_clr, a_snow_cld, & + snow_inst, snow_sedi,& snow_melt, snow_mass_conv, sedi_ice, snow_imb, cld_ice_imb, & neg_snow +! snow number diagnostics + integer :: snow_num_inst, snow_num_sedi, snow_num_melt, snow_num_adj + + + ! total precip diagnostics integer :: a_precip_cld, a_precip_clr, sedi_sfc @@ -225,7 +277,7 @@ module lscloud_types_mod ! vapor diagnostics - integer :: SQ3d, qdt_liquid_init, qdt_ice_init, qdt_rain_evap, & + integer :: SQ3d, qdt_liquid_init, qdt_ice_init, qdt_tiny, qdt_rain_evap, & qdt_cond, qdt_deposition, qdt_eros_l, qdt_eros_i, & qdt_qv_on_qi, qdt_sedi_ice2vapor, qdt_sedi_liquid2vapor, & qdt_super_sat_rm, qdt_destr, qdt_cleanup_liquid, & @@ -375,25 +427,44 @@ module lscloud_types_mod ! intermediate qi real, dimension(:,:,:), pointer :: & ql_upd =>NULL(), & + qr_upd =>NULL(), & qi_upd =>NULL(), & + qs_upd =>NULL(), & + qg_upd =>NULL(), & qa_upd =>NULL(), & qn_upd =>NULL(), & qni_upd =>NULL(), & + qnr_upd =>NULL(), & + qns_upd =>NULL(), & ql_mean =>NULL(), & + qr_mean =>NULL(), & qi_mean =>NULL(), & + qs_mean =>NULL(), & + qg_mean =>NULL(), & qa_mean =>NULL(), & qn_mean =>NULL(), & qni_mean =>NULL(), & + qnr_mean =>NULL(), & + qns_mean =>NULL(), & ql_in =>NULL(), & + qr_in =>NULL(), & qi_in =>NULL(), & + qs_in =>NULL(), & + qg_in =>NULL(), & qa_in =>NULL(), & qn_in =>NULL(), & qni_in =>NULL(), & + qnr_in =>NULL(), & + qns_in =>NULL(), & SL_out =>NULL(), & SI_out =>NULL(), & SA_out =>NULL(), & SN_out =>NULL(), & SNi_out =>NULL(), & + SR_out =>NULL(), & + SS_out =>NULL(), & + SNR_out =>NULL(), & + SNS_out =>NULL(), & SA_0 =>NULL(), & qa_upd_0 =>NULL(), & relvarn =>NULL(), & @@ -472,6 +543,7 @@ module lscloud_types_mod do_mg_microphys, & do_mg_ncar_microphys, & do_ncar_microphys, & + do_ncar_MG2, & do_lin_cld_microphys, & tiedtke_macrophysics, & dqa_activation, & diff --git a/atmos_param/macrophysics/tiedtke_macro.F90 b/atmos_param/macrophysics/tiedtke_macro.F90 index fee7cd7d..f691bbe7 100644 --- a/atmos_param/macrophysics/tiedtke_macro.F90 +++ b/atmos_param/macrophysics/tiedtke_macro.F90 @@ -781,6 +781,9 @@ subroutine tiedtke_macro_diagnostics ( & if (diag_id%dcond > 0 ) & diag_4d(:,:,:,diag_pt%dcond) = Cloud_processes%dcond_ls(:,:,:) +!--> h1g, this is only for partial activation +!--> (i.e., dqa_activation = true or aerosol_activation_scheme = dqa + if ( .not. total_activation ) then do k=1,kdim do j=1,jdim do i=1,idim @@ -793,7 +796,7 @@ subroutine tiedtke_macro_diagnostics ( & end do end do end do - + endif !----------------------------------------------------------------------- end subroutine tiedtke_macro_diagnostics diff --git a/atmos_param/microphysics/ls_cloud_microphysics.F90 b/atmos_param/microphysics/ls_cloud_microphysics.F90 index 17d1b38c..b7062759 100644 --- a/atmos_param/microphysics/ls_cloud_microphysics.F90 +++ b/atmos_param/microphysics/ls_cloud_microphysics.F90 @@ -10,6 +10,7 @@ module ls_cloud_microphysics_mod ! MG microphysics (as developed by M. Salzmann) ! MG-NCAR microphysics (an early version of NCAR microphysics) ! NCAR microphysics version 1.5 (became available in 2012) +! NCAR microphysics version 2.0 (became available? ) ! !----------------------------------------------------------------------- @@ -71,6 +72,9 @@ module ls_cloud_microphysics_mod use micro_mg_mod, only: micro_mg_init, micro_mg_get_cols,& micro_mg_tend +use micro_mg2_mod, only: micro_mg2_init, micro_mg2_get_cols,& + micro_mg2_tend + implicit none private @@ -109,7 +113,7 @@ module ls_cloud_microphysics_mod ! model ice particle number ? logical :: use_Cooper = .false. ! use Cooper formula when overriding ! model ice particle number ? -integer, dimension(6) :: init_date = (/ 1980, 1, 1, 0, 0, 0 /) +integer, dimension(6) :: init_date = (/ 1, 1, 1, 0, 0, 0 /) ! date to use as base for ! defining microphysics start time real :: micro_begin_sec = 0.0 ! begin microphysics this many @@ -118,17 +122,21 @@ module ls_cloud_microphysics_mod real :: min_precip_needing_adjustment = 0.0 real :: lowest_allowed_precip = 0.0 logical :: use_ndust = .false. +real :: accretion_scale = 1.0 +real :: liq_num_eros_fac = 1.0 +real :: ice_num_eros_fac = 1.0 +logical :: do_cleanup = .true. namelist / ls_cloud_microphysics_nml / & lin_microphys_top_press, mass_cons, & override_liq_num, override_ice_num, & use_Meyers, use_Cooper, init_date, & micro_begin_sec, top_lev, & min_precip_needing_adjustment, & - lowest_allowed_precip, use_ndust - - + lowest_allowed_precip, use_ndust, accretion_scale, & + do_cleanup, liq_num_eros_fac, ice_num_eros_fac !h1g, 2020-06-22 + !-------------------- clock definitions -------------------------------- integer :: rk_micro_clock, lin_micro_clock, ncar_micro_clock @@ -145,10 +153,10 @@ module ls_cloud_microphysics_mod logical :: doing_prog_clouds real :: dtcloud, inv_dtcloud logical :: do_rk_microphys, do_mg_microphys, do_mg_ncar_microphys, & - do_ncar_microphys + do_ncar_microphys, do_ncar_MG2 logical :: tiedtke_macrophysics logical :: dqa_activation, total_activation -integer :: nsphum, nql, nqi, nqa, nqn, nqni, nqr, nqs, nqg +integer :: nsphum, nql, nqi, nqa, nqn, nqni, nqr, nqs, nqg, nqnr, nqns !-------------------------------------------------------------------- ! other module variables @@ -219,6 +227,9 @@ subroutine ls_cloud_microphysics_init ( & do_mg_microphys = Constants_lsc%do_mg_microphys do_mg_ncar_microphys = Constants_lsc%do_mg_ncar_microphys do_ncar_microphys = Constants_lsc%do_ncar_microphys + + do_ncar_MG2 = Constants_lsc%do_ncar_MG2 + tiedtke_macrophysics = Constants_lsc%tiedtke_macrophysics dqa_activation = Constants_lsc%dqa_activation total_activation = Constants_lsc%total_activation @@ -231,6 +242,9 @@ subroutine ls_cloud_microphysics_init ( & nqr = Physics_control%nqr nqs = Physics_control%nqs + nqnr = Physics_control%nqnr + nqns = Physics_control%nqns + !------------------------------------------------------------------------ ! define clocks for large-scale cloud schemes initialization (local ! variables) and for the prognostic loop clocks (module variables). @@ -255,6 +269,10 @@ subroutine ls_cloud_microphysics_init ( & ncar_micro_init_clock = mpp_clock_id( & ' Ls_cld_micro: ncar_micro:Initialization' , & grain=CLOCK_MODULE_DRIVER) + else if (do_ncar_MG2) then + ncar_micro_init_clock = mpp_clock_id( & + ' Ls_cld_micro: ncar_MG2:Initialization' , & + grain=CLOCK_MODULE_DRIVER) endif if (do_rk_microphys) then @@ -277,6 +295,10 @@ subroutine ls_cloud_microphysics_init ( & ncar_micro_clock = mpp_clock_id( & ' Ls_cld_micro: ncar_micro' , & grain=CLOCK_MODULE_DRIVER ) + else if (do_ncar_MG2) then + ncar_micro_clock = mpp_clock_id( & + ' Ls_cld_micro: ncar_MG2' , & + grain=CLOCK_MODULE_DRIVER ) endif !------------------------------------------------------------------------- @@ -399,6 +421,20 @@ subroutine ls_cloud_microphysics_init ( & endif call mpp_clock_end (ncar_micro_init_clock) +!----------------------------------------------------------------------- +! ncar microphysics (ncar v2.0) +!----------------------------------------------------------------------- + else if (do_ncar_MG2) then + call mpp_clock_begin (ncar_micro_init_clock) + call micro_mg2_init (r8, GRAV, RDGAS, RVGAS, CP_AIR, TFREEZE, & + HLV, HLF, Nml_lsc%do_ice_nucl_wpdf, & + errstring, Exch_ctrl) + if (trim(errstring) /= '') then + call error_mesg ('ls_cloud_microphysics/micro_mg2_init', & + errstring, FATAL) + endif + call mpp_clock_end (ncar_micro_init_clock) + !----------------------------------------------------------------------- ! no valid microphys scheme chosen !----------------------------------------------------------------------- @@ -458,7 +494,7 @@ end subroutine ls_cloud_microphysics_time_vary !######################################################################## subroutine ls_cloud_microphysics ( & - is, ie, js, je, Time, dt, Input_mp, Output_mp, C2ls_mp,& + is, ie, js, je, Time, dt, lon, lat, Input_mp, Output_mp, C2ls_mp,& Tend_mp, Lsdiag_mp, Lsdiag_mp_control, Atmos_state, & Cloud_state, Particles, Precip_state, Cloud_processes, & Removal_mp, Aerosol) @@ -481,6 +517,8 @@ subroutine ls_cloud_microphysics ( & integer, intent(in) :: is, ie, js, je real, intent(in) :: dt type(aerosol_type), intent(in), optional :: Aerosol +real, intent(in), dimension(:,:) :: lon, lat + !------------------------------------------------------------------------ ! local variables: @@ -494,7 +532,9 @@ subroutine ls_cloud_microphysics ( & size(Input_mp%tin,3)) :: & delp, delz, & ST_micro, SQ_micro, SL_micro, SI_micro, & - SN_micro, SNI_micro, D_eros_l, D_eros_i, & + SN_micro, SNI_micro, & + SR_micro, SS_micro, SNR_micro,SNS_micro,& + D_eros_l, D_eros_i, & nerosc, nerosi, dqcdt, dqidt, qa_new, & ssat_disposal, ql_new, qi_new, & nctend, nitend, qn_new, qni_new, & @@ -502,7 +542,7 @@ subroutine ls_cloud_microphysics ( & accre_enhann, tnd_qsnown, & tnd_nsnown, re_icen, relvarn, & crystal1, rho_air, & - aerosols_concen, droplets_concen + aerosols_concen, droplets_concen, test_bqx, dte3d real, dimension( size(Input_mp%tin,1), size(Input_mp%tin,2), & size(Input_mp%tin,3),4) :: & @@ -577,107 +617,30 @@ subroutine ls_cloud_microphysics ( & Tend_mp%q_tnd(:,:,:,nqni) = Cloud_state%SNI_out(:,:,:) call mpp_clock_end (rk_micro_clock) -!----------------------------------------------------------------------- -! lin cld microphysics is activated -!----------------------------------------------------------------------- - else if (do_lin_cld_microphys ) then - call mpp_clock_begin (lin_micro_clock) - do k=1,kx - delp(:,:,k) = & - Input_mp%phalf(:,:,k+1) - Input_mp%phalf(:,:,k) - delz(:,:,k) = & - (Input_mp%zhalf(:,:,k+1) - Input_mp%zhalf(:,:,k))*& - Input_mp%tin(:,:,k)/Input_mp%tm(:,:,k) - end do - -!------------------------------------------------------------------------ -! droplet number concentration in #/cc following Boucher and Lohmann 1995 -! the lin microphysics uses #/cc -!------------------------------------------------------------------------ - do k=1,kx - do j=1,jx - do i=1,ix - depth = (Input_mp%phalf(i,j,k+1) - Input_mp%phalf(i,j,k)) / & - ( 9.8*0.029*Input_mp%pfull(i,j,k )/(8.314* & - Input_mp%tin(i,j,k))) -!sulfate concentration in ug/m3 - aerosols_concen(i,j,k)=(Aerosol%aerosol(i,j,k,1))/depth*1.e9 - if ( Input_mp%lat(i,j) < -1.0472 ) then ! South of ~60S are treated as ocean - droplets_concen(i,j,k)= 10.**2.06* & - (0.7273*aerosols_concen(i,j,k))**0.48 - else - droplets_concen(i,j,k)= Input_mp%land(i,j) *(10.**2.24* & - (0.7273*aerosols_concen(i,j,k))**0.257)+ & - (1.-Input_mp%land(i,j))* (10.**2.06* & - (0.7273*aerosols_concen(i,j,k))**0.48) - endif - enddo - enddo - end do - - call lin_cld_microphys_driver( & - Input_mp%qin, Input_mp%tracer(:,:,:,nql), & - Input_mp%tracer(:,:,:,nqr), Input_mp%tracer(:,:,:,nqi), & - Input_mp%tracer(:,:,:,nqs), Input_mp%tracer(:,:,:,nqg), & - Input_mp%tracer(:,:,:,nqa), droplets_concen,Tend_mp%qtnd, & - Tend_mp%q_tnd(:,:,:,nql), Tend_mp%q_tnd(:,:,:,nqr), & - Tend_mp%q_tnd(:,:,:,nqi), Tend_mp%q_tnd(:,:,:,nqs), & - Tend_mp%q_tnd(:,:,:,nqg), tend_mp%q_tnd(:,:,:,nqa), & - Tend_mp%ttnd, Input_mp%tin, Input_mp%w, Input_mp%uin, & - Input_mp%vin, Output_mp%udt, Output_mp%vdt, delz, delp, & - Input_mp%area, dt, Input_mp%land, Precip_state%surfrain, & - Precip_state%surfsnow, ice_lin, graupel_lin, & - is, ie, js, je, 1, kx, ktop, kx, Time) - -!----------------------------------------------------------------------- -! Add all "solid" form of precipitation into surf_snow -!----------------------------------------------------------------------- - Precip_state%surfsnow = (Precip_state%surfsnow + ice_lin + & - graupel_lin) * dt/86400. - Precip_state%surfrain = Precip_state%surfrain * dt/86400. - -!----------------------------------------------------------------------- -! Update tendencies: -!----------------------------------------------------------------------- - Output_mp%rdt(:,:,:,nqr) = Output_mp%rdt(:,:,:,nqr) + & - Tend_mp%q_tnd(:,:,:,nqr) - Output_mp%rdt(:,:,:,nqs) = Output_mp%rdt(:,:,:,nqs) + & - Tend_mp%q_tnd(:,:,:,nqs) - Output_mp%rdt(:,:,:,nqg) = Output_mp%rdt(:,:,:,nqg) + & - Tend_mp%q_tnd(:,:,:,nqg) - Tend_mp%ttnd = Tend_mp%ttnd * dt - Tend_mp%qtnd = Tend_mp%qtnd * dt - Tend_mp%q_tnd(:,:,:,nql) = Tend_mp%q_tnd(:,:,:,nql) * dt - Tend_mp%q_tnd(:,:,:,nqi) = Tend_mp%q_tnd(:,:,:,nqi) * dt - Tend_mp%q_tnd(:,:,:,nqa) = Tend_mp%q_tnd(:,:,:,nqa) * dt - -!----------------------------------------------------------------------- -! Update rain_wat, snow_wat, graupel_wat -!----------------------------------------------------------------------- - Input_mp%tracer(:,:,:,nqr) = Input_mp%tracer(:,:,:,nqr) + & - Tend_mp%q_tnd(:,:,:,nqr)*dt - Input_mp%tracer(:,:,:,nqs) = Input_mp%tracer(:,:,:,nqs) + & - Tend_mp%q_tnd(:,:,:,nqs)*dt - Input_mp%tracer(:,:,:,nqg) = Input_mp%tracer(:,:,:,nqg) + & - Tend_mp%q_tnd(:,:,:,nqg)*dt - call mpp_clock_end (lin_micro_clock) - !----------------------------------------------------------------------- ! NCAR microphysics (currently 3 flavors) !----------------------------------------------------------------------- else if (do_mg_microphys .or. & do_mg_ncar_microphys .or. & - do_ncar_microphys) then + do_ncar_microphys .or. & + do_ncar_MG2 ) then call mpp_clock_begin (ncar_micro_clock) + ST_micro(:,:,:) = 0.0 + SQ_micro(:,:,:) = 0.0 + SL_micro(:,:,:) = 0.0 + SI_micro(:,:,:) = 0.0 + SN_micro(:,:,:) = 0.0 + SNI_micro(:,:,:) = 0.0 + + SR_micro(:,:,:) = 0.0 + SNR_micro(:,:,:) = 0.0 + SS_micro(:,:,:) = 0.0 + SNS_micro(:,:,:) = 0.0 + !----------------------------------------------------------------------- ! determine whether NCAR microphysics are active at the current time !----------------------------------------------------------------------- - call get_time( time, current_sec, current_days) - current_total_sec = real(current_sec - current_sec0) + & - 86400.0*(current_days - current_days0) - - if (current_total_sec >= micro_begin_sec) then Atmos_state%tn = Input_mp%tin + Tend_mp%ttnd Atmos_state%qvn = Input_mp%qin + Tend_mp%qtnd @@ -704,7 +667,7 @@ subroutine ls_cloud_microphysics ( & Cloud_processes%D_eros(i,j,k)/ & dtcloud if (Cloud_state%ql_upd(i,j,k) >= qmin) then - nerosc(i,j,k) = D_eros_l(i,j,k)/ & + nerosc(i,j,k) = liq_num_eros_fac * D_eros_l(i,j,k)/ & Cloud_state%ql_upd(i,j,k)* & Cloud_state%qn_upd(i,j,k)/MAX(0.0001, & Cloud_state%qa_upd(i,j,k)) @@ -712,7 +675,7 @@ subroutine ls_cloud_microphysics ( & nerosc(i,j,k) = 0. endif if (Cloud_state%qi_upd(i,j,k) >= qmin) then - nerosi(i,j,k) = D_eros_i(i,j,k)/ & + nerosi(i,j,k) = ice_num_eros_fac * D_eros_i(i,j,k)/ & Cloud_state%qi_upd(i,j,k)* & Cloud_state%qni_upd(i,j,k)/MAX(0.0001, & Cloud_state%qa_upd(i,j,k)) @@ -767,7 +730,7 @@ subroutine ls_cloud_microphysics ( & if (do_mg_microphys) then !----------------------------------------------------------------------- -! define activated droplets in units of #/kg (drop1 is #/cc). +! define activated droplets in units of #/kg (drop1 is in-cloud #/cc). !----------------------------------------------------------------------- Particles%drop2 = Particles%drop1*1.e6/Atmos_state%airdens @@ -829,7 +792,8 @@ subroutine ls_cloud_microphysics ( & !------------------------------------------------------------------------- ! executed for mg_ncar or ncar microphysics: !------------------------------------------------------------------------- - else if (do_mg_ncar_microphys .or. do_ncar_microphys) then + else if (do_mg_ncar_microphys .or. do_ncar_microphys & + .or. do_ncar_MG2 ) then rho = Input_mp%pfull/(RDGAS*Atmos_state%tn) @@ -1050,6 +1014,7 @@ subroutine ls_cloud_microphysics ( & call write_debug_output (" ST samp bef mg ", & Tend_mp%ttnd, j=j) + !------------------------------------------------------------------------- ! call the ncar microphysics routine micro_mg_tend. !------------------------------------------------------------------------- @@ -1144,36 +1109,176 @@ subroutine ls_cloud_microphysics ( & Precip_state%surfrain(i,j) *1000.0 enddo enddo - endif ! (do_mg) - endif ! (do_mg) + + else if (do_ncar_MG2) then + nlev = kx + top_lev = 1 + mgncol = ix + accre_enhann(:,:,:) = accretion_scale ! accretion enhancement factor + + call get_time( time, current_sec, current_days) + ! if ( mpp_pe() == mpp_root_pe() ) & + ! write(*,*) 'current_sec =', current_sec + + do k=1,kx + do j=1,jx + do i=1,ix + if ( Atmos_state%tn(i,j,k) .lt.-150.0+273.15 .or. & + Atmos_state%tn(i,j,k) .gt.90+273.15) & + write(*,'(a,3i5, 5f12.5, 15e12.3)') 'before MG2: bad temperature@1213', & + i,j,k, current_sec/3600.0, Atmos_state%tn(i,j,k), Atmos_state%qvn(i,j,k), Input_mp%pfull(i,j,k), dtcloud + + enddo + enddo + enddo + + do j=1,jx + call micro_mg2_tend ( lon(:,j), lat(:,j), & + dqa_activation, total_activation, & + tiedtke_macrophysics, j, jx, & + mgncol, nlev, dtcloud, & + Particles%concen_dust_sub(:,j,:), & + Atmos_state%tn(:,j,:), & + Atmos_state%qvn(:,j,:), & + Cloud_state%ql_upd(:,j,:), Cloud_state%qi_upd(:,j,:), & + Cloud_state%qn_upd(:,j,:), Cloud_state%qni_upd(:,j,:), & + Cloud_state%qr_upd(:,j,:), Cloud_state%qs_upd(:,j,:), & + Cloud_state%qnr_upd(:,j,:), Cloud_state%qns_upd(:,j,:), & + relvarn(:,j,:), accre_enhann(:,j,:), & + Input_mp%pfull(:,j,:), & + Atmos_state%delp(:,j,:), & + Input_mp%zhalf(:,j,:), & + Cloud_state%qa_upd(:,j,:), & + liqcldf(:,j,:) , icecldf(:,j,:), & + Cloud_processes%delta_cf(:,j,:), & + D_eros_l(:,j,:), nerosc(:,j,:), & + D_eros_i(:,j,:), nerosi(:,j,:), & + dqcdt(:,j,:), dqidt(:,j,:), & + crystal1(:,j,:), & + Particles%drop2(:,j,:), & + rbar_dust_4bin(:,j,:,:), ndust_4bin(:,j,:,:), & + ST_micro(:,j,:), SQ_micro(:,j,:), SL_micro(:,j,:), & + SI_micro(:,j,:), SN_micro(:,j,:), SNI_micro(:,j,:), & + SR_micro(:,j,:), SS_micro(:,j,:), SNR_micro(:,j,:), SNS_micro(:,j,:),& + Precip_state%surfrain(:,j), & + Precip_state%surfsnow(:,j), & + Precip_state%lsc_snow(:,j,:), & + Removal_mp%rain3d(:,j,:), & + Removal_mp%snow3d(:,j,:), & + Precip_state%lsc_rain(:,j,:), & + Precip_state%lsc_rain_size(:,j,:), & + Precip_state%lsc_snow_size(:,j,:), & + errstring, Cloud_processes%f_snow_berg(:,j,:), & + ssat_disposal (:,j,:), & + Lsdiag_mp_control%n_diag_4d, Lsdiag_mp%diag_4d, & + Lsdiag_mp_control%diag_id, & + Lsdiag_mp_control%diag_pt) +!Convert from effective radius to diameter for use in radiation. +! in old NCAR, diameter was returned from mmicro_pcond routine. + Precip_state%lsc_rain_size(:,j,:) = & + 2.0*Precip_state%lsc_rain_size(:,j,:) + Precip_state%lsc_snow_size(:,j,:) = & + 2.0*Precip_state%lsc_snow_size(:,j,:) + + if(maxval(Removal_mp%snow3d(:,j,:)) > 1.e-2) write(*,*) 'max snow3d',maxval(Removal_mp%snow3d(:,j,:)) + if(minval(Removal_mp%snow3d(:,j,:)) <-1.e-2) write(*,*) 'min snow3d',minval(Removal_mp%snow3d(:,j,:)) + + do i=1,ix + do k=1,kx + if( Cloud_state%qn_upd(i,j,k) + dtcloud * SN_micro(i,j,k) < -1.e-3 ) then + print*, 'negative drop number @1281', lon(i,j), lat(i,j), k, Cloud_state%qn_upd(i,j,k), & + SN_micro(i,j,k), Cloud_state%qn_upd(i,j,k) + dtcloud * SN_micro(i,j,k) + endif + + if( Cloud_state%qr_upd(i,j,k) + dtcloud * SR_micro(i,j,k) < -1.e-3 ) then + print*, 'negative rain mass @1281', lon(i,j), lat(i,j), k, Cloud_state%qr_upd(i,j,k), & + SR_micro(i,j,k), Cloud_state%qr_upd(i,j,k) + dtcloud * SR_micro(i,j,k) + endif + + if( Cloud_state%qnr_upd(i,j,k) + dtcloud * SNR_micro(i,j,k) < -1.e-3 ) then + print*, 'negative rain number @1281', lon(i,j), lat(i,j), k, Cloud_state%qnr_upd(i,j,k), & + SNR_micro(i,j,k), Cloud_state%qnr_upd(i,j,k) + dtcloud * SNR_micro(i,j,k) + endif + + if( Cloud_state%qs_upd(i,j,k) + dtcloud * SS_micro(i,j,k) < -1.e-3 ) then + print*, 'negative snow mass @1281', lon(i,j), lat(i,j), k, Cloud_state%qs_upd(i,j,k), & + SS_micro(i,j,k), Cloud_state%qs_upd(i,j,k) + dtcloud * SS_micro(i,j,k) + endif + + if( Cloud_state%qns_upd(i,j,k) + dtcloud * SNS_micro(i,j,k) < -1.e-3 ) then + print*, 'negative snow number @1281', lon(i,j), lat(i,j), k, Cloud_state%qns_upd(i,j,k), & + SNS_micro(i,j,k), Cloud_state%qns_upd(i,j,k) + dtcloud * SNS_micro(i,j,k) + endif + enddo + enddo + + enddo ! end of j loop + +!------------------------------------------------------------------------ +! calculate column enthalpy and total water changes +! Note: in MG2, temperature tendency is multiplied by Cp_air. +!------------------------------------------------------------------------ + enth_micro_col(:,:) = 0.0 + wat_micro_col(:,:) = 0.0 + do j=1,jx + do i=1,ix + do k=1,kx + enth_micro_col(i,j) = enth_micro_col(i,j) + & + ( ST_micro(i,j,k) - HLV*SL_micro(i,j,k) - & + HLS*SI_micro(i,j,k) )* & + Atmos_state%delp(i,j,k)/grav + + wat_micro_col(i,j) = wat_micro_col(i,j) + & + ( SQ_micro(i,j,k) + SL_micro(i,j,k) + & + SI_micro(i,j,k) )* & + Atmos_state%delp(i,j,k)/grav + enddo + + enth_micro_col(i,j) = enth_micro_col(i,j) + & + (-HLV*1000.0* & + (Precip_state%surfrain(i,j) - & + Precip_state%surfsnow(i,j)) - & + HLS*1000.0 * Precip_state%surfsnow(i,j) ) + + wat_micro_col(i,j) = wat_micro_col(i,j) + & + Precip_state%surfrain(i,j) *1000.0 + enddo + enddo + + endif ! do_mg_ncar_microphys + endif ! if do_mg_microphys, elseif do_mg_ncar_microphys .or. do_ncar_microphys & .or. do_ncar_MG2 !------------------------------------------------------------------------ ! adjust precip fields to assure mass conservation and realizable ! values. !------------------------------------------------------------------------ call adjust_precip_fields ( & - ix, jx, kx, SQ_micro, SL_micro, SI_micro, & + ix, jx, kx, SQ_micro, SL_micro, SI_micro, SR_micro, SS_micro, & Atmos_state, Precip_state, Lsdiag_mp, & Lsdiag_mp_control ) !----------------------------------------------------------------------- ! update prognostic tendencies due to microphysics terms. !----------------------------------------------------------------------- - Tend_mp%qtnd = Tend_mp%qtnd + SQ_micro*dtcloud - Tend_mp%ttnd = Tend_mp%ttnd + ST_micro/cp_air*dtcloud - Tend_mp%q_tnd(:,:,:,nql) = Tend_mp%q_tnd(:,:,:,nql) + & - SL_micro(:,:,:)*dtcloud - Tend_mp%q_tnd(:,:,:,nqi) = Tend_mp%q_tnd(:,:,:,nqi) + & - SI_micro(:,:,:)*dtcloud - Tend_mp%q_tnd(:,:,:,nqn) = Tend_mp%q_tnd(:,:,:,nqn) + & - SN_micro(:,:,:)*dtcloud - Tend_mp%q_tnd(:,:,:,nqni)= Tend_mp%q_tnd(:,:,:,nqni) + & - SNI_micro(:,:,:)*dtcloud + Tend_mp%qtnd = Tend_mp%qtnd + SQ_micro*dtcloud + Tend_mp%ttnd = Tend_mp%ttnd + ST_micro/cp_air*dtcloud + Cloud_state%SL_out = Cloud_state%SL_out + SL_micro*dtcloud + Cloud_state%SI_out = Cloud_state%SI_out + SI_micro*dtcloud + Cloud_state%SN_out = Cloud_state%SN_out + SN_micro*dtcloud + Cloud_state%SNI_out = Cloud_state%SNI_out + SNI_micro*dtcloud - Cloud_state%SL_out = Cloud_state%SL_out + SL_micro*dtcloud - Cloud_state%SI_out = Cloud_state%SI_out + SI_micro*dtcloud - Cloud_state%SN_out = Cloud_state%SN_out + SN_micro*dtcloud - Cloud_state%SNI_out = Cloud_state%SNI_out + SNI_micro*dtcloud + if (nqr /= NO_TRACER) then + Cloud_state%SR_out = Cloud_state%SR_out + SR_micro*dtcloud + endif + if (nqs /= NO_TRACER) then + Cloud_state%SS_out = Cloud_state%SS_out + SS_micro*dtcloud + endif + if (nqnr /= NO_TRACER) then + Cloud_state%SNR_out = Cloud_state%SNR_out + SNR_micro*dtcloud + endif + if (nqns /= NO_TRACER) then + Cloud_state%SNS_out = Cloud_state%SNS_out + SNS_micro*dtcloud + endif !------------------------------------------------------------------------ ! adjustment to fields needed after removing supersaturation (only @@ -1246,6 +1351,14 @@ subroutine ls_cloud_microphysics ( & Tend_mp%q_tnd(:,:,:,nqn) = Cloud_state%SN_out(:,:,:) if (nqni /= NO_TRACER) & Tend_mp%q_tnd(:,:,:,nqni) = Cloud_state%SNI_out(:,:,:) + if (nqr /= NO_TRACER) & + Tend_mp%q_tnd(:,:,:,nqr) = Cloud_state%SR_out(:,:,:) + if (nqs /= NO_TRACER) & + Tend_mp%q_tnd(:,:,:,nqs) = Cloud_state%SS_out(:,:,:) + if (nqnr /= NO_TRACER) & + Tend_mp%q_tnd(:,:,:,nqnr) = Cloud_state%SNR_out(:,:,:) + if (nqns /= NO_TRACER) & + Tend_mp%q_tnd(:,:,:,nqns) = Cloud_state%SNS_out(:,:,:) !----------------------------------------------------------------------- ! define the total precipitating ice field for use in COSP (stored in @@ -1256,7 +1369,6 @@ subroutine ls_cloud_microphysics ( & Removal_mp%snowclr3d = Removal_mp%snow3d endif ! do_clubb - endif ! current_total_sec >= micro_begin_sec call mpp_clock_end (ncar_micro_clock) !------------------------------------------------------------------------- @@ -1344,7 +1456,7 @@ end subroutine ls_cloud_microphysics_end !######################################################################## subroutine adjust_precip_fields ( & - ix, jx, kx, SQ_micro, SL_micro, SI_micro, & + ix, jx, kx, SQ_micro, SL_micro, SI_micro, SR_micro, SS_micro, & Atmos_state, Precip_state, Lsdiag_mp, & Lsdiag_mp_control ) @@ -1360,7 +1472,7 @@ subroutine adjust_precip_fields ( & type(mp_lsdiag_control_type), intent(inout) :: Lsdiag_mp_control type(atmos_state_type), intent(inout) :: Atmos_state type(precip_state_type), intent(inout) :: Precip_state -real, dimension (:,:,:), intent(in) :: SL_micro, SI_micro, SQ_micro +real, dimension (:,:,:), intent(in) :: SL_micro, SI_micro, SQ_micro, SR_micro, SS_micro !---------------------------------------------------------------------- @@ -1380,7 +1492,7 @@ subroutine adjust_precip_fields ( & m1(i,j) = 0. do k=1,kx m1(i,j) = m1(i,j) + & - (SQ_micro(i,j,k) + SL_micro(i,j,k) + SI_micro(i,j,k))* & + (SQ_micro(i,j,k) + SL_micro(i,j,k) + SI_micro(i,j,k) + SR_micro(i,j,k) + SS_micro(i,j,k) )* & dtcloud*Atmos_state%delp(i,j,k)/grav end do m2(i,j) = 1.e3*Precip_state%surfrain(i,j)*dtcloud @@ -1464,9 +1576,7 @@ subroutine adjust_precip_fields ( & end subroutine adjust_precip_fields - - -!######################################################################### +!######################################################################## subroutine adjust_for_supersaturation_removal ( & ix, jx, kx, C2ls_mp, Input_mp, Atmos_state, & @@ -1534,7 +1644,7 @@ subroutine adjust_for_supersaturation_removal ( & ! proportional to the cloud area increase. save the incremental ! increase due to removing superstauration as diagnostics. !----------------------------------------------------------------------- - if (dqa_activation) then + ! if (dqa_activation) then ! h1g, 2020-03-19 if (ssat_disposal(i,j,k) == 2.) then Cloud_state%SNi_out(i,j,k) = & Cloud_state%SNi_out(i,j,k) + & @@ -1563,7 +1673,7 @@ subroutine adjust_for_supersaturation_removal ( & (1. - Cloud_state%qa_upd(i,j,k) - tmp2s(i,j,k))/ & dtcloud endif - end if ! dqa_activation + ! end if ! dqa_activation ! h1g, 2020-03-19 if (max(Lsdiag_mp_control%diag_id%qadt_super, & Lsdiag_mp_control%diag_id%qa_super_col) > 0) then Lsdiag_mp%diag_4d(i,j,k, & @@ -1618,7 +1728,7 @@ subroutine destroy_tiny_clouds ( & real, dimension (ix,jx,kx) :: ql_new, qi_new, qn_new, qni_new, & qa_new integer :: i,j,k - + real, dimension (ix,jx,kx) :: qr_new, qnr_new, qs_new, qns_new !----------------------------------------------------------------------- ! define current cloud and particle values. @@ -1628,6 +1738,10 @@ subroutine destroy_tiny_clouds ( & qn_new = Cloud_state%qn_in + Cloud_state%SN_out qni_new = Cloud_state%qni_in + Cloud_state%SNi_out + qr_new = Cloud_state%qr_in + Cloud_state%SR_out + qnr_new = Cloud_state%qnr_in + Cloud_state%SNR_out + qs_new = Cloud_state%qs_in + Cloud_state%SS_out + qns_new = Cloud_state%qns_in + Cloud_state%SNS_out !----------------------------------------------------------------------- ! if these values are lower than acceptable, or if the new cloud area ! is lower than acceptable, set the tendency to balance the input value, @@ -1697,6 +1811,8 @@ subroutine destroy_tiny_clouds ( & !----------------------------------------------------------------------- ! redefine the new cloud tracer values. !----------------------------------------------------------------------- + + if ( do_cleanup ) then ! --> h1g, 20200317 ql_new = Cloud_state%ql_in + Cloud_state%SL_out qi_new = Cloud_state%qi_in + Cloud_state%SI_out qn_new = Cloud_state%qn_in + Cloud_state%SN_out @@ -1840,6 +1956,7 @@ subroutine destroy_tiny_clouds ( & end do end do + endif ! do_cleanup --> h1g 20200317 !---------------------------------------------------------------------- ! make sure the new cloud area is not smaller than the minimum ! allowable. if not set the tendency so that cloud area is reduced to @@ -1873,7 +1990,7 @@ subroutine destroy_tiny_clouds ( & ! microphysics, as part of the destruction diagnostic. !------------------------------------------------------------------------ if (do_mg_ncar_microphys .or. do_ncar_microphys .or. & - do_mg_microphys) then + do_mg_microphys .or. do_ncar_MG2 ) then if (Lsdiag_mp_control%diag_id%qadt_limits + & Lsdiag_mp_control%diag_id%qa_limits_col > 0) & Lsdiag_mp%diag_4d(:,:,:,Lsdiag_mp_control%diag_pt%qadt_limits) = & @@ -1891,9 +2008,69 @@ subroutine destroy_tiny_clouds ( & inv_dtcloud endif -!----------------------------------------------------------------------- - +! rain destruction + if ( do_ncar_MG2 ) then + do k=1,kx + do j=1,jx + do i=1,ix + if ( qr_new(i,j,k) <= qmin .or. qnr_new(i,j,k) <= qmin ) then + Cloud_state%SR_out(i,j,k) = Cloud_state%SR_out(i,j,k) - & + qr_new(i,j,k) + Cloud_state%SNR_out(i,j,k) = Cloud_state%SNR_out(i,j,k) - & + qnr_new(i,j,k) + + Tend_mp%qtnd(i,j,k) = Tend_mp%qtnd(i,j,k) + qr_new(i,j,k) + Tend_mp%ttnd(i,j,k) = Tend_mp%ttnd(i,j,k) - (hlv*qr_new(i,j,k))/cp_air + + if (Lsdiag_mp_control%diag_id%qrdt_destr > 0 .or. & + Lsdiag_mp_control%diag_id%qr_destr_col > 0) & + Lsdiag_mp%diag_4d(i,j,k,Lsdiag_mp_control%diag_pt%qrdt_destr) = & + - qr_new(i,j,k)/dtcloud + if (Lsdiag_mp_control%diag_id%qnrdt_destr > 0 .or. & + Lsdiag_mp_control%diag_id%qnr_destr_col > 0) & + Lsdiag_mp%diag_4d(i,j,k,Lsdiag_mp_control%diag_pt%qnrdt_destr) = & + - qnr_new(i,j,k)/dtcloud + if (Lsdiag_mp_control%diag_id%qdt_destr + & + Lsdiag_mp_control%diag_id%q_destr_col > 0) & + Lsdiag_mp%diag_4d(i,j,k,Lsdiag_mp_control%diag_pt%qdt_destr) = & + Lsdiag_mp%diag_4d(i,j,k,Lsdiag_mp_control%diag_pt%qdt_destr) + & + qr_new(i,j,k)/dtcloud + endif + enddo + enddo + enddo +! snow destruction + do k=1,kx + do j=1,jx + do i=1,ix + if ( qs_new(i,j,k) <= qmin .or. qns_new(i,j,k) <= qmin) then + Cloud_state%SS_out(i,j,k) = Cloud_state%SS_out(i,j,k) - & + qs_new(i,j,k) + Cloud_state%SNS_out(i,j,k) = Cloud_state%SNS_out(i,j,k) - & + qns_new(i,j,k) + Tend_mp%qtnd(i,j,k) = Tend_mp%qtnd(i,j,k) + qs_new(i,j,k) + Tend_mp%ttnd(i,j,k) = Tend_mp%ttnd(i,j,k) - (hls*qs_new(i,j,k))/cp_air + + if (Lsdiag_mp_control%diag_id%qsdt_destr > 0 .or. & + Lsdiag_mp_control%diag_id%qs_destr_col > 0) & + Lsdiag_mp%diag_4d(i,j,k,Lsdiag_mp_control%diag_pt%qsdt_destr) = & + - qs_new(i,j,k)/dtcloud + if (Lsdiag_mp_control%diag_id%qnsdt_destr > 0 .or. & + Lsdiag_mp_control%diag_id%qns_destr_col > 0) & + Lsdiag_mp%diag_4d(i,j,k,Lsdiag_mp_control%diag_pt%qnsdt_destr) = & + - qns_new(i,j,k)/dtcloud + if (Lsdiag_mp_control%diag_id%qdt_destr + & + Lsdiag_mp_control%diag_id%q_destr_col > 0) & + Lsdiag_mp%diag_4d(i,j,k,Lsdiag_mp_control%diag_pt%qdt_destr) = & + Lsdiag_mp%diag_4d(i,j,k,Lsdiag_mp_control%diag_pt%qdt_destr) + & + qs_new(i,j,k)/dtcloud + endif + enddo + enddo + enddo + endif ! do_ncar_MG2 +!----------------------------------------------------------------------- end subroutine destroy_tiny_clouds diff --git a/atmos_param/microphysics/micro_mg2.F90 b/atmos_param/microphysics/micro_mg2.F90 new file mode 100644 index 00000000..037c8483 --- /dev/null +++ b/atmos_param/microphysics/micro_mg2.F90 @@ -0,0 +1,4294 @@ + +#define GFDL_COMPATIBLE_MICROP + +module micro_mg2_mod + +! this is ncar routine micro_mg2 + +!--------------------------------------------------------------------------------- +! Purpose: +! MG microphysics version 2, prognostic precipitation. +! point for the development of MG2 +! +! Author: Andrew Gettelman, Hugh Morrison. +! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan +!! +! NOTE: If do_cldice is false, then MG microphysics should not update CLDICE +! or NUMICE; however, it is assumed that the other microphysics scheme will have +! updated CLDICE and NUMICE. The other microphysics should handle the following +! processes that would have been done by MG: +! - Detrainment (liquid and ice) +! - Homogeneous ice nucleation +! - Heterogeneous ice nucleation +! - Bergeron process +! - Melting of ice +! - Freezing of cloud drops +! - Autoconversion (ice -> snow) +! - Growth/Sublimation of ice +! - Sedimentation of ice +!--------------------------------------------------------------------------------- +! Based on micro_mg (restructuring of former cldwat2m_micro) +! Author: Andrew Gettelman, Hugh Morrison. +! Contributions from: Xiaohong Liu and Steve Ghan +! December 2005-May 2010 +! Description in: Morrison and Gettelman, 2008. J. Climate (MG2008) +! Gettelman et al., 2010 J. Geophys. Res. - Atmospheres (G2010) +! for questions contact Hugh Morrison, Andrew Gettelman +! e-mail: morrison@ucar.edu, andrew@ucar.edu +!--------------------------------------------------------------------------------- + +!-------------------------------------------------------------------------- +! Interfaces, diagnostics, used modules, constants modified for use in GFDL +! based models +! Huan Guo +!-------------------------------------------------------------------------- + +! Code comments added by HM, 093011 +! General code structure: +! +! Code is divided into two main subroutines: +! subroutine micro_mg_init --> initializes microphysics routine, should be called +! once at start of simulation +! subroutine micro_mg_tend --> main microphysics routine to be called each time step +! +! List of external functions: +! qsat_water --> for calculating saturation vapor pressure with respect to liquid water +! qsat_ice --> for calculating saturation vapor pressure with respect to ice +! gamma --> standard mathematical gamma function +! ......................................................................... +! List of inputs through use statement in fortran90: +! Variable Name Description Units +! ......................................................................... +! gravit acceleration due to gravity m s-2 +! rair dry air gas constant for air J kg-1 K-1 +! tmelt temperature of melting point for water K +! cpair specific heat at constant pressure for dry air J kg-1 K-1 +! rh2o gas constant for water vapor J kg-1 K-1 +! latvap latent heat of vaporization J kg-1 +! latice latent heat of fusion J kg-1 +! qsat_water external function for calculating liquid water +! saturation vapor pressure/humidity - +! qsat_ice external function for calculating ice +! saturation vapor pressure/humidity pa +! rhmini relative humidity threshold parameter for +! nucleating ice - +! ......................................................................... +! NOTE: List of all inputs/outputs passed through the call/subroutine statement +! for micro_mg_tend is given below at the start of subroutine micro_mg_tend. +!--------------------------------------------------------------------------------- + +! Procedures required: +! 1) An implementation of the gamma function (if not intrinsic). +! 2) saturation vapor pressure and specific humidity over water +! 3) svp over ice + +#ifdef GFDL_COMPATIBLE_MICROP +use gamma_mg_mod, only: gamma =>gamma_mg +use lscloud_types_mod, only: diag_id_type, diag_pt_type + +use mpp_mod, only: input_nml_file +use fms_mod, only: mpp_pe, file_exist, error_mesg, & + open_namelist_file, FATAL, & + stdlog, write_version_number, & + check_nml_error, close_file, & + mpp_root_pe, mpp_chksum +!use simple_pdf_mod, only: simple_pdf +use sat_vapor_pres_mod, only: lookup_es2, lookup_es3, compute_qs +use physics_radiation_exch_mod, only : exchange_control_type + +#endif + +! Parameters from the utilities module. +use micro_mg2_utils, only: & + r8, & + pi, & + omsm, & + qsmall, & + mincld, & + rhosn, & + rhoi, & + rhow, & + rhows, & + ac, bc, & + ai, bi, & + aj, bj, & + ar, br, & + as, bs, & + mi0, & + rising_factorial + +! Constituent properties. +use micro_mg2_utils, only: & + mg_liq_props, & + mg_ice_props, & + mg_rain_props, & + mg_snow_props + +! Size calculation functions. +use micro_mg2_utils, only: & + size_dist_param_liq, & + size_dist_param_basic, & + avg_diameter + + +use micro_mg2_utils, only: & + micro_mg_utils_init, & + size_dist_param_liq, & + size_dist_param_basic, & + avg_diameter, & + rising_factorial, & + ice_deposition_sublimation, & + sb2001v2_liq_autoconversion,& + sb2001v2_accre_cld_water_rain,& + kk2000_liq_autoconversion, & + ice_autoconversion, & + immersion_freezing, & + contact_freezing, & + snow_self_aggregation, & + accrete_cloud_water_snow, & + secondary_ice_production, & + accrete_rain_snow, & + heterogeneous_rain_freezing, & + accrete_cloud_water_rain, & + self_collection_rain, & + accrete_cloud_ice_snow, & + evaporate_sublimate_precip, & + bergeron_process_snow, & ! h1g, 2020-03-23 + cotton_liq_autoconversion ! h1g, 2020-03-23 + + +implicit none +private +save + +public :: & + micro_mg2_init, & + micro_mg2_get_cols, & + micro_mg2_tend + +!------------------------------------------------------------------------ +!--version number-------------------------------------------------------- + +character(len=128) :: Version = '$Id: micro_mg2.F90,v 1.1.2.2.2.1 2017/01/23 14:50:42 Huan.Guo Exp $' +character(len=128) :: Tagname = '$Name: $' + +!========================================================= +! Constants set in initialization +!========================================================= + +! Set using arguments to micro_mg_init +real(r8) :: g ! gravity +real(r8) :: r ! dry air gas constant +real(r8) :: rv ! water vapor gas constant +real(r8) :: cpp ! specific heat of dry air +real(r8) :: tmelt ! freezing point of water (K) + +! latent heats of: +real(r8) :: xxlv ! vaporization +real(r8) :: xlf ! freezing +real(r8) :: xxls ! sublimation + +real(r8) :: rhosu ! typical 850mn air density + +real(r8) :: icenuct ! ice nucleation temperature: currently -5 degrees C + +real(r8) :: snowmelt ! what temp to melt all snow: currently 2 degrees C +real(r8) :: rainfrze ! what temp to freeze all rain: currently -5 degrees C + +real :: dcs !autoconversion size threshold +logical :: rho_factor_in_max_vt = .true. +real :: max_rho_factor_in_vt = 1.0 + +! switch for specification rather than prediction of droplet and crystal number +! note: number will be adjusted as needed to keep mean size within bounds, +! even when specified droplet or ice number is used + +! ***note: Even if constant cloud ice number is set, ice number is allowed +! to evolve based on process rates. This is needed in order to calculate +! the change in mass due to ice nucleation. All other ice microphysical +! processes are consistent with the specified constant ice number if +! this switch is turned on. + +! nccons = .true. to specify constant cloud droplet number +! nicons = .true. to specify constant cloud ice number + +logical :: nccons = .false. +logical :: nicons = .false. + +! parameters for specified ice and droplet number concentration +! note: these are local in-cloud values, not grid-mean +real(r8) :: ncnst = 100.e6_r8 ! droplet num concentration when + ! nccons=.true. (m-3) +real(r8) :: ninst = 0.1e6_r8 ! ice num concentration when + ! nicons=.true. (m-3) +! <---h1g, 2012-06-12 +logical :: liu_in = .false. + ! True = Liu et al 2007 Ice nucleation + ! False = cooper fixed ice nucleation (MG2008) + +logical :: use_Meyers = .false. +! Ni (/m3) = 1000 * exp( (12.96* [(esl-esi)/esi]) - 0.639 ) +! Figure 9.3 of Rogers and Yau (1998) shows the nearly linear +! variation of [(esl-esi)/esi] from 0. at 273.16K to 0.5 at +! 233.16K. Analytically this is parameterized as (tfreeze-T)/80. +! +! Ni (/m3) = 1000 * exp( 12.96* (tfreeze-T)/80 - 0.639 ) + +logical :: use_Fan2019 = .false. +real(r8) :: Nice_max_Fan = 40.0 + +!---> h1g, 2014-05-19 +real :: tc_cooper = -35.0 +real :: IceFallFac = 1.0 +real :: SnowFallFac = 1.0 +logical :: include_contact_freeze_in_berg = .false. + +character(len=16) :: micro_mg_precip_frac_method = "max_overlap" ! type of precipitation fraction method +real(r8) :: micro_mg_bergs_eff_factor = 1.0_r8 ! bergs efficiency factor (liquid to snow) +real(r8) :: micro_mg_berg_eff_factor = 1.0_r8 ! berg efficiency factor (liquid to ice) + +logical :: allow_sed_supersat = .true. ! Allow supersaturated conditions after sedimentation loop + +logical :: do_sb_physics = .false. +logical :: use_hetfrz_classnuc = .false. +real :: tau_act_liq = 1800.0 +real :: tau_act_ice = 900.0 +real :: tc_act = -35.0 + +logical :: allow_rain_num_evap = .false. +logical :: allow_snow_num_sublimation = .false. + +logical :: no_evap_in_sedimentation = .false. +real(r8) :: vfactor = 1.0 +real(r8) :: vfac_drop = 1.0 ! h1g, 2020-06-18 +real(r8) :: vfac_ice = 1.0 ! h1g, 2020-06-18 + +real(r8) :: icld_cri = -0.2 ! h1g, 2020-07-02 +real(r8) :: evap_subl_fac = 1.0 ! h1g, 2020-07-06 + +real(r8) :: ice_sublim_factor = 1.0 ! h1g, 2020-07-16 + +! minimum mass of new crystal due to freezing of cloud droplets done +! externally (kg) +real(r8), parameter :: mi0l_min = 4._r8/3._r8*pi*rhow*(4.e-6_r8)**3 + +real :: rhmini=0.80 ! minimum rh for ice cld fraction > 0 +logical :: microp_uniform = .false. + ! .true. = configure uniform for + ! sub-columns + ! .false. = use w/o sub-columns + ! (default) +logical :: do_cldice = .true. + ! .true. = do all processes (default) + ! .false. = skip all processes + ! affecting cloud ice +logical :: do_ice_nucl_wpdf +logical :: clubb_active +logical :: do_Ni_linear_interp = .false. +logical :: do_implicit_fall = .false. + + +logical :: do_qc_implicit_fall = .true. +logical :: do_qi_implicit_fall = .true. +logical :: do_qr_implicit_fall = .true. +logical :: do_qs_implicit_fall = .true. + + +! additional constants to help speed up code +real(r8) :: gamma_br_plus1 +real(r8) :: gamma_br_plus4 +real(r8) :: gamma_bs_plus1 +real(r8) :: gamma_bs_plus4 +real(r8) :: gamma_bi_plus1 +real(r8) :: gamma_bi_plus4 +real(r8) :: gamma_bj_plus1 +real(r8) :: gamma_bj_plus4 +real(r8) :: xxlv_squared +real(r8) :: xxls_squared +!<--- h1g, 2014-05-19 + +real(r8) :: dum_5, dum_30, dum_tmp +integer :: iter = 1 +logical :: do_liq_num_adjust = .true. +logical :: do_liq_num_riming = .true. +logical :: do_liq_num_ihom = .true. ! h1g, 2020-06-22 +logical :: do_ice_num_adjust = .true. ! h1g, 2020-07-01 + +logical :: do_cotton_auto = .false. +real(r8) :: rthresh = 8.6 +logical :: do_HM_splinter = .true. +logical :: remove_super_RK = .false. +logical :: use_const_ELI = .false. ! --> h1g, 2020-04-16 +real(r8) :: ELI_RK = 0.7 ! --> h1g, 2020-04-16 +logical :: use_FanAndCooper = .false. ! --> h1g, 2020-04-18 +real(r8) :: sublim_factor = 0.0 +real(r8) :: ice_nucl_factor = 1.0 + +namelist / micro_mg2_nml / & + max_rho_factor_in_vt, & + rho_factor_in_max_vt, & + nccons, ncnst, & ! cjg + nicons, ninst, & ! cjg + liu_in, & ! h1g + use_Meyers, tc_cooper, & !h1g + IceFallFac, SnowFallFac, & !h1g + include_contact_freeze_in_berg, & !h1g + do_sb_physics, allow_sed_supersat, & ! h1g + use_hetfrz_classnuc, micro_mg_precip_frac_method, micro_mg_berg_eff_factor, & + tau_act_liq, tau_act_ice, tc_act, allow_rain_num_evap, allow_snow_num_sublimation, & + rhmini, microp_uniform, do_cldice, do_Ni_linear_interp, & + do_implicit_fall, vfactor, no_evap_in_sedimentation, iter, & + use_Fan2019, Nice_max_Fan, & + do_qc_implicit_fall, do_qi_implicit_fall, do_qr_implicit_fall, do_qs_implicit_fall, & + do_liq_num_adjust, do_liq_num_riming, do_cotton_auto, rthresh, do_HM_splinter, & ! h1g, 2020-03-06 + remove_super_RK, use_const_ELI, ELI_RK, use_FanAndCooper, sublim_factor, & ! h1g, 2020-04-18 + ice_nucl_factor, vfac_drop, vfac_ice, do_liq_num_ihom, micro_mg_bergs_eff_factor, & ! h1g, 2020-06-22 + do_ice_num_adjust, icld_cri, evap_subl_fac, ice_sublim_factor ! h1g, 2020-07-06 + +!=============================================================================== +contains +!=============================================================================== + +subroutine micro_mg2_init( & + kind, gravit, rair, rh2o, cpair, & + tmelt_in, latvap, latice, & + ! rhmini_in, microp_uniform_in, do_cldice_in, & + do_ice_nucl_wpdf_in, errstring, Exch_ctrl) + + !----------------------------------------------------------------------- + ! + ! Purpose: + ! initialize constants for MG microphysics + ! + ! Author: Andrew Gettelman Dec 2005 + ! + !----------------------------------------------------------------------- + + integer, intent(in) :: kind ! Kind used for reals + real(r8), intent(in) :: gravit + real(r8), intent(in) :: rair + real(r8), intent(in) :: rh2o + real(r8), intent(in) :: cpair + real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) + real(r8), intent(in) :: latvap + real(r8), intent(in) :: latice + + logical, intent(in) :: do_ice_nucl_wpdf_in + type(exchange_control_type), intent(in) :: Exch_ctrl + + character(128), intent(out) :: errstring ! Output status (non-blank for error return) + + INTEGER :: unit, io, ierr, logunit + + !----------------------------------------------------------------------- + + dcs = Exch_ctrl%dcs + call micro_mg_utils_init(kind, rh2o, cpair, tmelt_in, latvap, latice, & + dcs, errstring) + + errstring = ' ' + + if( kind .ne. r8 ) then + errstring = 'micro_mg2_init: KIND of reals does not match' + return + endif + + ! declarations for MG code (transforms variable names) + + g= gravit ! gravity + r= rair ! dry air gas constant: note units(phys_constants are in J/K/kmol) + rv= rh2o ! water vapor gas constant + cpp = cpair ! specific heat of dry air + tmelt = tmelt_in + +! latent heats + xxlv = latvap ! latent heat vaporization + xlf = latice ! latent heat freezing + xxls = xxlv + xlf ! latent heat of sublimation + +!--------------------------------------------------------------- +! process namelist +!--------------------------------------------------------------- +#ifdef INTERNAL_FILE_NML + read (input_nml_file, nml=micro_mg2_nml, iostat=io) + ierr = check_nml_error(io,'micro_mg2_nml') +#else + if ( file_exist('input.nml')) then + unit = open_namelist_file () + ierr=1; do while (ierr /= 0) + read (unit, nml=micro_mg2_nml, iostat=io, end=10) + ierr = check_nml_error(io,'micro_mg2_nml') + enddo +10 call close_file (unit) + endif +#endif + +!----------------------------------------------------------------------- +! write version and namelist to stdlog. +!----------------------------------------------------------------------- + call write_version_number (version, tagname) + logunit = stdlog() + if (mpp_pe() == mpp_root_pe()) & + write (logunit, nml=micro_mg2_nml) + + do_ice_nucl_wpdf = do_ice_nucl_wpdf_in + clubb_active=(Exch_ctrl%do_clubb>0) + + ! typical air density at 850 mb + rhosu = 85000._r8/(rair * tmelt) + + ! Maximum temperature at which snow is allowed to exist + snowmelt = tmelt + 2._r8 + ! Minimum temperature at which rain is allowed to exist + rainfrze = tmelt - 40._r8 + + ! Ice nucleation temperature + icenuct = tmelt - 5._r8 + + ! Define constants to help speed up code (this limits calls to gamma function) + gamma_br_plus1=gamma(1._r8+br) + gamma_br_plus4=gamma(4._r8+br) + gamma_bs_plus1=gamma(1._r8+bs) + gamma_bs_plus4=gamma(4._r8+bs) + gamma_bi_plus1=gamma(1._r8+bi) + gamma_bi_plus4=gamma(4._r8+bi) + gamma_bj_plus1=gamma(1._r8+bj) + gamma_bj_plus4=gamma(4._r8+bj) + + xxlv_squared=xxlv**2 + xxls_squared=xxls**2 + +end subroutine micro_mg2_init + +!=============================================================================== +!microphysics routine for each timestep goes here... +subroutine micro_mg2_tend ( lon, lat, & + dqa_activation, total_activation, tiedtke_macrophysics, & + j, jdim, & + mgncol, nlev, deltatin, & + concen_dust_sub, & + tn, qn, & + qcn, qin, & + ncn, nin, & + qrn, qsn, & + nrn, nsn, & + relvar, accre_enhan, & + p, pdel, zhalf, & + cldn, liqcldf, icecldf, & + delta_cf, D_eros_l, nerosc, D_eros_i, nerosi, dqcdt, dqidt, & + naai, npccn, & + rndst, nacon, & + tlat, qvlat, & + qctend, qitend, & + nctend, nitend, & + qrtend, qstend, & + nrtend, nstend, & + prect, preci, & + qsout, rflx, sflx, & + qrout, reff_rain, reff_snow, & + errstring, & + f_snow_berg, ssat_disposal, & + n_diag_4d, diag_4l, diag_id, diag_pt) + + + ! input arguments + real(r8), intent(in) :: lon(mgncol), lat(mgncol) + + logical, intent (in) :: dqa_activation + logical, intent (in) :: total_activation + logical, intent (in) :: tiedtke_macrophysics + integer, intent(in) :: j, jdim + integer, intent(in) :: mgncol ! number of microphysics columns + integer, intent(in) :: nlev ! number of layers + real(r8), intent(in) :: deltatin ! time step (s) + + real(r8), intent(in) :: concen_dust_sub(mgncol,nlev) ! sub-micro dust aerosol concentration (ug/m3) + + real(r8), intent(in) :: tn(mgncol,nlev) ! input temperature (K) + real(r8), intent(in) :: qn(mgncol,nlev) ! input h20 vapor mixing ratio (kg/kg) + real(r8), intent(in) :: relvar(mgncol,nlev) ! relative variance of cloud water (-) + real(r8), intent(in) :: accre_enhan(mgncol,nlev) ! optional accretion enhancement factor (-) + + ! note: all input cloud variables are grid-averaged + real(r8), intent(in) :: qcn(mgncol,nlev) ! cloud water mixing ratio (kg/kg) + real(r8), intent(in) :: qin(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) + real(r8), intent(in) :: ncn(mgncol,nlev) ! cloud water number conc (1/kg) + real(r8), intent(in) :: nin(mgncol,nlev) ! cloud ice number conc (1/kg) + + real(r8), intent(in) :: qrn(mgncol,nlev) ! rain mixing ratio (kg/kg) + real(r8), intent(in) :: qsn(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8), intent(in) :: nrn(mgncol,nlev) ! rain number conc (1/kg) + real(r8), intent(in) :: nsn(mgncol,nlev) ! snow number conc (1/kg) + + real(r8), intent(in) :: p(mgncol,nlev) ! air pressure (pa) + real(r8), intent(in) :: pdel(mgncol,nlev) ! pressure difference across level (pa) + + real(r8), intent(in) :: zhalf(mgncol,nlev+1) ! half-pressure level height (m) + ! hm add 11-16-11, interface pressure + + real(r8), intent(in) :: cldn(mgncol,nlev) ! cloud fraction (no units) + real(r8), intent(in) :: liqcldf(mgncol,nlev) ! liquid cloud fraction (no units) + real(r8), intent(in) :: icecldf(mgncol,nlev) ! ice cloud fraction (no units) + + + real(r8), intent(in) :: delta_cf(mgncol,nlev) + real(r8), intent(inout) :: D_eros_l(mgncol,nlev) + real(r8), intent(inout) :: nerosc(mgncol,nlev) + real(r8), intent(inout) :: D_eros_i(mgncol,nlev) + real(r8), intent(inout) :: nerosi(mgncol,nlev) + real(r8), intent(inout) :: dqcdt(mgncol,nlev) + real(r8), intent(inout) :: dqidt(mgncol,nlev) + + ! used for scavenging + ! Inputs for aerosol activation + real(r8), intent(inout) :: naai(mgncol,nlev) ! ice nucleation number (from microp_aero_ts) (1/kg) + real(r8), intent(in) :: npccn(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) + + ! Note that for these variables, the dust bin is assumed to be the last index. + ! (For example, in CAM, the last dimension is always size 4.) + real(r8), intent(in) :: rndst(:,:,:) ! radius of each dust bin, for contact freezing (from microp_aero_ts) (m) + real(r8), intent(in) :: nacon(:,:,:) ! number in each dust bin, for contact freezing (from microp_aero_ts) (1/m^3) + + ! output arguments + ! direct cw to precip conversion + real(r8), intent(out) :: tlat(mgncol,nlev) ! latent heating rate (W/kg) + real(r8), intent(out) :: qvlat(mgncol,nlev) ! microphysical tendency qv (1/s) + real(r8), intent(out) :: qctend(mgncol,nlev) ! microphysical tendency qc (1/s) + real(r8), intent(out) :: qitend(mgncol,nlev) ! microphysical tendency qi (1/s) + real(r8), intent(out) :: nctend(mgncol,nlev) ! microphysical tendency nc (1/(kg*s)) + real(r8), intent(out) :: nitend(mgncol,nlev) ! microphysical tendency ni (1/(kg*s)) + + real(r8), intent(out) :: qrtend(mgncol,nlev) ! microphysical tendency qr (1/s) + real(r8), intent(out) :: qstend(mgncol,nlev) ! microphysical tendency qs (1/s) + real(r8), intent(out) :: nrtend(mgncol,nlev) ! microphysical tendency nr (1/(kg*s)) + real(r8), intent(out) :: nstend(mgncol,nlev) ! microphysical tendency ns (1/(kg*s)) + + + real(r8), intent(out) :: prect(mgncol) ! surface precip rate (m/s) + real(r8), intent(out) :: preci(mgncol) ! cloud ice/snow precip rate (m/s) + + + real(r8), intent(out) :: qsout(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8), intent(out) :: rflx(mgncol,nlev+1) ! grid-box average rain flux (kg m^-2 s^-1) + real(r8), intent(out) :: sflx(mgncol,nlev+1) ! grid-box average snow flux (kg m^-2 s^-1) + real(r8), intent(out) :: qrout(mgncol,nlev) ! grid-box average rain mixing ratio (kg/kg) + real(r8), intent(out) :: reff_rain(mgncol,nlev) ! rain effective radius (micron) + real(r8), intent(out) :: reff_snow(mgncol,nlev) ! snow effective radius (micron) + + character(128), intent(out) :: errstring ! output status (non-blank for error return) + real(r8), intent(out) :: f_snow_berg (mgncol,nlev) ! ratio of bergeron + ! production of qi to + ! sum of bergeron, + ! riming and freezing + real(r8), intent(out) :: ssat_disposal(mgncol,nlev) + ! disposition of supersaturation at end + ! of step; 0.= no ssat, 1.= liq, 2.=ice) + INTEGER,INTENT(IN) :: n_diag_4d + REAL, dimension( mgncol,jdim, nlev, 0:n_diag_4d ), INTENT(INOUT) :: diag_4l + TYPE(diag_id_type),INTENT(IN) :: diag_id + TYPE(diag_pt_type),INTENT(INout) :: diag_pt + + +!--> h1g, 2019-12-05 + ! temporary variables for sub-stepping + real(r8) :: tlat1(mgncol,nlev) + real(r8) :: qvlat1(mgncol,nlev) + real(r8) :: qctend1(mgncol,nlev) + real(r8) :: qitend1(mgncol,nlev) + real(r8) :: nctend1(mgncol,nlev) + real(r8) :: nitend1(mgncol,nlev) + real(r8) :: qrtend1(mgncol,nlev) + real(r8) :: qstend1(mgncol,nlev) + real(r8) :: nrtend1(mgncol,nlev) + real(r8) :: nstend1(mgncol,nlev) +!<-- h1g, 2019-12-05 + + ! local workspace + ! all units mks unless otherwise stated + + ! local copies of input variables + real(r8) :: q(mgncol,nlev) ! water vapor mixing ratio (kg/kg) + real(r8) :: t(mgncol,nlev) ! temperature (K) + real(r8) :: qc(mgncol,nlev) ! cloud liquid mixing ratio (kg/kg) + real(r8) :: qi(mgncol,nlev) ! cloud ice mixing ratio (kg/kg) + real(r8) :: nc(mgncol,nlev) ! cloud liquid number concentration (1/kg) + real(r8) :: ni(mgncol,nlev) ! cloud liquid number concentration (1/kg) + real(r8) :: qr(mgncol,nlev) ! rain mixing ratio (kg/kg) + real(r8) :: qs(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8) :: nr(mgncol,nlev) ! rain number concentration (1/kg) + real(r8) :: ns(mgncol,nlev) ! snow number concentration (1/kg) + +!--> h1g, 2019-12-06 +! temporary copies of snow and rain variables + real(r8) :: qrtmp(mgncol,nlev) ! rain mixing ratio (kg/kg) + real(r8) :: qstmp(mgncol,nlev) ! snow mixing ratio (kg/kg) + real(r8) :: nrtmp(mgncol,nlev) ! rain number concentration (1/kg) + real(r8) :: nstmp(mgncol,nlev) ! snow number concentration (1/kg) +!<-- h1g, 2019-12-06 + + ! general purpose variables + real(r8) :: deltat ! sub-time step (s) + real(r8) :: mtime ! the assumed ice nucleation timescale + + ! physical properties of the air at a given point + real(r8) :: rho(mgncol,nlev) ! density (kg m-3) + real(r8) :: dv(mgncol,nlev) ! diffusivity of water vapor + real(r8) :: mu(mgncol,nlev) ! viscosity + real(r8) :: sc(mgncol,nlev) ! schmidt number + real(r8) :: rhof(mgncol,nlev) ! density correction factor for fallspeed + + + ! cloud fractions + real(r8) :: precip_frac(mgncol,nlev) ! precip fraction assuming maximum overlap + real(r8) :: cldm(mgncol,nlev) ! cloud fraction + real(r8) :: icldm(mgncol,nlev) ! ice cloud fraction + real(r8) :: lcldm(mgncol,nlev) ! liq cloud fraction + real(r8) :: qsfm(mgncol,nlev) ! subgrid cloud water saturation scaling factor + + ! mass mixing ratios + real(r8) :: qcic(mgncol,nlev) ! in-cloud cloud liquid + real(r8) :: qiic(mgncol,nlev) ! in-cloud cloud ice + real(r8) :: qsic(mgncol,nlev) ! in-precip snow + real(r8) :: qric(mgncol,nlev) ! in-precip rain + + ! number concentrations + real(r8) :: ncic(mgncol,nlev) ! in-cloud droplet + real(r8) :: niic(mgncol,nlev) ! in-cloud cloud ice + real(r8) :: nsic(mgncol,nlev) ! in-precip snow + real(r8) :: nric(mgncol,nlev) ! in-precip rain + ! maximum allowed ni value + real(r8) :: nimax(mgncol,nlev) + + ! Size distribution parameters for: + ! cloud ice + real(r8) :: lami(mgncol,nlev) ! slope + real(r8) :: n0i(mgncol,nlev) ! intercept + ! cloud liquid + real(r8) :: lamc(mgncol,nlev) ! slope + real(r8) :: pgam(mgncol,nlev) ! spectral width parameter + ! snow + real(r8) :: lams(mgncol,nlev) ! slope + real(r8) :: n0s(mgncol,nlev) ! intercept + ! rain + real(r8) :: lamr(mgncol,nlev) ! slope + real(r8) :: n0r(mgncol,nlev) ! intercept + + ! Rates/tendencies due to: + + ! Instantaneous snow melting + real(r8) :: minstsm(mgncol,nlev) ! mass mixing ratio + real(r8) :: ninstsm(mgncol,nlev) ! number concentration + ! Instantaneous rain freezing + real(r8) :: minstrf(mgncol,nlev) ! mass mixing ratio + real(r8) :: ninstrf(mgncol,nlev) ! number concentration + + ! deposition of cloud ice + real(r8) :: vap_dep(mgncol,nlev) ! deposition from vapor to ice PMC 12/3/12 + ! sublimation of cloud ice + real(r8) :: ice_sublim(mgncol,nlev) ! sublimation from ice to vapor PMC 12/3/12 + ! ice nucleation + real(r8) :: nnuccd(mgncol,nlev) ! number rate from deposition/cond.-freezing + real(r8) :: mnuccd(mgncol,nlev) ! mass mixing ratio + ! freezing of cloud water + real(r8) :: mnuccc(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnuccc(mgncol,nlev) ! number concentration + ! contact freezing of cloud water + real(r8) :: mnucct(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnucct(mgncol,nlev) ! number concentration + ! deposition nucleation in mixed-phase clouds (from external scheme) + real(r8) :: mnudep(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnudep(mgncol,nlev) ! number concentration + ! ice multiplication + real(r8) :: msacwi(mgncol,nlev) ! mass mixing ratio + real(r8) :: nsacwi(mgncol,nlev) ! number concentration + ! autoconversion of cloud droplets + real(r8) :: prc(mgncol,nlev) ! mass mixing ratio + real(r8) :: nprc(mgncol,nlev) ! number concentration (rain) + real(r8) :: nprc1(mgncol,nlev) ! number concentration (cloud droplets) + ! self-aggregation of snow + real(r8) :: nsagg(mgncol,nlev) ! number concentration + ! self-collection of rain + real(r8) :: nragg(mgncol,nlev) ! number concentration + ! collection of droplets by snow + real(r8) :: psacws(mgncol,nlev) ! mass mixing ratio + real(r8) :: npsacws(mgncol,nlev) ! number concentration + ! collection of rain by snow + real(r8) :: pracs(mgncol,nlev) ! mass mixing ratio + real(r8) :: npracs(mgncol,nlev) ! number concentration + ! freezing of rain + real(r8) :: mnuccr(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnuccr(mgncol,nlev) ! number concentration + ! freezing of rain to form ice (mg add 4/26/13) + real(r8) :: mnuccri(mgncol,nlev) ! mass mixing ratio + real(r8) :: nnuccri(mgncol,nlev) ! number concentration + ! accretion of droplets by rain + real(r8) :: pra(mgncol,nlev) ! mass mixing ratio + real(r8) :: npra(mgncol,nlev) ! number concentration + ! autoconversion of cloud ice to snow + real(r8) :: prci(mgncol,nlev) ! mass mixing ratio + real(r8) :: nprci(mgncol,nlev) ! number concentration + ! accretion of cloud ice by snow + real(r8) :: prai(mgncol,nlev) ! mass mixing ratio + real(r8) :: nprai(mgncol,nlev) ! number concentration + ! evaporation of rain + real(r8) :: pre(mgncol,nlev) ! mass mixing ratio + ! sublimation of snow + real(r8) :: prds(mgncol,nlev) ! mass mixing ratio + ! number evaporation + real(r8) :: nsubi(mgncol,nlev) ! cloud ice + real(r8) :: nsubc(mgncol,nlev) ! droplet + real(r8) :: nsubs(mgncol,nlev) ! snow + real(r8) :: nsubr(mgncol,nlev) ! rain + ! bergeron process + real(r8) :: berg(mgncol,nlev) ! mass mixing ratio (cloud ice) + real(r8) :: bergs(mgncol,nlev) ! mass mixing ratio (snow) + + + ! fallspeeds + ! number-weighted + real(r8) :: uns(mgncol,nlev) ! snow + real(r8) :: unr(mgncol,nlev) ! rain + ! air density corrected fallspeed parameters + real(r8) :: arn(mgncol,nlev) ! rain + real(r8) :: asn(mgncol,nlev) ! snow + real(r8) :: acn(mgncol,nlev) ! cloud droplet + real(r8) :: ain(mgncol,nlev) ! cloud ice + real(r8) :: ajn(mgncol,nlev) ! cloud small ice + + ! Mass of liquid droplets used with external heterogeneous freezing. + real(r8) :: mi0l(mgncol) + + ! saturation vapor pressures + real(r8) :: esl(mgncol,nlev) ! liquid + real(r8) :: esi(mgncol,nlev) ! ice + real(r8) :: esn ! checking for RH after rain evap + + ! saturation vapor mixing ratios + real(r8) :: qvl(mgncol,nlev) ! liquid + real(r8) :: qvi(mgncol,nlev) ! ice + real(r8) :: qvn ! checking for RH after rain evap + + ! relative humidity + real(r8) :: relhum(mgncol,nlev) + + ! parameters for cloud water and cloud ice sedimentation calculations + real(r8) :: fc(mgncol,nlev) + real(r8) :: fnc(mgncol,nlev) + real(r8) :: fi(mgncol,nlev) + real(r8) :: fni(mgncol,nlev) + + real(r8) :: fr(mgncol,nlev) + real(r8) :: fnr(mgncol,nlev) + real(r8) :: fs(mgncol,nlev) + real(r8) :: fns(mgncol,nlev) + + real(r8) :: faloutc(nlev) + real(r8) :: faloutnc(nlev) + real(r8) :: falouti(nlev) + real(r8) :: faloutni(nlev) + + real(r8) :: faloutr(nlev) + real(r8) :: faloutnr(nlev) + real(r8) :: falouts(nlev) + real(r8) :: faloutns(nlev) + + real(r8) :: faltndc + real(r8) :: faltndnc + real(r8) :: faltndi + real(r8) :: faltndni + real(r8) :: faltndqie + real(r8) :: faltndqce + + real(r8) :: faltndr + real(r8) :: faltndnr + real(r8) :: faltnds + real(r8) :: faltndns + + real(r8) :: rainrt(mgncol,nlev) ! rain rate for reflectivity calculation + + ! dummy variables + real(r8) :: dum + real(r8) :: dum1 + real(r8) :: dum2 + real(r8) :: dumni0 + real(r8) :: dumns0 + ! dummies for checking RH + real(r8) :: qtmp + real(r8) :: ttmp + ! dummies for conservation check + real(r8) :: ratio + real(r8) :: tmpfrz + ! dummies for in-cloud variables + real(r8) :: dumc(mgncol,nlev) ! qc + real(r8) :: dumnc(mgncol,nlev) ! nc + real(r8) :: dumi(mgncol,nlev) ! qi + real(r8) :: dumni(mgncol,nlev) ! ni + real(r8) :: dumr(mgncol,nlev) ! rain mixing ratio + real(r8) :: dumnr(mgncol,nlev) ! rain number concentration + real(r8) :: dums(mgncol,nlev) ! snow mixing ratio + real(r8) :: dumns(mgncol,nlev) ! snow number concentration + ! Array dummy variable + real(r8) :: dum_2D(mgncol,nlev) + real(r8) :: pdel_inv(mgncol,nlev) + + ! loop array variables + ! "i" and "k" are column/level iterators for internal (MG) variables + ! "n" is used for other looping (currently just sedimentation) + integer i, k, n, it + + ! number of sub-steps for loops over "n" (for sedimentation) + integer nstep + integer mdust + + ! Varaibles to scale fall velocity between small and regular ice regimes. + real(r8) :: irad + real(r8) :: ifrac + + real(r8) :: tnd_qsnow(mgncol,nlev) ! snow mass tendency (kg/kg/s) + real(r8) :: tnd_nsnow(mgncol,nlev) ! snow number tendency (#/kg/s) + real(r8) :: re_ice(mgncol,nlev) ! ice effective radius (m) + + ! From external ice nucleation. + real(r8) :: frzimm(mgncol,nlev) ! Number tendency due to immersion freezing (1/cm3) + real(r8) :: frzcnt(mgncol,nlev) ! Number tendency due to contact freezing (1/cm3) + real(r8) :: frzdep(mgncol,nlev) ! Number tendency due to deposition nucleation (1/cm3) + + real(r8) :: lflx(mgncol,nlev+1) ! grid-box average liquid condensate flux (kg m^-2 s^-1) + real(r8) :: iflx(mgncol,nlev+1) ! grid-box average ice condensate flux (kg m^-2 s^-1) + + real(r8) :: qcsinksum_rate1ord(mgncol,nlev) ! 1st order rate for direct cw to precip conversion + + real(r8) :: effc(mgncol,nlev) ! droplet effective radius (micron) + real(r8) :: effc_fn(mgncol,nlev) ! droplet effective radius, assuming nc = 1.e8 kg-1 + real(r8) :: effi(mgncol,nlev) ! cloud ice effective radius (micron) + real(r8) :: sadice(mgncol,nlev) ! cloud ice surface area density (cm2/cm3) + real(r8) :: sadsnow(mgncol,nlev) ! cloud snow surface area density (cm2/cm3) + + real(r8) :: nevapr(mgncol,nlev) ! evaporation rate of rain + snow (1/s) + real(r8) :: evapsnow(mgncol,nlev) ! sublimation rate of snow (1/s) + real(r8) :: am_evp_st(mgncol,nlev) ! stratiform evaporation area (frac) + real(r8) :: prain(mgncol,nlev) ! production of rain + snow (1/s) + real(r8) :: prodsnow(mgncol,nlev) ! production of snow (1/s) + real(r8) :: cmeout(mgncol,nlev) ! evap/sub of cloud (1/s) + real(r8) :: deffi(mgncol,nlev) ! ice effective diameter for optics (radiation) (micron) + real(r8) :: pgamrad(mgncol,nlev) ! ice gamma parameter for optics (radiation) (no units) + real(r8) :: lamcrad(mgncol,nlev) ! slope of droplet distribution for optics (radiation) (1/m) + + real(r8) :: dsout(mgncol,nlev) ! snow diameter (m) + + real(r8) :: qcsevap(mgncol,nlev) ! cloud water evaporation due to sedimentation (1/s) + real(r8) :: qisevap(mgncol,nlev) ! cloud ice sublimation due to sublimation (1/s) + real(r8) :: qvres(mgncol,nlev) ! residual condensation term to ensure RH < 100% (1/s) + + real(r8) :: cmeitot(mgncol,nlev) ! grid-mean cloud ice sub/dep (1/s) + real(r8) :: vtrmc(mgncol,nlev) ! mass-weighted cloud water fallspeed (m/s) + real(r8) :: vtrmi(mgncol,nlev) ! mass-weighted cloud ice fallspeed (m/s) + real(r8) :: umr(mgncol,nlev) ! mass weighted rain fallspeed (m/s) + real(r8) :: ums(mgncol,nlev) ! mass weighted snow fallspeed (m/s) + real(r8) :: qcsedten(mgncol,nlev) ! qc sedimentation tendency (1/s) + real(r8) :: qisedten(mgncol,nlev) ! qi sedimentation tendency (1/s) + real(r8) :: qrsedten(mgncol,nlev) ! qr sedimentation tendency (1/s) + real(r8) :: qssedten(mgncol,nlev) ! qs sedimentation tendency (1/s) + + real(r8) :: pratot(mgncol,nlev) ! accretion of cloud by rain + real(r8) :: prctot(mgncol,nlev) ! autoconversion of cloud to rain + real(r8) :: mnuccctot(mgncol,nlev) ! mixing ratio tend due to immersion freezing + real(r8) :: mnuccttot(mgncol,nlev) ! mixing ratio tend due to contact freezing + real(r8) :: msacwitot(mgncol,nlev) ! mixing ratio tend due to H-M splintering + real(r8) :: psacwstot(mgncol,nlev) ! collection of cloud water by snow + real(r8) :: bergstot(mgncol,nlev) ! bergeron process on snow + real(r8) :: bergtot(mgncol,nlev) ! bergeron process on cloud ice + real(r8) :: melttot(mgncol,nlev) ! melting of cloud ice + real(r8) :: homotot(mgncol,nlev) ! homogeneous freezing cloud water + + real(r8) :: qcrestot(mgncol,nlev) ! residual cloud condensation due to removal of excess supersat + real(r8) :: prcitot(mgncol,nlev) ! autoconversion of cloud ice to snow + real(r8) :: praitot(mgncol,nlev) ! accretion of cloud ice by snow + real(r8) :: qirestot(mgncol,nlev) ! residual ice deposition due to removal of excess supersat + real(r8) :: mnuccrtot(mgncol,nlev) ! mixing ratio tendency due to heterogeneous freezing of rain to snow (1/s1) + real(r8) :: mnuccritot(mgncol,nlev) ! mixing ratio tendency due to heterogeneous freezing of rain to ice for small rain drops (1/s1) + real(r8) :: pracstot(mgncol,nlev) ! mixing ratio tendency due to accretion of rain by snow (1/s) + real(r8) :: mnuccdtot(mgncol,nlev) ! mass tendency from ice nucleation + real(r8) :: meltsdttot(mgncol,nlev) ! latent heating rate due to melting of snow (W/kg) + real(r8) :: frzrdttot(mgncol,nlev) ! latent heating rate due to homogeneous freezing of rain (W/kg) + real(r8) :: nrout(mgncol,nlev) ! rain number concentration (1/m3) + real(r8) :: nsout(mgncol,nlev) ! snow number concentration (1/m3) + real(r8) :: refl(mgncol,nlev) ! analytic radar reflectivity + real(r8) :: arefl(mgncol,nlev) ! average reflectivity will zero points outside valid range + real(r8) :: areflz(mgncol,nlev) ! average reflectivity in z. + real(r8) :: frefl(mgncol,nlev) ! fractional occurrence of radar reflectivity + real(r8) :: csrfl(mgncol,nlev) ! cloudsat reflectivity + real(r8) :: acsrfl(mgncol,nlev) ! cloudsat average + real(r8) :: fcsrfl(mgncol,nlev) ! cloudsat fractional occurrence of radar reflectivity + real(r8) :: rercld(mgncol,nlev) ! effective radius calculation for rain + cloud + real(r8) :: ncai(mgncol,nlev) ! output number conc of ice nuclei available (1/m3) + real(r8) :: ncal(mgncol,nlev) ! output number conc of CCN (1/m3) + real(r8) :: qrout2(mgncol,nlev) ! copy of qrout as used to compute drout2 + real(r8) :: qsout2(mgncol,nlev) ! copy of qsout as used to compute dsout2 + real(r8) :: nrout2(mgncol,nlev) ! copy of nrout as used to compute drout2 + real(r8) :: nsout2(mgncol,nlev) ! copy of nsout as used to compute dsout2 + real(r8) :: drout2(mgncol,nlev) ! mean rain particle diameter (m) + real(r8) :: dsout2(mgncol,nlev) ! mean snow particle diameter (m) + real(r8) :: freqs(mgncol,nlev) ! fractional occurrence of snow + real(r8) :: freqr(mgncol,nlev) ! fractional occurrence of rain + real(r8) :: nfice(mgncol,nlev) ! fractional occurrence of ice + real(r8) :: qcrat(mgncol,nlev) ! limiter for qc process rates (1=no limit --> 0. no qc) + + real(r8) :: sum_freeze(mgncol,nlev) + real(r8) :: sum_freeze2(mgncol,nlev) + real(r8) :: sum_rime(mgncol,nlev) + real(r8) :: sum_splinter(mgncol,nlev) + real(r8) :: sum_bergs(mgncol,nlev) + real(r8) :: sum_cond(mgncol,nlev) + real(r8) :: sum_berg(mgncol,nlev) + real(r8) :: sum_ice_adj(mgncol,nlev) + real(r8) :: qldt_sum + +! these variables are only used in the GFDL implementation + + real(r8) :: cmelo(mgncol,nlev) ! liquid condensation + real(r8) :: eroslo(mgncol,nlev) ! liquid erosion + real(r8) :: erosio(mgncol,nlev) ! ice erosion + real(r8) :: preo(mgncol,nlev) ! rain evaporation + real(r8) :: prdso(mgncol,nlev) ! snow sublimation + real(r8) :: npccn2(mgncol,nlev) ! ccn activated number tendency (from microp_aero_ts) (1/kg*s) + logical :: do_berg1 + logical :: limit_berg = .false. + real(r8) :: berg_lim = 1.0e-6_r8 + real(r8) :: dum3 ! temporary dummy variable + + +! droplet number + real(r8) :: nucclim(mgncol,nlev) + real(r8) :: nucclimo(mgncol,nlev) + real(r8) :: npccno(mgncol,nlev) + real(r8) :: nnuccco(mgncol,nlev) + real(r8) :: nnuccto(mgncol,nlev) + real(r8) :: npsacwso(mgncol,nlev) + real(r8) :: nsubco(mgncol,nlev) + real(r8) :: nerosco(mgncol,nlev) + real(r8) :: nprao(mgncol,nlev) + real(r8) :: nprc1o(mgncol,nlev) + +! cloud ice number + real(r8) :: nucclim1i(mgncol,nlev) + real(r8) :: nucclim1io(mgncol,nlev) + real(r8) :: nnuccdo(mgncol,nlev) + real(r8) :: nsacwio(mgncol,nlev) + real(r8) :: nsubio(mgncol,nlev) + real(r8) :: nerosio(mgncol,nlev) + real(r8) :: nprcio(mgncol,nlev) + real(r8) :: npraio(mgncol,nlev) + real(r8) :: nnuccrio(mgncol,nlev) + +#ifdef GFDL_COMPATIBLE_MICROP + real(r8) :: dum2i(mgncol,nlev) ! used with ice nuleation + real(r8) :: dum2l(mgncol,nlev) ! used with drop nuleation + real(r8) :: dum2a(mgncol,nlev) ! used with ice nuleation +#endif + + real(r8) :: flx(nlev), precip, dum_1D(nlev) + + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! default return error message + errstring = ' ' + + ! Process inputs + + ! assign variable deltat for sub-stepping... + deltat = deltatin + + + ! Copies of input concentrations that may be changed internally. + + t = tn + q = qn + qc = qcn + nc = ncn + qi = qin + ni = nin + qr = qrn + nr = nrn + qs = qsn + ns = nsn + + frzimm = 0.0_r8 + frzcnt = 0.0_r8 + frzdep = 0.0_r8 + + tnd_qsnow = 0.0_r8 + tnd_nsnow = 0.0_r8 + re_ice = 20e-6 + + ssat_disposal = 0.0_r8 + sum_freeze = 0.0_r8 + sum_freeze2 = 0.0_r8 + + ! cldn: used to set cldm, unused for subcolumns + ! liqcldf: used to set lcldm, unused for subcolumns + ! icecldf: used to set icldm, unused for subcolumns + + if (microp_uniform) then + ! subcolumns, set cloud fraction variables to one + ! if cloud water or ice is present, if not present + ! set to mincld (mincld used instead of zero, to prevent + ! possible division by zero errors). + + where (qc >= qsmall) + lcldm = 1._r8 + elsewhere + lcldm = mincld + end where + + where (qi >= qsmall) + icldm = 1._r8 + elsewhere + icldm = mincld + end where + + cldm = max(icldm, lcldm) + qsfm = 1._r8 + + else + ! get cloud fraction, check for minimum + cldm = max(cldn,mincld) + lcldm = max(liqcldf,mincld) + icldm = max(icecldf,mincld) + qsfm = 1.0_r8 + end if + + ! Initialize local variables + + ! local physical properties + rho = p/(r*t) + dv = 8.794E-5_r8 * t**1.81_r8 / p + mu = 1.496E-6_r8 * t**1.5_r8 / (t + 120._r8) + sc = mu/(rho*dv) + + + ! air density adjustment for fallspeed parameters + ! includes air density correction factor to the + ! power of 0.54 following Heymsfield and Bansemer 2007 + + rhof=(rhosu/rho)**0.54_r8 +#ifdef GFDL_COMPATIBLE_MICROP + if (.not. rho_factor_in_max_vt) rhof = 1.0 + rhof = MIN (rhof, max_rho_factor_in_vt) +#endif + +! --->h1g, add namelist variables, 2014-07-01 +! Zhao et al., ACP 2013, Table 1, +! ai: 350-1400 (s^-1); as: 5.86-23.44 (m^0.59 s^-1) +! IceFallFac: 0.5 -- 2; SnowFallFac: 0.5 -- 2 + arn=ar*rhof + asn=as* SnowFallFac* rhof + acn=g*rhow/(18._r8*mu) + ain=ai * IceFallFac*(rhosu/rho)**0.35_r8 + ajn=aj * (rhosu/rho)**0.35_r8 + + diag_4l(:,j,:,diag_pt%qidt_tiny) = 0.0 + diag_4l(:,j,:,diag_pt%qnidt_tiny) = 0.0 + diag_4l(:,j,:,diag_pt%qrdt_tiny) = 0.0 + diag_4l(:,j,:,diag_pt%qnrdt_tiny) = 0.0 + + diag_4l(:,j,:,diag_pt%qldt_tiny) = 0.0 + diag_4l(:,j,:,diag_pt%qndt_tiny) = 0.0 + diag_4l(:,j,:,diag_pt%qsdt_tiny) = 0.0 + diag_4l(:,j,:,diag_pt%qnsdt_tiny) = 0.0 + + + !INITIALIZE STUFF FOR SUBSTEPPING + !=============================================== + +!--> h1g, 2019-12-05 + ! get sub-step time step + deltat=deltat/real(iter) +!<-- h1g, 2019-12-05 + + ! set mtime here to avoid answer-changing + mtime=deltat + + ! initialize tendencies to zero +!--> h1g, 2019-12-05 + tlat1 = 0._r8 + qvlat1 = 0._r8 + qctend1 = 0._r8 + qitend1 = 0._r8 + nctend1 = 0._r8 + nitend1 = 0._r8 + qrtend1 = 0._r8 + qstend1 = 0._r8 + nrtend1 = 0._r8 + nstend1 = 0._r8 +!<-- h1g, 2019-12-05 + + ! initialize microphysics output + qcsevap=0._r8 + qisevap=0._r8 + qvres =0._r8 + cmeitot =0._r8 + vtrmc =0._r8 + vtrmi =0._r8 + qcsedten =0._r8 + qisedten =0._r8 + qrsedten =0._r8 + qssedten =0._r8 + + diag_4l(:,j,:,diag_pt%qndt_sedi) = 0.0 + diag_4l(:,j,:,diag_pt%qnidt_sedi) = 0.0 + diag_4l(:,j,:,diag_pt%rain_num_sedi) = 0.0 + diag_4l(:,j,:,diag_pt%snow_num_sedi) = 0.0 + +!initialize gfdl-only arrays-- this may not be needed and will be reviewed later. + preo =0._r8 + prdso=0._r8 + cmelo =0._r8 + eroslo =0._r8 + erosio =0._r8 +!droplet number + nucclimo = 0._r8 + npccno = 0._r8 + nnuccco = 0._r8 + nnuccto = 0._r8 + npsacwso = 0._r8 + nsubco = 0._r8 + nerosco = 0._r8 + nprao = 0._r8 + nprc1o = 0._r8 +!ice number + nucclim1io = 0._r8 + nnuccdo = 0._r8 + nsacwio = 0._r8 + nsubio = 0._r8 + nerosio = 0._r8 + nprcio = 0._r8 + npraio = 0._r8 + nnuccrio = 0._r8 + + pratot=0._r8 + prctot=0._r8 + mnuccctot=0._r8 + mnuccttot=0._r8 + msacwitot=0._r8 + psacwstot=0._r8 + bergstot=0._r8 + bergtot=0._r8 + melttot=0._r8 + homotot=0._r8 + qcrestot=0._r8 + prcitot=0._r8 + praitot=0._r8 + qirestot=0._r8 + mnuccrtot=0._r8 + mnuccritot=0._r8 + pracstot=0._r8 + meltsdttot=0._r8 + frzrdttot=0._r8 + mnuccdtot=0._r8 + + rflx=0._r8 + sflx=0._r8 + lflx=0._r8 + iflx=0._r8 + + ! initialize precip output + + qrout=0._r8 + qsout=0._r8 + nrout=0._r8 + nsout=0._r8 + + ! for refl calc + rainrt = 0._r8 + + ! initialize rain size + rercld=0._r8 + + qcsinksum_rate1ord = 0._r8 + + ! initialize variables for trop_mozart + nevapr = 0._r8 + evapsnow = 0._r8 + am_evp_st = 0._r8 + prain = 0._r8 + prodsnow = 0._r8 + cmeout = 0._r8 + + precip_frac = mincld + + lamc=0._r8 + + !*********DO SUBSTEPPING!*************** + !============================================ + substepping: do it=1,iter + + ! initialize sub-step microphysical tendencies + + tlat=0._r8 + qvlat=0._r8 + qctend=0._r8 + qitend=0._r8 + qstend = 0._r8 + qrtend = 0._r8 + nctend=0._r8 + nitend=0._r8 + nrtend = 0._r8 + nstend = 0._r8 + + ! initialize in-cloud and in-precip quantities to zero + qcic = 0._r8 + qiic = 0._r8 + qsic = 0._r8 + qric = 0._r8 + + ncic = 0._r8 + niic = 0._r8 + nsic = 0._r8 + nric = 0._r8 + + ! initialize precip at surface + + prect = 0._r8 + preci = 0._r8 + + ! initialize precip fallspeeds to zero + ums = 0._r8 + uns = 0._r8 + umr = 0._r8 + unr = 0._r8 + + ! initialize limiter for output + qcrat = 1._r8 + + ! Many outputs have to be initialized here at the top to work around + ! ifort problems, even if they are always overwritten later. + effc = 10._r8 + lamcrad = 0._r8 + pgamrad = 0._r8 + effc_fn = 10._r8 + effi = 25._r8 + sadice = 0._r8 + sadsnow = 0._r8 + deffi = 50._r8 + + qrout2 = 0._r8 + nrout2 = 0._r8 + drout2 = 0._r8 + qsout2 = 0._r8 + nsout2 = 0._r8 + dsout = 0._r8 + dsout2 = 0._r8 + + freqr = 0._r8 + freqs = 0._r8 + + reff_rain = 0._r8 + reff_snow = 0._r8 + + refl = -9999._r8 + arefl = 0._r8 + areflz = 0._r8 + frefl = 0._r8 + csrfl = 0._r8 + acsrfl = 0._r8 + fcsrfl = 0._r8 + + ncal = 0._r8 + ncai = 0._r8 + + nfice = 0._r8 + +!--> h1g, 2019-12-06 +! re-calculate saturation vapor pressure for liquid and ice + do k = 1, nlev + do i = 1, mgncol + call compute_qs (t(i,k), p(i,k), qvl(i,k), q = q(i,k), & + esat = esl(i,k), es_over_liq = .true.) + call compute_qs (t(i,k), p(i,k), qvi(i,k), q = q(i,k), & + esat = esi(i,k), es_over_liq_and_ice = .true.) + + if ( t(i,k) < tmelt) then + ! Scale the water saturation values to reflect subgrid scale + ! ice cloud fraction, where ice clouds begin forming at a + ! gridbox average relative humidity of rhmini (not 1). + ! + ! NOTE: For subcolumns and other non-subgrid clouds, qsfm willi + ! be 1. + qvi(i,k) = qsfm(i,k) * qvi(i,k) + esi(i,k) = qsfm(i,k) * esi(i,k) + qvl(i,k) = qsfm(i,k) * qvl(i,k) + esl(i,k) = qsfm(i,k) * esl(i,k) + endif + end do + end do + + relhum = q / max(qvl, qsmall) +!<-- h1g, 2019-12-06 + +#ifdef GFDL_COMPATIBLE_MICROP +! --->h1g, 2019-10-25 + dum_30 = 5.0_r8*exp(0.304_r8*( 30.0)) + dum_5 = 5.0_r8*exp(0.304_r8*( 5.0)) +! <---h1g, 2019-10-25 + +! calculate ice nucleation dum2i + do k=1,nlev + do i=1,mgncol + if (t(i,k).lt. icenuct ) then + + if ( liu_in .or. use_Fan2019 ) then + dum2i(i,k) = naai(i,k) + if ( lat(i)*180.0/3.14159 > 60.0 ) dum2i(i,k) = dum2i(i,k) * ice_nucl_factor ! h1g, 2019-12-17 + +! --->h1g, 2014-05-30 add Meyers ice nucleation formula (Only temperature dependent) + elseif ( use_Meyers ) then + dum2i(i,k) = (exp(12.96* (tmelt -t(i,k))/80 - 0.639)) *1000._r8 + dum2i(i,k)= ( dum2i(i,k) )/rho(i,k) ! convert from m-3 to kg-1 +! <--- h1g, 2014-05-30 + +! <-- h1g, 2020-04-18 + elseif ( use_FanAndCooper ) then + dum2i(i,k) = 2.74 * concen_dust_sub(i,k) * exp(0.412_r8*(tmelt-t(i,k))) + dum2i(i,k) = min( dum2i(i,k), Nice_max_Fan*1000._r8 ) + dum2i(i,k) = dum2i(i,k) * p(i,k)/ 95000. + dum2i(i,k)= dum2i(i,k)/rho(i,k) ! convert from m-3 to kg-1 + + dum_tmp = 0.005_r8*exp(0.304_r8*(tmelt-t(i,k)))*1000._r8 + dum_tmp = min( dum_tmp, 5.0_r8*exp(0.304_r8*(-tc_cooper))) + dum_tmp = dum_tmp/rho(i,k) ! convert from m-3 to kg-1 + dum2i(i,k)= dum2i(i,k) + dum_tmp +! --> h1g, 2020-04-18 + + else +! cooper curve (factor of 1000 is to convert from L-1 to m-3) + dum2i(i,k)=0.005_r8*exp(0.304_r8*(tmelt-t(i,k)))*1000._r8 +! put limit on number of nucleated crystals, set to number at T=-30 C +! cooper (limit to value at -35 C) + dum2i(i,k)= min(dum2i(i,k),5.0_r8*exp(0.304_r8*(-tc_cooper))) + +! --->h1g, 2019-10-25 + dum_tmp = dum_5 + (dum_30-dum_5)/25.0*( tmelt-t(i,k) - 5.0) + if ( do_Ni_linear_interp ) & + dum2i(i,k)= max(dum2i(i,k), dum_tmp ) +! <---h1g, 2019-10-25 + + dum2i(i,k)=dum2i(i,k)/rho(i,k) ! convert from m-3 to kg-1 + endif + else + dum2i(i,k)=0._r8 + end if ! t(i,k).lt. icenuct + ! naai(i,k) = dum2i(i,k) + end do + end do +#endif + + +#ifdef GFDL_COMPATIBLE_MICROP + dum2l = 0. +#endif + +!ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc +! droplet activation +#ifdef GFDL_COMPATIBLE_MICROP + do k=1,nlev + do i=1,mgncol + if ( qc(i,k).ge.qsmall ) then + dum2l(i,k) = max(0._r8, npccn (i,k)) + +!RSH npccn2 is the change in droplet number on this step. In the +! non-GFDL_COMPATIBLE_MICROP, this is not calculated since the input +! droplet number already includes the newly activated droplets. + npccn2(i,k) = ((dum2l(i,k) - nc(i,k)/cldm(i,k))/tau_act_liq )*cldm(i,k) + npccn2(i,k) = max(0._r8,npccn2(i,k)) + else + npccn2(i,k)=0._r8 + end if + ! nc(i,k) = nc(i,k)+npccn2(i,k)*deltat ! from MG2, additional changes from h1g + end do + end do +#endif + +! ice activation + if (do_cldice) then +! --->h1g, 2014-05-30 add Meyers ice nucleation option + where (dum2i > 0._r8 .and. t < icenuct .and. & + relhum*esl/esi > rhmini+0.05_r8 .and. icldm > icld_cri) + + !if NAAI > 0. then set numice = naai (as before) + !note: this is gridbox averaged + nnuccd = (dum2i-ni/icldm)/tau_act_ice * icldm + nnuccd = max(nnuccd,0._r8) + nimax = dum2i*icldm + !Calc mass of new particles using new crystal mass... + !also this will be multiplied by mtime as nnuccd is... + mnuccd = nnuccd * mi0 + + elsewhere + nnuccd = 0._r8 + nimax = 0._r8 + mnuccd = 0._r8 + end where + ! ni = ni + nnuccd*deltat ! h1g, 2019-12-10 + end if ! do_cldice + + !============================================================================= +!--> h1g, 2019-12-06 +! temporary copy of qs, ns, qr, nr for calculating qs, ns, qr, nr tendencies + qstmp = qs + nstmp = ns + qrtmp = qr + nrtmp = nr +!<-- h1g, 2019-12-06 + + do k=1,nlev + do i=1,mgncol + + ! calculate instantaneous precip processes (melting and homogeneous freezing) + + ! melting of snow at +2 C + + if (t(i,k) > snowmelt) then + if (qs(i,k) > 0._r8) then + + ! make sure melting snow doesn't reduce temperature below threshold + dum = -xlf/cpp*qs(i,k) + if (t(i,k)+dum < snowmelt) then + dum = (t(i,k)-snowmelt)*cpp/xlf + dum = dum/qs(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + minstsm(i,k) = dum*qs(i,k) + ninstsm(i,k) = dum*ns(i,k) + + dum1=-xlf*minstsm(i,k)/deltat + tlat(i,k)=tlat(i,k)+dum1 + meltsdttot(i,k)=meltsdttot(i,k) + dum1 + + qs(i,k) = max(qs(i,k) - minstsm(i,k), 0._r8) + ns(i,k) = max(ns(i,k) - ninstsm(i,k), 0._r8) + qr(i,k) = max(qr(i,k) + minstsm(i,k), 0._r8) + nr(i,k) = max(nr(i,k) + ninstsm(i,k), 0._r8) + end if + end if + + end do + end do + + + do k=1,nlev + do i=1,mgncol + ! freezing of rain at -5 C + + if (t(i,k) < rainfrze) then + + if (qr(i,k) > 0._r8) then + + ! make sure freezing rain doesn't increase temperature above threshold + dum = xlf/cpp*qr(i,k) + if (t(i,k)+dum > rainfrze) then + dum = -(t(i,k)-rainfrze)*cpp/xlf + dum = dum/qr(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + minstrf(i,k) = dum*qr(i,k) + ninstrf(i,k) = dum*nr(i,k) + + ! heating tendency + dum1 = xlf*minstrf(i,k)/deltat + tlat(i,k)=tlat(i,k)+dum1 + frzrdttot(i,k)=frzrdttot(i,k) + dum1 + + qr(i,k) = max(qr(i,k) - minstrf(i,k), 0._r8) + nr(i,k) = max(nr(i,k) - ninstrf(i,k), 0._r8) + qs(i,k) = max(qs(i,k) + minstrf(i,k), 0._r8) + ns(i,k) = max(ns(i,k) + ninstrf(i,k), 0._r8) + + end if + end if + end do + end do + + + do k=1,nlev + do i=1,mgncol + ! obtain in-cloud values of cloud water/ice mixing ratios and number concentrations + !------------------------------------------------------- + ! for microphysical process calculations + ! units are kg/kg for mixing ratio, 1/kg for number conc + + if (qc(i,k).ge.qsmall) then + ! limit in-cloud values to 0.005 kg/kg + qcic(i,k)=min(qc(i,k)/lcldm(i,k),5.e-3_r8) + ncic(i,k)=max(nc(i,k)/lcldm(i,k),0._r8) + + ! specify droplet concentration + if (nccons) then + ncic(i,k)=ncnst/rho(i,k) + end if + else + qcic(i,k)=0._r8 + ncic(i,k)=0._r8 + end if + + if (qi(i,k).ge.qsmall) then + ! limit in-cloud values to 0.005 kg/kg + qiic(i,k)=min(qi(i,k)/icldm(i,k),5.e-3_r8) + niic(i,k)=max( ( ni(i,k) +nnuccd(i,k)*deltat )/icldm(i,k),0._r8) ! h1g, 2019-12-10 + ! niic(i,k)=max( ni(i,k)/icldm(i,k),0._r8) ! h1g, 2019-12-10 + + ! switch for specification of cloud ice number + if (nicons) then + niic(i,k)=ninst/rho(i,k) + end if + else + qiic(i,k)=0._r8 + niic(i,k)=0._r8 + end if + + end do + end do + + !======================================================================== + + ! for sub-columns cldm has already been set to 1 if cloud + ! water or ice is present, so precip_frac will be correctly set below + ! and nothing extra needs to be done here + + precip_frac = cldm + + micro_vert_loop: do k=1,nlev + + if (trim(micro_mg_precip_frac_method) == 'in_cloud') then + + if (k /= 1) then + where (qc(:,k) < qsmall .and. qi(:,k) < qsmall) + precip_frac(:,k) = precip_frac(:,k-1) + end where + endif + + else if (trim(micro_mg_precip_frac_method) == 'max_overlap') then + + ! calculate precip fraction based on maximum overlap assumption + + ! if rain or snow mix ratios are smaller than threshold, + ! then leave precip_frac as cloud fraction at current level + if (k /= 1) then + where (qr(:,k-1) >= qsmall .or. qs(:,k-1) >= qsmall) + precip_frac(:,k)=max(precip_frac(:,k-1),precip_frac(:,k)) + end where + end if + + endif + + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + ! get size distribution parameters based on in-cloud cloud water + ! these calculations also ensure consistency between number and mixing ratio + !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! cloud liquid + !------------------------------------------- + call size_dist_param_liq(mg_liq_props, qcic(:,k), ncic(:,k), rho(:,k), & + pgam(:,k), lamc(:,k), mgncol) + + !======================================================================== + ! autoconversion of cloud liquid water to rain + ! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc + ! minimum qc of 1 x 10^-8 prevents floating point error + + if (.not. do_sb_physics .and. .not.do_cotton_auto) then + call kk2000_liq_autoconversion(microp_uniform, qcic(:,k), & + ncic(:,k), rho(:,k), relvar(:,k), prc(:,k), nprc(:,k), nprc1(:,k), mgncol) + endif + + ! assign qric based on prognostic qr, using assumed precip fraction + ! note: this could be moved above for consistency with qcic and qiic calculations + qric(:,k) = qr(:,k)/precip_frac(:,k) + nric(:,k) = nr(:,k)/precip_frac(:,k) + + ! limit in-precip mixing ratios to 10 g/kg + qric(:,k)=min(qric(:,k),0.01_r8) + + ! add autoconversion to precip from above to get provisional rain mixing ratio + ! and number concentration (qric and nric) + + where (qric(:,k).lt.qsmall) + qric(:,k)=0._r8 + nric(:,k)=0._r8 + end where + + ! make sure number concentration is a positive number to avoid + ! taking root of negative later + + nric(:,k)=max(nric(:,k),0._r8) + + ! Get size distribution parameters for cloud ice + + call size_dist_param_basic(mg_ice_props, qiic(:,k), niic(:,k), & + lami(:,k), mgncol, n0=n0i(:,k)) + + ! Alternative autoconversion + if (do_cotton_auto ) then + call cotton_liq_autoconversion(.false., qcic(:,k), & + ncic(:,k), rho(:,k), relvar(:,k), rthresh, prc(:,k), nprc(:,k), nprc1(:,k), mgncol) + elseif (do_sb_physics) then + call sb2001v2_liq_autoconversion(pgam(:,k),qcic(:,k),ncic(:,k), & + qric(:,k),rho(:,k),relvar(:,k),prc(:,k),nprc(:,k),nprc1(:,k), mgncol) + endif + + + !....................................................................... + ! Autoconversion of cloud ice to snow + ! similar to Ferrier (1994) + + if (do_cldice) then + call ice_autoconversion(t(:,k), qiic(:,k), lami(:,k), n0i(:,k), & + dcs, prci(:,k), nprci(:,k), mgncol) + + else + ! Add in the particles that we have already converted to snow, and + ! don't do any further autoconversion of ice. + prci(:,k) = tnd_qsnow(:,k) / cldm(:,k) + nprci(:,k) = tnd_nsnow(:,k) / cldm(:,k) + end if + + ! note, currently we don't have this + ! inside the do_cldice block, should be changed later + ! assign qsic based on prognostic qs, using assumed precip fraction + qsic(:,k) = qs(:,k)/precip_frac(:,k) + nsic(:,k) = ns(:,k)/precip_frac(:,k) + + ! limit in-precip mixing ratios to 10 g/kg + qsic(:,k)=min(qsic(:,k),0.01_r8) + + ! if precip mix ratio is zero so should number concentration + + where (qsic(:,k) < qsmall) + qsic(:,k)=0._r8 + nsic(:,k)=0._r8 + end where + + ! make sure number concentration is a positive number to avoid + ! taking root of negative later + + nsic(:,k)=max(nsic(:,k),0._r8) + !....................................................................... + ! get size distribution parameters for precip + !...................................................................... + ! rain + + call size_dist_param_basic(mg_rain_props, qric(:,k), nric(:,k), & + lamr(:,k), mgncol, n0=n0r(:,k)) + + where (lamr(:,k) >= qsmall) + + ! provisional rain number and mass weighted mean fallspeed (m/s) + + unr(:,k) = min(arn(:,k)*gamma_br_plus1/lamr(:,k)**br,9.1_r8*rhof(:,k)) + umr(:,k) = min(arn(:,k)*gamma_br_plus4/(6._r8*lamr(:,k)**br),9.1_r8*rhof(:,k)) + + elsewhere + umr(:,k) = 0._r8 + unr(:,k) = 0._r8 + end where + + !...................................................................... + ! snow + + call size_dist_param_basic(mg_snow_props, qsic(:,k), nsic(:,k), & + lams(:,k), mgncol, n0=n0s(:,k)) + + where (lams(:,k) > 0._r8) + ! provisional snow number and mass weighted mean fallspeed (m/s) + ums(:,k) = min(asn(:,k)*gamma_bs_plus4/(6._r8*lams(:,k)**bs),1.2_r8*rhof(:,k)) + uns(:,k) = min(asn(:,k)*gamma_bs_plus1/lams(:,k)**bs,1.2_r8*rhof(:,k)) + + elsewhere + ums(:,k) = 0._r8 + uns(:,k) = 0._r8 + end where + + if (do_cldice) then + if (.not. use_hetfrz_classnuc) then + + ! heterogeneous freezing of cloud water + !---------------------------------------------- + + call immersion_freezing(microp_uniform, t(:,k), pgam(:,k), lamc(:,k), & + qcic(:,k), ncic(:,k), relvar(:,k), mnuccc(:,k), nnuccc(:,k), mgncol) + + + ! make sure number of droplets frozen does not exceed available ice nuclei concentration + ! this prevents 'runaway' droplet freezing + + where (qcic(:,k).ge.qsmall .and. t(:,k).lt.269.15_r8) + where (nnuccc(:,k)*lcldm(:,k).gt.nnuccd(:,k)) + ! scale mixing ratio of droplet freezing with limit + mnuccc(:,k)=mnuccc(:,k)*(nnuccd(:,k)/(nnuccc(:,k)*lcldm(:,k))) + nnuccc(:,k)=nnuccd(:,k)/lcldm(:,k) + end where + end where + + mdust = size(rndst,3) + call contact_freezing(microp_uniform, t(:,k), p(:,k), rndst(:,k,:), & + nacon(:,k,:), pgam(:,k), lamc(:,k), qcic(:,k), ncic(:,k), & + relvar(:,k), mnucct(:,k), nnucct(:,k), mgncol, mdust) + + mnudep(:,k)=0._r8 + nnudep(:,k)=0._r8 + else + + ! Mass of droplets frozen is the average droplet mass, except + ! with two limiters: concentration must be at least 1/cm^3, and + ! mass must be at least the minimum defined above. + mi0l = qcic(:,k)/max(ncic(:,k), 1.0e6_r8/rho(:,k)) + mi0l = max(mi0l_min, mi0l) + + where (qcic(:,k) >= qsmall) + nnuccc(:,k) = frzimm(:,k)*1.0e6_r8/rho(:,k) + mnuccc(:,k) = nnuccc(:,k)*mi0l + + nnucct(:,k) = frzcnt(:,k)*1.0e6_r8/rho(:,k) + mnucct(:,k) = nnucct(:,k)*mi0l + + nnudep(:,k) = frzdep(:,k)*1.0e6_r8/rho(:,k) + mnudep(:,k) = nnudep(:,k)*mi0 + elsewhere + nnuccc(:,k) = 0._r8 + mnuccc(:,k) = 0._r8 + + nnucct(:,k) = 0._r8 + mnucct(:,k) = 0._r8 + + nnudep(:,k) = 0._r8 + mnudep(:,k) = 0._r8 + end where + + end if + + else + mnuccc(:,k)=0._r8 + nnuccc(:,k)=0._r8 + mnucct(:,k)=0._r8 + nnucct(:,k)=0._r8 + mnudep(:,k)=0._r8 + nnudep(:,k)=0._r8 + end if + + call snow_self_aggregation(t(:,k), rho(:,k), asn(:,k), rhosn, qsic(:,k), nsic(:,k), & + nsagg(:,k), mgncol) + + call accrete_cloud_water_snow(t(:,k), rho(:,k), asn(:,k), uns(:,k), mu(:,k), & + qcic(:,k), ncic(:,k), qsic(:,k), pgam(:,k), lamc(:,k), lams(:,k), n0s(:,k), & + psacws(:,k), npsacws(:,k), use_const_ELI, ELI_RK, mgncol) ! h1g, 2020-04-16 + if ( .not. do_liq_num_riming ) npsacws(:,k) = 0.0 ! h1g, 2020-03-10 + + + if (do_cldice .and. do_HM_splinter ) then + call secondary_ice_production(t(:,k), psacws(:,k), msacwi(:,k), nsacwi(:,k), mgncol) + else + nsacwi(:,k) = 0.0_r8 + msacwi(:,k) = 0.0_r8 + end if + + call accrete_rain_snow(t(:,k), rho(:,k), umr(:,k), ums(:,k), unr(:,k), uns(:,k), & + qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), & + pracs(:,k), npracs(:,k), mgncol) + + call heterogeneous_rain_freezing(t(:,k), qric(:,k), nric(:,k), lamr(:,k), & + mnuccr(:,k), nnuccr(:,k), mgncol) + + if (do_sb_physics) then + call sb2001v2_accre_cld_water_rain(qcic(:,k), ncic(:,k), qric(:,k), & + rho(:,k), relvar(:,k), pra(:,k), npra(:,k), mgncol) + else + call accrete_cloud_water_rain(microp_uniform, qric(:,k), qcic(:,k), & + ncic(:,k), relvar(:,k), pra(:,k), npra(:,k), mgncol) + endif + + if (.not. microp_uniform) then + pra(:,k) = pra(:,k) * accre_enhan(:,k) + npra(:,k) = npra(:,k) * accre_enhan(:,k) + endif + + + call self_collection_rain(rho(:,k), qric(:,k), nric(:,k), nragg(:,k), mgncol) + + if (do_cldice) then + call accrete_cloud_ice_snow(t(:,k), rho(:,k), asn(:,k), qiic(:,k), niic(:,k), & + qsic(:,k), lams(:,k), n0s(:,k), prai(:,k), nprai(:,k), mgncol) + else + prai(:,k) = 0._r8 + nprai(:,k) = 0._r8 + end if + + call evaporate_sublimate_precip(t(:,k), rho(:,k), & + dv(:,k), mu(:,k), sc(:,k), q(:,k), qvl(:,k), qvi(:,k), & + lcldm(:,k), precip_frac(:,k), arn(:,k), asn(:,k), qcic(:,k), qiic(:,k), & + qric(:,k), qsic(:,k), lamr(:,k), n0r(:,k), lams(:,k), n0s(:,k), & + pre(:,k), prds(:,k), am_evp_st(:,k), mgncol) + pre(:,k) = evap_subl_fac * pre(:,k) + prds(:,k) = evap_subl_fac * prds(:,k) + + call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), & + qvl(:,k), qvi(:,k), asn(:,k), qcic(:,k), qsic(:,k), lams(:,k), n0s(:,k), & + bergs(:,k), mgncol) + + bergs(:,k)=bergs(:,k)*micro_mg_bergs_eff_factor + + !+++PMC 12/3/12 - NEW VAPOR DEP/SUBLIMATION GOES HERE!!! + if (do_cldice) then + + call ice_deposition_sublimation(t(:,k), q(:,k), qc(:,k), qi(:,k), ni(:,k), & + icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & + berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) + vap_dep(:,k) = vap_dep(:,k) * ice_sublim_factor !h1g, 2017-07-17 + ice_sublim(:,k) = ice_sublim(:,k) * ice_sublim_factor !h1g, 2017-07-16 + berg(:,k)=berg(:,k)*micro_mg_berg_eff_factor + ! vap_dep(:,k) = vap_dep(:,k) + dqidt(:,k) ! h1g, 2016-12-19 + + where ( ice_sublim(:,k) < 0._r8 .and. qi(:,k) > qsmall .and. icldm(:,k) > mincld) + nsubi(:,k) = sublim_factor*ice_sublim(:,k) / qi(:,k) * ni(:,k) / icldm(:,k) + elsewhere + nsubi(:,k) = 0._r8 + end where + + ! bergeron process should not reduce nc unless + ! all ql is removed (which is handled elsewhere) + !in fact, nothing in this entire file makes nsubc nonzero. + nsubc(:,k) = 0._r8 + + end if !do_cldice + !---PMC 12/3/12 + + do i=1,mgncol + + ! conservation to ensure no negative values of cloud water/precipitation + ! in case microphysical process rates are large + !=================================================================== + + ! note: for check on conservation, processes are multiplied by omsm + ! to prevent problems due to round off error + + ! conservation of qc + !------------------------------------------------------------------- + + dum = ((prc(i,k)+pra(i,k)+mnuccc(i,k)+mnucct(i,k)+msacwi(i,k)+ & + psacws(i,k)+bergs(i,k))*lcldm(i,k)+berg(i,k))*deltat + + if (dum.gt.qc(i,k)+dqcdt(i,k)*deltat+D_eros_l(i,k)*deltat) then + + ratio = (qc(i,k)/deltat+ max(dqcdt(i,k),0.0))/((prc(i,k)+pra(i,k)+mnuccc(i,k)+mnucct(i,k)+ & + msacwi(i,k)+psacws(i,k)+bergs(i,k))*lcldm(i,k)+berg(i,k)-D_eros_l(i,k)+max(-dqcdt(i,k),0.0))*omsm + prc(i,k) = prc(i,k)*ratio + pra(i,k) = pra(i,k)*ratio + mnuccc(i,k) = mnuccc(i,k)*ratio + mnucct(i,k) = mnucct(i,k)*ratio + msacwi(i,k) = msacwi(i,k)*ratio + psacws(i,k) = psacws(i,k)*ratio + bergs(i,k) = bergs(i,k)*ratio + berg(i,k) = berg(i,k)*ratio + D_eros_l(i,k) = D_eros_l(i,k)*ratio + if( dqcdt(i,k) < 0.0 ) dqcdt(i,k)=dqcdt(i,k)*ratio + qcrat(i,k) = ratio + if( ratio > 1) print*,'error ratio>1 in conservation of qc', i,k,ratio + if( ratio < 0) print*,'error ratio<0 in conservation of qc', i,k,ratio + else + qcrat(i,k) = 1._r8 + end if + + + !PMC 12/3/12: ratio is also frac of step w/ liquid. + !thus we apply berg for "ratio" of timestep and vapor + !deposition for the remaining frac of the timestep. + if (qc(i,k) >= qsmall) then + vap_dep(i,k) = vap_dep(i,k)*(1._r8-qcrat(i,k)) + end if + + end do + + do i=1,mgncol + + !================================================================= + ! apply limiter to ensure that ice/snow sublimation and rain evap + ! don't push conditions into supersaturation, and ice deposition/nucleation don't + ! push conditions into sub-saturation + ! note this is done after qc conservation since we don't know how large + ! vap_dep is before then + ! estimates are only approximate since other process terms haven't been limited + ! for conservation yet + + ! first limit ice deposition/nucleation vap_dep + mnuccd + dum1 = vap_dep(i,k) + mnuccd(i,k) + if (dum1 > 1.e-20_r8) then + dum = (q(i,k)-qvi(i,k))/(1._r8 + xxls_squared*qvi(i,k)/(cpp*rv*t(i,k)**2))/deltat + dum = max(dum,0._r8) + if (dum1 > dum) then + ! Allocate the limited "dum" tendency to mnuccd and vap_dep + ! processes. Don't divide by cloud fraction; these are grid- + ! mean rates. + dum1 = mnuccd(i,k) / (vap_dep(i,k)+mnuccd(i,k)) + mnuccd(i,k) = dum*dum1 + vap_dep(i,k) = dum - mnuccd(i,k) + end if + end if + + end do + + do i=1,mgncol + + !=================================================================== + ! conservation of nc + !------------------------------------------------------------------- + dum = ((nprc1(i,k)+npra(i,k)+nnuccc(i,k)+nnucct(i,k)+ & + npsacws(i,k)-nsubc(i,k))*lcldm(i,k) - npccn2(i,k) )*deltat + + if (dum.gt.nc(i,k)+nerosc(i,k)*lcldm(i,k)*deltat) then + ratio = ( nc(i,k)/deltat + npccn2(i,k) )/( (nprc1(i,k)+npra(i,k)+nnuccc(i,k)+nnucct(i,k)+& + npsacws(i,k)-nsubc(i,k)-nerosc(i,k) )*lcldm(i,k) )*omsm + + nprc1(i,k) = nprc1(i,k) * ratio + npra(i,k) = npra(i,k) * ratio + nnuccc(i,k) = nnuccc(i,k) * ratio + nnucct(i,k) = nnucct(i,k) * ratio + npsacws(i,k) = npsacws(i,k)* ratio + nsubc(i,k) = nsubc(i,k) * ratio + nerosc(i,k) = nerosc(i,k) * ratio + end if + + mnuccri(i,k)=0._r8 + nnuccri(i,k)=0._r8 + + if (do_cldice) then + + ! freezing of rain to produce ice if mean rain size is smaller than Dcs + if (lamr(i,k) > qsmall .and. 1._r8/lamr(i,k) < Dcs) then + mnuccri(i,k)=mnuccr(i,k) + nnuccri(i,k)=nnuccr(i,k) + mnuccr(i,k)=0._r8 + nnuccr(i,k)=0._r8 + end if + end if + + end do + + do i=1,mgncol + ! conservation of rain mixing ratio + !------------------------------------------------------------------- + dum = ((-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k))*precip_frac(i,k)- & + (pra(i,k)+prc(i,k))*lcldm(i,k))*deltat + + ! note that qrtend is included below because of instantaneous freezing/melt + if (dum.gt.qr(i,k).and. & + (-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k)).ge.qsmall) then + ratio = (qr(i,k)/deltat+(pra(i,k)+prc(i,k))*lcldm(i,k))/ & + precip_frac(i,k)/(-pre(i,k)+pracs(i,k)+mnuccr(i,k)+mnuccri(i,k))*omsm + pre(i,k)=pre(i,k)*ratio + pracs(i,k)=pracs(i,k)*ratio + mnuccr(i,k)=mnuccr(i,k)*ratio + mnuccri(i,k)=mnuccri(i,k)*ratio + end if + end do + + do i=1,mgncol + ! conservation of rain number + !------------------------------------------------------------------- + ! Add evaporation of rain number. + if (allow_rain_num_evap) then + if (pre(i,k) < 0._r8 .and. qr(i,k) > qsmall) then + nsubr(i,k) = max(-nr(i,k)/deltat, pre(i,k)*nr(i,k)/qr(i,k)) + else + nsubr(i,k) = 0._r8 + endif + else + ! neglect evaporation of nr, allow_rain_num_evap = .false. h1g, 2017-02-27 + nsubr(i,k) = 0._r8 + end if + end do + + do i=1,mgncol + dum = ((-nsubr(i,k)+npracs(i,k)+nnuccr(i,k)+nnuccri(i,k)-nragg(i,k))*precip_frac(i,k)- & + nprc(i,k)*lcldm(i,k))*deltat + + if (dum.gt.nr(i,k)) then + ratio = (nr(i,k)/deltat+nprc(i,k)*lcldm(i,k))/precip_frac(i,k)/ & + (-nsubr(i,k)+npracs(i,k)+nnuccr(i,k)+nnuccri(i,k)-nragg(i,k))*omsm + + nragg(i,k)=nragg(i,k)*ratio + npracs(i,k)=npracs(i,k)*ratio + nnuccr(i,k)=nnuccr(i,k)*ratio + nsubr(i,k)=nsubr(i,k)*ratio + nnuccri(i,k)=nnuccri(i,k)*ratio + end if + end do + + if (do_cldice) then + + do i=1,mgncol + + ! conservation of qi + !------------------------------------------------------------------- + + dum = ((-mnuccc(i,k)-mnucct(i,k)-mnudep(i,k)-msacwi(i,k))*lcldm(i,k)+(prci(i,k)+ & + prai(i,k))*icldm(i,k)-mnuccri(i,k)*precip_frac(i,k) & + -ice_sublim(i,k)-vap_dep(i,k)-berg(i,k)-mnuccd(i,k))*deltat + + if (dum.gt.qi(i,k)+dqidt(i,k)*deltat+D_eros_i(i,k)*deltat) then + ratio = (qi(i,k)/deltat+max(dqidt(i,k),0.0)+vap_dep(i,k)+berg(i,k)+mnuccd(i,k)+ & + (mnuccc(i,k)+mnucct(i,k)+mnudep(i,k)+msacwi(i,k))*lcldm(i,k)+ & + mnuccri(i,k)*precip_frac(i,k))/ & + ((prci(i,k)+prai(i,k))*icldm(i,k)-ice_sublim(i,k)-D_eros_i(i,k)+max(-dqidt(i,k),0.0))*omsm + + if( dqidt(i,k) < 0.0 ) dqidt(i,k)=dqidt(i,k)*ratio + if( ratio > 1) print*,"error ratio>1 in conservation of qi",i,k,ratio + if( ratio < 0) then + print*,"error ratio<0 in conservation of qi",i,k, lon(i), lat(i), it + print*,"dum=", dum, qi(i,k), dqidt(i,k), D_eros_i(i,k), deltat + print*,"conv of qi", -mnuccc(i,k), -mnucct(i,k), -mnudep(i,k), -msacwi(i,k), lcldm(i,k) + print*, "==", prci(i,k), prai(i,k), icldm(i,k), -mnuccri(i,k), precip_frac(i,k) + print*, "+++", -ice_sublim(i,k), -vap_dep(i,k), -berg(i,k), -mnuccd(i,k) + endif + + prci(i,k) = prci(i,k)*ratio + prai(i,k) = prai(i,k)*ratio + ice_sublim(i,k) = ice_sublim(i,k)*ratio + D_eros_i(i,k) = D_eros_i(i,k)*ratio + end if + end do + + end if + + if (do_cldice) then + + do i=1,mgncol + + ! conservation of ni + !------------------------------------------------------------------- + if (use_hetfrz_classnuc) then + tmpfrz = nnuccc(i,k) + else + tmpfrz = 0._r8 + end if + dum = ((-nnucct(i,k)-tmpfrz-nnudep(i,k)-nsacwi(i,k))*lcldm(i,k)+(nprci(i,k)+ & + nprai(i,k)-nsubi(i,k))*icldm(i,k)-nnuccri(i,k)*precip_frac(i,k) - nnuccd(i,k) )*deltat + + if (dum.gt.ni(i,k)+nerosi(i,k)*icldm(i,k)*deltat) then + ratio = (ni(i,k)/deltat+ nnuccd(i,k)+& + (nnucct(i,k)+tmpfrz+nnudep(i,k)+nsacwi(i,k))*lcldm(i,k)+ & + nnuccri(i,k)*precip_frac(i,k))/ & + ((nprci(i,k)+nprai(i,k)-nsubi(i,k)-nerosi(i,k))*icldm(i,k))*omsm + nprci(i,k) = nprci(i,k)*ratio + nprai(i,k) = nprai(i,k)*ratio + nsubi(i,k) = nsubi(i,k)*ratio + nerosi(i,k)= nerosi(i,k)*ratio + end if + end do + end if + + do i=1,mgncol + + ! conservation of snow mixing ratio + !------------------------------------------------------------------- + dum = (-(prds(i,k)+pracs(i,k)+mnuccr(i,k))*precip_frac(i,k)-(prai(i,k)+prci(i,k))*icldm(i,k) & + -(bergs(i,k)+psacws(i,k))*lcldm(i,k))*deltat + + if (dum.gt.qs(i,k).and.-prds(i,k).ge.qsmall) then + ratio = (qs(i,k)/deltat+(prai(i,k)+prci(i,k))*icldm(i,k)+ & + (bergs(i,k)+psacws(i,k))*lcldm(i,k)+(pracs(i,k)+mnuccr(i,k))*precip_frac(i,k))/ & + precip_frac(i,k)/(-prds(i,k))*omsm + prds(i,k)=prds(i,k)*ratio + end if + + end do + + do i=1,mgncol + + ! conservation of snow number + !------------------------------------------------------------------- + ! calculate loss of number due to sublimation + ! for now neglect sublimation of ns + +!--> h1g, 2019-12-03 + if (allow_snow_num_sublimation) then + if (prds(i,k) < 0._r8 .and. qs(i,k) > qsmall ) then + dum = prds(i,k)*deltat/qs(i,k) + dum = max(-1._r8,dum) + nsubs(i,k) = dum*ns(i,k)/deltat + else + nsubs(i,k)=0._r8 + endif + else + ! neglect sublimation of ns, allow_snow_num_sublimation = .false. h1g, 2019-12-03 + nsubs(i,k)=0._r8 + endif +!<-- h1g, 2019-12-03 + + + dum = ((-nsagg(i,k)-nsubs(i,k)-nnuccr(i,k))*precip_frac(i,k)-nprci(i,k)*icldm(i,k))*deltat + + if (dum.gt.ns(i,k)) then + ratio = (ns(i,k)/deltat+nnuccr(i,k)* & + precip_frac(i,k)+nprci(i,k)*icldm(i,k))/precip_frac(i,k)/ & + (-nsubs(i,k)-nsagg(i,k))*omsm + nsubs(i,k)=nsubs(i,k)*ratio + nsagg(i,k)=nsagg(i,k)*ratio + end if + + end do + + do i=1,mgncol + + ! next limit ice and snow sublimation and rain evaporation + ! get estimate of q and t at end of time step + ! don't include other microphysical processes since they haven't + ! been limited via conservation checks yet + + if ((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k) < -1.e-20_r8) then + + qtmp=q(i,k)-(ice_sublim(i,k)+vap_dep(i,k)+mnuccd(i,k)+ & + (pre(i,k)+prds(i,k))*precip_frac(i,k))*deltat + ttmp=t(i,k)+((pre(i,k)*precip_frac(i,k))*xxlv+ & + (prds(i,k)*precip_frac(i,k)+vap_dep(i,k)+ice_sublim(i,k)+mnuccd(i,k))*xxls)*deltat/cpp + + if ( ttmp .lt.-150.0+273.15 .or. ttmp .gt.90+273.15) & + write(*,'(a, i4, 2f9.4, 15e12.3)') 'MG2: bad temperature@2117', k, lon(i), lat(i), & + ttmp, t(i,k), pre(i,k), precip_frac(i,k), prds(i,k),vap_dep(i,k), ice_sublim(i,k), mnuccd(i,k), & + qtmp, q(i,k), p(i,k) + + ! use rhw to allow ice supersaturation + call compute_qs(ttmp, p(i,k), qvn, q = q(i,k), & + esat = esn, es_over_liq = .true.) + + ! modify ice/precip evaporation rate if q > qsat + if (qtmp > qvn) then + + dum1=pre(i,k)*precip_frac(i,k)/((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k)) + dum2=prds(i,k)*precip_frac(i,k)/((pre(i,k)+prds(i,k))*precip_frac(i,k)+ice_sublim(i,k)) + ! recalculate q and t after vap_dep and mnuccd but without evap or sublim + qtmp=q(i,k)-(vap_dep(i,k)+mnuccd(i,k))*deltat + ttmp=t(i,k)+((vap_dep(i,k)+mnuccd(i,k))*xxls)*deltat/cpp + + ! use rhw to allow ice supersaturation + call compute_qs(ttmp, p(i,k), qvn, q = q(i,k), & + esat = esn, es_over_liq = .true.) + + dum=(qtmp-qvn)/(1._r8 + xxlv_squared*qvn/(cpp*rv*ttmp**2)) + dum=min(dum,0._r8) + + ! modify rates if needed, divide by precip_frac to get local (in-precip) value + pre(i,k)=dum*dum1/deltat/precip_frac(i,k) + + ! do separately using RHI for prds and ice_sublim + call compute_qs(ttmp, p(i,k), qvn, q = q(i,k), & + esat = esn, es_over_liq_and_ice = .true. ) + + dum=(qtmp-qvn)/(1._r8 + xxls_squared*qvn/(cpp*rv*ttmp**2)) + dum=min(dum,0._r8) + + ! modify rates if needed, divide by precip_frac to get local (in-precip) value + prds(i,k) = dum*dum2/deltat/precip_frac(i,k) + + ! don't divide ice_sublim by cloud fraction since it is grid-averaged + dum1 = (1._r8-dum1-dum2) + ice_sublim(i,k) = dum*dum1/deltat + end if + end if + + end do + + ! Big "administration" loop enforces conservation, updates variables + ! that accumulate over substeps, and sets output variables. + + do i=1,mgncol + + ! get tendencies due to microphysical conversion processes + !========================================================== + ! note: tendencies are multiplied by appropriate cloud/precip + ! fraction to get grid-scale values + ! note: vap_dep is already grid-average values + + ! The net tendencies need to be added to rather than overwritten, + ! because they may have a value already set for instantaneous + ! melting/freezing. + + qvlat(i,k) = qvlat(i,k)-dqcdt(i,k)-dqidt(i,k)-(pre(i,k)+prds(i,k))*precip_frac(i,k)-& + vap_dep(i,k)-ice_sublim(i,k)-mnuccd(i,k)-mnudep(i,k)*lcldm(i,k) - D_eros_l(i,k) - D_eros_i(i,k) + + ! if ( i==7 .and. k==31 ) print*,'2001 tlat= ', i,k, 'dqcdt',dqcdt(i,k), 'D_eros_l',D_eros_l(i,k), & + ! 'D_eros_i', D_eros_i(i,k), & + ! 'pre',pre(i,k), 'precip_frac', precip_frac(i,k), & + ! 'prds', prds(i,k), 'vap_dep', vap_dep(i,k), & + ! 'ice_sublim', ice_sublim(i,k), 'mnuccd', mnuccd(i,k),& + ! 'mnudep', mnudep(i,k), 'bergs',bergs(i,k), & + ! 'psacws',psacws(i,k), 'mnuccc', mnuccc(i,k), & + ! 'mnucct', mnucct(i,k), 'msacwi',msacwi(i,k), & + ! 'mnuccr',mnuccr(i,k), 'pracs',pracs(i,k), & + ! 'mnuccri',mnuccri(i,k), 'berg', berg(i,k) + + tlat(i,k) = tlat(i,k)+dqcdt(i,k)*xxlv+D_eros_l(i,k)*xxlv+dqidt(i,k)*xxls+D_eros_i(i,k)*xxls+ & + ((pre(i,k)*precip_frac(i,k))*xxlv & + +(prds(i,k)*precip_frac(i,k)+vap_dep(i,k)+ice_sublim(i,k)+mnuccd(i,k)+mnudep(i,k)*lcldm(i,k))*xxls+ & + ((bergs(i,k)+psacws(i,k)+mnuccc(i,k)+mnucct(i,k)+msacwi(i,k))*lcldm(i,k)+(mnuccr(i,k)+ & + pracs(i,k)+mnuccri(i,k))*precip_frac(i,k)+berg(i,k))*xlf) + + qctend(i,k) = qctend(i,k)+dqcdt(i,k)+D_eros_l(i,k)+ & + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & + psacws(i,k)-bergs(i,k))*lcldm(i,k)-berg(i,k) + + if (do_cldice) then +! Note by h1g 2017-02-24, mnudep = 0.0 be default ( use_hetfrz_classnuc = .false. ) + qitend(i,k) = qitend(i,k)+dqidt(i,k)+D_eros_i(i,k)+ & + (mnuccc(i,k)+mnucct(i,k)+mnudep(i,k)+msacwi(i,k))*lcldm(i,k)+(-prci(i,k)- & + prai(i,k))*icldm(i,k)+vap_dep(i,k)+berg(i,k)+ice_sublim(i,k)+ & + mnuccd(i,k)+mnuccri(i,k)*precip_frac(i,k) + end if + + qrtend(i,k) = qrtend(i,k)+ & + (pra(i,k)+prc(i,k))*lcldm(i,k)+(pre(i,k)-pracs(i,k)- & + mnuccr(i,k)-mnuccri(i,k))*precip_frac(i,k) + + qstend(i,k) = qstend(i,k)+ & + (prai(i,k)+prci(i,k))*icldm(i,k)+(psacws(i,k)+bergs(i,k))*lcldm(i,k)+(prds(i,k)+ & + pracs(i,k)+mnuccr(i,k))*precip_frac(i,k) + + cmeout(i,k) = cmeout(i,k) + vap_dep(i,k) + ice_sublim(i,k) + mnuccd(i,k) + + ! add output for cmei (accumulate) + cmeitot(i,k) = cmeitot(i,k) + vap_dep(i,k) + ice_sublim(i,k) + mnuccd(i,k) + dqidt(i,k) + + ! assign variables for trop_mozart, these are grid-average + !------------------------------------------------------------------- + ! evaporation/sublimation is stored here as positive term + +!--> h1g, 2019-12-06 + evapsnow(i,k) = evapsnow(i,k) - prds(i,k)*precip_frac(i,k) + nevapr(i,k) = nevapr(i,k) - pre(i,k)*precip_frac(i,k) +!<-- h1g, 2019-12-06 + + ! change to make sure prain is positive: do not remove snow from + ! prain used for wet deposition + prain(i,k) = prain(i,k)+(pra(i,k)+prc(i,k))*lcldm(i,k)+(-pracs(i,k)- & + mnuccr(i,k)-mnuccri(i,k))*precip_frac(i,k) + prodsnow(i,k) = prodsnow(i,k)+(prai(i,k)+prci(i,k))*icldm(i,k)+(psacws(i,k)+bergs(i,k))*lcldm(i,k)+(& + pracs(i,k)+mnuccr(i,k))*precip_frac(i,k) + + ! following are used to calculate 1st order conversion rate of cloud water + ! to rain and snow (1/s), for later use in aerosol wet removal routine + ! previously, wetdepa used (prain/qc) for this, and the qc in wetdepa may be smaller than the qc + ! used to calculate pra, prc, ... in this routine + ! qcsinksum_rate1ord = { rate of direct transfer of cloud water to rain & snow } + ! (no cloud ice or bergeron terms) +!--> h1g, 2019-12-06 + qcsinksum_rate1ord(i,k) = qcsinksum_rate1ord(i,k) + (pra(i,k)+prc(i,k)+psacws(i,k))*lcldm(i,k) + ! Avoid zero/near-zero division. + ! qcsinksum_rate1ord(i,k) = qcsinksum_rate1ord(i,k) / & + ! max(qc(i,k),1.0e-30_r8) +!<-- h1g, 2019-12-06 + + preo(i,k) = preo(i,k) + pre(i,k)*precip_frac(i,k) + prdso(i,k) = prdso(i,k) + prds(i,k)*precip_frac(i,k) + + eroslo(i,k) = eroslo(i,k) + D_eros_l(i,k) + erosio(i,k) = erosio(i,k) + D_eros_i(i,k) + + cmelo(i,k) = cmelo(i,k) + dqcdt(i,k) + + ! microphysics output, note this is grid-averaged + pratot(i,k) = pratot(i,k)+pra(i,k)*lcldm(i,k) + prctot(i,k) = prctot(i,k)+prc(i,k)*lcldm(i,k) + mnuccctot(i,k) = mnuccctot(i,k)+mnuccc(i,k)*lcldm(i,k) + mnuccttot(i,k) = mnuccttot(i,k)+mnucct(i,k)*lcldm(i,k) + mnuccdtot(i,k) = mnuccdtot(i,k)+mnuccd(i,k) + + msacwitot(i,k) = msacwitot(i,k)+msacwi(i,k)*lcldm(i,k) + psacwstot(i,k) = psacwstot(i,k)+psacws(i,k)*lcldm(i,k) + bergstot(i,k) = bergstot(i,k)+bergs(i,k)*lcldm(i,k) + bergtot(i,k) = bergtot(i,k)+berg(i,k) + prcitot(i,k) = prcitot(i,k)+prci(i,k)*icldm(i,k) + praitot(i,k) = praitot(i,k)+prai(i,k)*icldm(i,k) + + pracstot(i,k) = pracstot(i,k)+pracs(i,k)*precip_frac(i,k) + mnuccrtot(i,k) = mnuccrtot(i,k)+mnuccr(i,k)*precip_frac(i,k) + mnuccritot(i,k) = mnuccritot(i,k)+mnuccri(i,k)*precip_frac(i,k) ! h1g, 2020-02-11 + + nctend(i,k) = nctend(i,k)+nerosc(i,k)*lcldm(i,k) + npccn2(i,k) + & + (-nnuccc(i,k)-nnucct(i,k)-npsacws(i,k)+nsubc(i,k) & + -npra(i,k)-nprc1(i,k))*lcldm(i,k) + + if (do_cldice) then + if (use_hetfrz_classnuc) then + tmpfrz = nnuccc(i,k) + else + tmpfrz = 0._r8 + end if + nitend(i,k) = nitend(i,k)+nerosi(i,k)*icldm(i,k)+ nnuccd(i,k)+& + (nnucct(i,k)+tmpfrz+nnudep(i,k)+nsacwi(i,k))*lcldm(i,k)+(nsubi(i,k)-nprci(i,k)- & + nprai(i,k))*icldm(i,k)+nnuccri(i,k)*precip_frac(i,k) + end if + + nstend(i,k) = nstend(i,k)+(nsubs(i,k)+ & + nsagg(i,k)+nnuccr(i,k))*precip_frac(i,k)+nprci(i,k)*icldm(i,k) + + nrtend(i,k) = nrtend(i,k)+ & + nprc(i,k)*lcldm(i,k)+(nsubr(i,k)-npracs(i,k)-nnuccr(i,k) & + -nnuccri(i,k)+nragg(i,k))*precip_frac(i,k) + + ! make sure that ni at advanced time step does not exceed + ! maximum (existing N + source terms*dt), which is possible if mtime < deltat + ! note that currently mtime = deltat + !================================================================ + +! ---> h1g, 2017-03-03 + IF (diag_id%qnidt_nucclim1 + diag_id%qni_nucclim1_col > 0) & + diag_4l(i,j,k,diag_pt%qnidt_nucclim1) = nitend(i,k) + + if (do_cldice .and. nitend(i,k).gt.0._r8.and.ni(i,k)+nitend(i,k)*deltat.gt.nimax(i,k)) then + ! nitend(i,k)=max(0._r8,(nimax(i,k)-ni(i,k))/deltat) + end if + + IF (diag_id%qnidt_nucclim1 + diag_id%qni_nucclim1_col > 0) & + diag_4l(i,j,k,diag_pt%qnidt_nucclim1) = nitend(i,k) - diag_4l(i,j,k,diag_pt%qnidt_nucclim1) +! <--- h1g, 2017-03-03 + + end do + + ! End of "administration" loop + + end do micro_vert_loop ! end k loop + + !----------------------------------------------------- + ! convert rain/snow q and N for output to history, note, + ! output is for gridbox average + + qrout = qrout + qr + nrout = nrout + nr * rho + qsout = qsout + qs + nsout = nsout + ns * rho + + ! calculate n0r and lamr from rain mass and number + ! divide by precip fraction to get in-precip (local) values of + ! rain mass and number, divide by rhow to get rain number in kg^-1 + + do k=1,nlev + + call size_dist_param_basic(mg_rain_props, qric(:,k), nric(:,k), lamr(:,k), mgncol, n0=n0r(:,k)) + + ! Calculate rercld + + ! calculate mean size of combined rain and cloud water + + call calc_rercld(lamr(:,k), n0r(:,k), lamc(:,k), pgam(:,k), qric(:,k), qcic(:,k), ncic(:,k), & + rercld(:,k), mgncol) + + enddo + + ! Assign variables back to start-of-timestep values + ! Some state variables are changed before the main microphysics loop + ! to make "instantaneous" adjustments. Afterward, we must move those changes + ! back into the tendencies. + ! These processes: + ! - Droplet activation (npccn, impacts nc) + ! - Instantaneous snow melting (minstsm/ninstsm, impacts qr/qs/nr/ns) + ! - Instantaneous rain freezing (minstfr/ninstrf, impacts qr/qs/nr/ns) + !================================================================================ + + ! Re-apply droplet activation tendency + ! nc = ncn + ! nctend = nctend + npccn2 + + ! ni = nin + ! nitend = nitend + nnuccd + + + ! Re-apply rain freezing and snow melting. + dum_2D = qs + qs = qstmp + qstend = qstend + (dum_2D-qs)/deltat + if (diag_id%snow_inst + diag_id%snow_inst_col > 0) & + diag_4l(:,j,:,diag_pt%snow_inst ) = diag_4l(:,j,:,diag_pt%snow_inst )+(dum_2D-qs)/deltat + + dum_2D = ns + ns = nstmp + nstend = nstend + (dum_2D-ns)/deltat + if (diag_id%snow_num_inst + diag_id%snow_num_inst_col > 0) & + diag_4l(:,j,:,diag_pt%snow_num_inst ) = diag_4l(:,j,:,diag_pt%snow_num_inst)+(dum_2D-ns)/deltat + + dum_2D = qr + qr = qrtmp + qrtend = qrtend + (dum_2D-qr)/deltat + if (diag_id%rain_inst + diag_id%rain_inst_col > 0) & + diag_4l(:,j,:,diag_pt%rain_inst ) = diag_4l(:,j,:,diag_pt%rain_inst )+(dum_2D-qr)/deltat + + + dum_2D = nr + nr = nrtmp + nrtend = nrtend + (dum_2D-nr)/deltat + if (diag_id%rain_num_inst + diag_id%rain_num_inst_col > 0) & + diag_4l(:,j,:,diag_pt%rain_num_inst ) = diag_4l(:,j,:,diag_pt%rain_num_inst )+(dum_2D-nr)/deltat + + !............................................................................. + !================================================================================ + ! modify to include snow. in prain & evap (diagnostic here: for wet dep) + nevapr = nevapr + evapsnow + prain = prain + prodsnow + + + + + + do k=1,nlev + do i=1,mgncol + + ! calculate sedimentation for cloud water and ice + !================================================================================ + + ! update in-cloud cloud mixing ratio and number concentration + ! with microphysical tendencies to calculate sedimentation, assign to dummy vars + ! note: these are in-cloud values***, hence we divide by cloud fraction + + dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat)/lcldm(i,k) + dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat)/icldm(i,k) + dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat)/lcldm(i,k),0._r8) + dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat)/icldm(i,k),0._r8) + + dumr(i,k) = (qr(i,k)+qrtend(i,k)*deltat)/precip_frac(i,k) + dumnr(i,k) = max((nr(i,k)+nrtend(i,k)*deltat)/precip_frac(i,k),0._r8) + dums(i,k) = (qs(i,k)+qstend(i,k)*deltat)/precip_frac(i,k) + dumns(i,k) = max((ns(i,k)+nstend(i,k)*deltat)/precip_frac(i,k),0._r8) + + + ! switch for specification of droplet and crystal number + if (nccons) then + dumnc(i,k)=ncnst/rho(i,k) + end if + + ! switch for specification of cloud ice number + if (nicons) then + dumni(i,k)=ninst/rho(i,k) + end if + enddo + enddo + + do k=1,nlev + + ! obtain new slope parameter to avoid possible singularity + + call size_dist_param_basic(mg_ice_props, dumi(:,k), dumni(:,k), & + lami(:,k), mgncol) + + call size_dist_param_liq(mg_liq_props, dumc(:,k), dumnc(:,k), rho(:,k), & + pgam(:,k), lamc(:,k), mgncol) + + enddo + + do k=1,nlev + do i=1,mgncol + + ! calculate number and mass weighted fall velocity for droplets and cloud ice + !------------------------------------------------------------------- + + + if (dumc(i,k).ge.qsmall) then + + vtrmc(i,k)=acn(i,k)*gamma(4._r8+bc+pgam(i,k))/ & + (lamc(i,k)**bc*gamma(pgam(i,k)+4._r8)) + + fc(i,k) = g*rho(i,k)*vtrmc(i,k) + + fnc(i,k) = g*rho(i,k)* & + acn(i,k)*gamma(1._r8+bc+pgam(i,k))/ & + (lamc(i,k)**bc*gamma(pgam(i,k)+1._r8)) + else + fc(i,k) = 0._r8 + fnc(i,k)= 0._r8 + end if + + ! calculate number and mass weighted fall velocity for cloud ice + + if (dumi(i,k).ge.qsmall) then + + vtrmi(i,k)=min(ain(i,k)*gamma_bi_plus4/(6._r8*lami(i,k)**bi), & + 1.2_r8*rhof(i,k)) + + fi(i,k) = g*rho(i,k)*vtrmi(i,k) + fni(i,k) = g*rho(i,k)* & + min(ain(i,k)*gamma_bi_plus1/lami(i,k)**bi,1.2_r8*rhof(i,k)) + + ! adjust the ice fall velocity for smaller (r < 20 um) ice + ! particles (blend over 18-20 um) + irad = 1.5_r8 / lami(i,k) * 1e6_r8 + ifrac = min(1._r8, max(0._r8, (irad - 18._r8) / 2._r8)) + + if (ifrac .lt. 1._r8) then + vtrmi(i,k) = ifrac * vtrmi(i,k) + & + (1._r8 - ifrac) * & + min(ajn(i,k)*gamma_bj_plus4/(6._r8*lami(i,k)**bj), & + 1.2_r8*rhof(i,k)) + + fi(i,k) = g*rho(i,k)*vtrmi(i,k) + fni(i,k) = ifrac * fni(i,k) + & + (1._r8 - ifrac) * & + g*rho(i,k)* & + min(ajn(i,k)*gamma_bj_plus1/lami(i,k)**bj,1.2_r8*rhof(i,k)) + end if + else + fi(i,k) = 0._r8 + fni(i,k)= 0._r8 + end if + + enddo + + enddo + + + do k=1,nlev + + ! fallspeed for rain + + call size_dist_param_basic(mg_rain_props, dumr(:,k), dumnr(:,k), & + lamr(:,k), mgncol) + enddo + + do k=1,nlev + + do i=1,mgncol + if (lamr(i,k).ge.qsmall) then + + ! 'final' values of number and mass weighted mean fallspeed for rain (m/s) + + unr(i,k) = min(arn(i,k)*gamma_br_plus1/lamr(i,k)**br,9.1_r8*rhof(i,k)) + umr(i,k) = min(arn(i,k)*gamma_br_plus4/(6._r8*lamr(i,k)**br),9.1_r8*rhof(i,k)) + + fr(i,k) = g*rho(i,k)*umr(i,k) + fnr(i,k) = g*rho(i,k)*unr(i,k) + + else + fr(i,k)=0._r8 + fnr(i,k)=0._r8 + end if + + ! fallspeed for snow + + call size_dist_param_basic(mg_snow_props, dums(i,k), dumns(i,k), & + lams(i,k)) + + if (lams(i,k).ge.qsmall) then + + ! 'final' values of number and mass weighted mean fallspeed for snow (m/s) + ums(i,k) = min(asn(i,k)*gamma_bs_plus4/(6._r8*lams(i,k)**bs),1.2_r8*rhof(i,k)) + uns(i,k) = min(asn(i,k)*gamma_bs_plus1/lams(i,k)**bs,1.2_r8*rhof(i,k)) + + fs(i,k) = g*rho(i,k)*ums(i,k) + fns(i,k) = g*rho(i,k)*uns(i,k) + + else + fs(i,k)=0._r8 + fns(i,k)=0._r8 + end if + + ! redefine dummy variables - sedimentation is calculated over grid-scale + ! quantities to ensure conservation + + dumc(i,k) = (qc(i,k)+qctend(i,k)*deltat) + dumnc(i,k) = max((nc(i,k)+nctend(i,k)*deltat),0._r8) + dumi(i,k) = (qi(i,k)+qitend(i,k)*deltat) + dumni(i,k) = max((ni(i,k)+nitend(i,k)*deltat),0._r8) + dumr(i,k) = (qr(i,k)+qrtend(i,k)*deltat) + dumnr(i,k) = max((nr(i,k)+nrtend(i,k)*deltat),0._r8) + dums(i,k) = (qs(i,k)+qstend(i,k)*deltat) + dumns(i,k) = max((ns(i,k)+nstend(i,k)*deltat),0._r8) + + if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8 + if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8 + if (dumr(i,k).lt.qsmall) dumnr(i,k)=0._r8 + if (dums(i,k).lt.qsmall) dumns(i,k)=0._r8 + + enddo + end do !!! vertical loop + +if ( do_implicit_fall ) then + fc = vfac_drop * fc/g/rho + fnc = vfac_drop * fnc/g/rho + fi = vfac_ice * fi/g/rho + fni = vfac_ice * fni/g/rho + + fr = vfactor * fr/g/rho + fnr = vfactor * fnr/g/rho + fs = vfactor * fs/g/rho + fns = vfactor * fns/g/rho + + ! cloud water (mass) sedimentation + do i=1,mgncol + dum_1D(:) = dumc(i,:) + call implicit_fall ( deltat, 1, nlev, zhalf(i,:) , fc(i,:), pdel(i,:), dum_1D, precip, flx) + do k=1,nlev + lflx(i,k+1) = lflx(i,k+1) + flx(k)/g/deltat + qcsedten(i,k)= qcsedten(i,k) + (dum_1D(k) - dumc(i,k))/deltat + qctend(i,k) = qctend(i,k) + (dum_1D(k) - dumc(i,k))/deltat + enddo + if ( precip .ge. 0.0 ) then !h1g, 2019-11-26, ensure numerical stability + prect(i) = prect(i)+precip/g/deltat/1000._r8 + endif + enddo + + ! cloud water (number) sedimentation + do i=1,mgncol + dum_1D(:) = dumnc(i,:) + call implicit_fall ( deltat, 1, nlev, zhalf(i,:) , fnc(i,:), pdel(i,:), dum_1D, precip, flx) + do k=1,nlev + nctend(i,k) = nctend(i,k) + (dum_1D(k) - dumnc(i,k))/deltat + IF ( diag_id%qndt_sedi + diag_id%qn_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%qndt_sedi) = & + diag_4l(i,j,k,diag_pt%qndt_sedi) + (dum_1D(k) - dumnc(i,k))/deltat + enddo + enddo + + ! cloud ice (mass) sedimentation + do i=1,mgncol + dum_1D(:) = dumi(i,:) + call implicit_fall ( deltat, 1, nlev, zhalf(i,:) , fi(i,:), pdel(i,:), dum_1D, precip, flx) + do k=1,nlev + iflx(i,k+1) = iflx(i,k+1) + flx(k)/g/deltat + qisedten(i,k)= qisedten(i,k) + (dum_1D(k) - dumi(i,k))/deltat + qitend(i,k) = qitend(i,k) + (dum_1D(k) - dumi(i,k))/deltat + enddo + if ( precip .ge. 0.0 ) then !h1g, 2019-11-26, ensure numerical stability + prect(i) = prect(i) + precip/g/deltat/1000._r8 + preci(i) = preci(i) + precip/g/deltat/1000._r8 + endif + enddo + + ! cloud ice (number) sedimentation + do i=1,mgncol + dum_1D(:) = dumni(i,:) + call implicit_fall ( deltat, 1, nlev, zhalf(i,:) , fni(i,:), pdel(i,:), dum_1D, precip, flx) + do k=1,nlev + nitend(i,k) = nitend(i,k) + (dum_1D(k) - dumni(i,k))/deltat + IF ( diag_id%qnidt_sedi + diag_id%qni_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%qnidt_sedi) = & + diag_4l(i,j,k,diag_pt%qnidt_sedi) + (dum_1D(k) - dumni(i,k))/deltat + enddo + enddo + + ! rain water (mass) sedimentation + do i=1,mgncol + dum_1D(:) = dumr(i,:) + call implicit_fall ( deltat, 1, nlev, zhalf(i,:) , fr(i,:), pdel(i,:), dum_1D, precip, flx) + do k=1,nlev + if ( flx(k) .ge. qsmall ) rflx(i,k+1) = rflx(i,k+1) + flx(k)/g/deltat !h1g, 2019-11-26, ensure numerical stability + qrsedten(i,k)= qrsedten(i,k) + (dum_1D(k) - dumr(i,k))/deltat + qrtend (i,k) = qrtend(i,k) + (dum_1D(k) - dumr(i,k))/deltat + enddo + if ( precip .ge. 0.0 ) then !h1g, 2019-11-26, ensure numerical stability + prect(i) = prect(i)+precip/g/deltat/1000._r8 + endif + enddo + + ! rain water (number) sedimentation + do i=1,mgncol + dum_1D(:) = dumnr(i,:) + call implicit_fall ( deltat, 1, nlev, zhalf(i,:) , fnr(i,:), pdel(i,:), dum_1D, precip, flx) + do k=1,nlev + nrtend(i,k) = nrtend(i,k) + (dum_1D(k) - dumnr(i,k))/deltat + IF ( diag_id%rain_num_sedi + diag_id%rain_num_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%rain_num_sedi) = & + diag_4l(i,j,k,diag_pt%rain_num_sedi) + (dum_1D(k) - dumnr(i,k))/deltat + enddo + enddo + + + ! snow water (mass) sedimentation + do i=1,mgncol + dum_1D(:) = dums(i,:) + call implicit_fall ( deltat, 1, nlev, zhalf(i,:) , fs(i,:), pdel(i,:), dum_1D, precip, flx) + do k=1,nlev + if ( flx(k) .ge. qsmall ) sflx(i,k+1) = sflx(i,k+1) + flx(k)/g/deltat !h1g, 2019-11-26, ensure numerical stability + qssedten(i,k)= qssedten(i,k) + (dum_1D(k) - dums(i,k))/deltat + qstend(i,k) = qstend(i,k) + (dum_1D(k) - dums(i,k))/deltat + enddo + if ( precip .ge. 0.0 ) then !h1g, 2019-11-26, ensure numerical stability + prect(i) = prect(i)+precip/g/deltat/1000._r8 + preci(i) = preci(i)+precip/g/deltat/1000._r8 + endif + enddo + ! snow water (number) sedimentation + do i=1,mgncol + dum_1D(:) = dumns(i,:) + call implicit_fall ( deltat, 1, nlev, zhalf(i,:) , fns(i,:), pdel(i,:), dum_1D, precip, flx) + do k=1,nlev + nstend(i,k) = nstend(i,k) + (dum_1D(k) - dumns(i,k))/deltat + IF ( diag_id%snow_num_sedi + diag_id%snow_num_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%snow_num_sedi) = & + diag_4l(i,j,k,diag_pt%snow_num_sedi) + (dum_1D(k) - dumns(i,k))/deltat + enddo + enddo + +else + + do k=1,nlev + do i=1,mgncol + pdel_inv(i,k) = 1._r8/pdel(i,k) + enddo + enddo + + ! initialize nstep for sedimentation sub-steps + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + !------------------------------------------------------------------- + + do i=1,mgncol + + nstep = 1 + int(max( & + maxval( fi(i,:)*pdel_inv(i,:)), & + maxval(fni(i,:)*pdel_inv(i,:))) & + * deltat) + +! if ( mpp_pe() == mpp_root_pe() ) & +! write(*, *) "nstep = ", nstep + + + ! loop over sedimentation sub-time step to ensure stability + !============================================================== + do n = 1,nstep + + if (do_cldice) then + falouti = fi(i,:) * dumi(i,:) + faloutni = fni(i,:) * dumni(i,:) + else + falouti = 0._r8 + faloutni = 0._r8 + end if + + ! top of model + k = 1 + + ! add fallout terms to microphysical tendencies + faltndi = falouti(k)/pdel(i,k) + faltndni = faloutni(k)/pdel(i,k) + qitend(i,k) = qitend(i,k)-faltndi/nstep + nitend(i,k) = nitend(i,k)-faltndni/nstep + + ! sedimentation tendency for output + qisedten(i,k)=qisedten(i,k)-faltndi/nstep + IF ( diag_id%qnidt_sedi + diag_id%qni_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%qnidt_sedi) = & + diag_4l(i,j,k,diag_pt%qnidt_sedi) - faltndni/nstep + + dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep + dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep + + do k = 2,nlev + + ! for cloud liquid and ice, if cloud fraction increases with height + ! then add flux from above to both vapor and cloud water of current level + ! this means that flux entering clear portion of cell from above evaporates + ! instantly + + ! note: this is not an issue with precip, since we assume max overlap + dum1=icldm(i,k)/icldm(i,k-1) + dum1=min(dum1,1._r8) + +!--> h1g, 2019-12-18 + if ( no_evap_in_sedimentation ) dum1 = 1.0 +!<-- h1g, 2019-12-18 + + faltndqie=(falouti(k)-falouti(k-1))/pdel(i,k) + + faltndi=(falouti(k)-dum1*falouti(k-1))/pdel(i,k) + faltndni=(faloutni(k)-dum1*faloutni(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + + qitend(i,k) = qitend(i,k)-faltndi/nstep + nitend(i,k) = nitend(i,k)-faltndni/nstep + + ! sedimentation tendency for output + qisedten(i,k)=qisedten(i,k)-faltndi/nstep + IF ( diag_id%qnidt_sedi + diag_id%qni_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%qnidt_sedi) = & + diag_4l(i,j,k,diag_pt%qnidt_sedi) - faltndni/nstep + + ! add terms to to evap/sub of cloud water + + qvlat(i,k)=qvlat(i,k)-(faltndqie-faltndi)/nstep + ! for output + qisevap(i,k)=qisevap(i,k)-(faltndqie-faltndi)/nstep + tlat(i,k)=tlat(i,k)+(faltndqie-faltndi)*xxls/nstep + + dumi(i,k) = dumi(i,k)-faltndi*deltat/nstep + dumni(i,k) = dumni(i,k)-faltndni*deltat/nstep + + end do + + ! Ice flux + do k = 1,nlev + iflx(i,k+1) = iflx(i,k+1) + falouti(k) / g / real(nstep) + end do + + ! units below are m/s + ! sedimentation flux at surface is added to precip flux at surface + ! to get total precip (cloud + precip water) rate + + prect(i) = prect(i)+falouti(nlev)/g/real(nstep)/1000._r8 + preci(i) = preci(i)+falouti(nlev)/g/real(nstep)/1000._r8 + end do + + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + !------------------------------------------------------------------- + nstep = 1 + int(max( & + maxval( fc(i,:)*pdel_inv(i,:)), & + maxval(fnc(i,:)*pdel_inv(i,:))) & + * deltat) + + ! loop over sedimentation sub-time step to ensure stability + !============================================================== + do n = 1,nstep + + faloutc = fc(i,:) * dumc(i,:) + faloutnc = fnc(i,:) * dumnc(i,:) + + ! top of model + k = 1 + + ! add fallout terms to microphysical tendencies + faltndc = faloutc(k)/pdel(i,k) + faltndnc = faloutnc(k)/pdel(i,k) + qctend(i,k) = qctend(i,k)-faltndc/nstep + nctend(i,k) = nctend(i,k)-faltndnc/nstep + + ! sedimentation tendency for output + qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep + + IF ( diag_id%qndt_sedi + diag_id%qn_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%qndt_sedi) = & + diag_4l(i,j,k,diag_pt%qndt_sedi) - faltndnc/nstep + + + dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep + dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep + + do k = 2,nlev + + dum=lcldm(i,k)/lcldm(i,k-1) + dum=min(dum,1._r8) + +!--> h1g, 2019-12-18 + if ( no_evap_in_sedimentation ) dum = 1.0 +!<-- h1g, 2019-12-18 + + faltndqce=(faloutc(k)-faloutc(k-1))/pdel(i,k) + faltndc=(faloutc(k)-dum*faloutc(k-1))/pdel(i,k) + faltndnc=(faloutnc(k)-dum*faloutnc(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + qctend(i,k) = qctend(i,k)-faltndc/nstep + nctend(i,k) = nctend(i,k)-faltndnc/nstep + + ! sedimentation tendency for output + qcsedten(i,k)=qcsedten(i,k)-faltndc/nstep + IF ( diag_id%qndt_sedi + diag_id%qn_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%qndt_sedi) = & + diag_4l(i,j,k,diag_pt%qndt_sedi) - faltndnc/nstep + + + ! add terms to to evap/sub of cloud water + qvlat(i,k)=qvlat(i,k)-(faltndqce-faltndc)/nstep + ! for output + qcsevap(i,k)=qcsevap(i,k)-(faltndqce-faltndc)/nstep + tlat(i,k)=tlat(i,k)+(faltndqce-faltndc)*xxlv/nstep + + dumc(i,k) = dumc(i,k)-faltndc*deltat/nstep + dumnc(i,k) = dumnc(i,k)-faltndnc*deltat/nstep + + end do + + !Liquid condensate flux here + do k = 1,nlev + lflx(i,k+1) = lflx(i,k+1) + faloutc(k) / g / real(nstep) + end do + + prect(i) = prect(i)+faloutc(nlev)/g/real(nstep)/1000._r8 + end do + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + !------------------------------------------------------------------- + nstep = 1 + int(max( & + maxval( fr(i,:)*pdel_inv(i,:)), & + maxval(fnr(i,:)*pdel_inv(i,:))) & + * deltat) + + + ! loop over sedimentation sub-time step to ensure stability + !============================================================== + do n = 1,nstep + + faloutr = fr(i,:) * dumr(i,:) + faloutnr = fnr(i,:) * dumnr(i,:) + + ! top of model + k = 1 + ! add fallout terms to microphysical tendencies + faltndr = faloutr(k)/pdel(i,k) + faltndnr = faloutnr(k)/pdel(i,k) + qrtend(i,k) = qrtend(i,k)-faltndr/nstep + nrtend(i,k) = nrtend(i,k)-faltndnr/nstep + + ! sedimentation tendency for output + qrsedten(i,k)=qrsedten(i,k)-faltndr/nstep + IF ( diag_id%rain_num_sedi + diag_id%rain_num_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%rain_num_sedi) = & + diag_4l(i,j,k,diag_pt%rain_num_sedi) - faltndnr/nstep + + dumr(i,k) = dumr(i,k)-faltndr*deltat/real(nstep) + dumnr(i,k) = dumnr(i,k)-faltndnr*deltat/real(nstep) + + do k = 2,nlev + + faltndr=(faloutr(k)-faloutr(k-1))/pdel(i,k) + faltndnr=(faloutnr(k)-faloutnr(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + qrtend(i,k) = qrtend(i,k)-faltndr/nstep + nrtend(i,k) = nrtend(i,k)-faltndnr/nstep + + ! sedimentation tendency for output + qrsedten(i,k)=qrsedten(i,k)-faltndr/nstep + IF ( diag_id%rain_num_sedi + diag_id%rain_num_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%rain_num_sedi) = & + diag_4l(i,j,k,diag_pt%rain_num_sedi) - faltndnr/nstep + + dumr(i,k) = dumr(i,k)-faltndr*deltat/real(nstep) + dumnr(i,k) = dumnr(i,k)-faltndnr*deltat/real(nstep) + end do + + ! Rain Flux + do k = 1,nlev + rflx(i,k+1) = rflx(i,k+1) + faloutr(k) / g / real(nstep) + end do + prect(i) = prect(i)+faloutr(nlev)/g/real(nstep)/1000._r8 + + end do + + ! calculate number of split time steps to ensure courant stability criteria + ! for sedimentation calculations + !------------------------------------------------------------------- + nstep = 1 + int(max( & + maxval( fs(i,:)*pdel_inv(i,:)), & + maxval(fns(i,:)*pdel_inv(i,:))) & + * deltat) + + ! loop over sedimentation sub-time step to ensure stability + !============================================================== + do n = 1,nstep + + falouts = fs(i,:) * dums(i,:) + faloutns = fns(i,:) * dumns(i,:) + + ! top of model + k = 1 + + ! add fallout terms to microphysical tendencies + faltnds = falouts(k)/pdel(i,k) + faltndns = faloutns(k)/pdel(i,k) + qstend(i,k) = qstend(i,k)-faltnds/nstep + nstend(i,k) = nstend(i,k)-faltndns/nstep + + ! sedimentation tendency for output + qssedten(i,k)=qssedten(i,k)-faltnds/nstep + IF ( diag_id%snow_num_sedi + diag_id%snow_num_sedi_col > 0 ) & + diag_4l(i,j,k,diag_pt%snow_num_sedi) = & + diag_4l(i,j,k,diag_pt%snow_num_sedi) - faltndns/nstep + + dums(i,k) = dums(i,k)-faltnds*deltat/real(nstep) + dumns(i,k) = dumns(i,k)-faltndns*deltat/real(nstep) + + do k = 2,nlev + + faltnds=(falouts(k)-falouts(k-1))/pdel(i,k) + faltndns=(faloutns(k)-faloutns(k-1))/pdel(i,k) + + ! add fallout terms to eulerian tendencies + qstend(i,k) = qstend(i,k)-faltnds/nstep + nstend(i,k) = nstend(i,k)-faltndns/nstep + + ! sedimentation tendency for output + qssedten(i,k)=qssedten(i,k)-faltnds/nstep + + dums(i,k) = dums(i,k)-faltnds*deltat/real(nstep) + dumns(i,k) = dumns(i,k)-faltndns*deltat/real(nstep) + + end do !! k loop + + ! Snow Flux + do k = 1,nlev + sflx(i,k+1) = sflx(i,k+1) + falouts(k) / g / real(nstep) + end do + prect(i) = prect(i)+falouts(nlev)/g/real(nstep)/1000._r8 + preci(i) = preci(i)+falouts(nlev)/g/real(nstep)/1000._r8 + + end do !! nstep loop + + enddo !! i loop + +endif +! end sedimentation + + tlat1 = tlat1 + tlat + t = t + tlat*deltat/cpp + + qvlat1 = qvlat1 + qvlat + q = q + qvlat*deltat + + qctend1 = qctend1 + qctend + qc = qc + qctend*deltat + + qitend1 = qitend1 + qitend + qi = qi + qitend*deltat + + nctend1 = nctend1 + nctend + nc = nc + nctend*deltat + + nitend1 = nitend1 + nitend + ni = ni + nitend*deltat + + qrtend1 = qrtend1 + qrtend + qr = qr + qrtend*deltat + + qstend1 = qstend1 + qstend + qs = qs + qstend*deltat + + nrtend1 = nrtend1 + nrtend + nr = nr + nrtend*deltat + + nstend1 = nstend1 + nstend + ns = ns + nstend*deltat + +!--> h1g, 2019-12-12, remove tiny or negative hydrometeor mass or number +!--> in order to avoid numerical instability + do k=1, nlev + do i=1, mgncol + if ( qi(i,k).lt. qsmall ) then + if (diag_id%qidt_tiny + diag_id%qi_tiny_col > 0) & + diag_4l(i,j,k,diag_pt%qidt_tiny) = & + diag_4l(i,j,k,diag_pt%qidt_tiny) - qi(i,k)/deltat + qitend1(i,k) = qitend1(i,k) - qi(i,k)/deltat + qi(i,k) = 0.0 + + qvlat1(i,k) = qvlat1(i,k) + qi(i,k)/deltat + q(i,k) = q(i,k) + qi(i,k) + tlat1(i,k) = tlat1(i,k) - qi(i,k)/deltat*xxls + t(i,k) = t(i,k) - qi(i,k)*xxls/cpp + endif + enddo + enddo + + do k=1, nlev + do i=1, mgncol + if ( ni(i,k).lt. qsmall ) then + if (diag_id%qnidt_tiny + diag_id%qni_tiny_col > 0) & + diag_4l(i,j,k,diag_pt%qnidt_tiny) = & + diag_4l(i,j,k,diag_pt%qnidt_tiny) - ni(i,k)/deltat + + nitend1(i,k) = nitend1(i,k) - ni(i,k)/deltat + ni(i,k) = 0.0 + endif + enddo + enddo + + do k=1, nlev + do i=1, mgncol + if ( qs(i,k).lt. qsmall ) then + if (diag_id%qsdt_tiny + diag_id%qs_tiny_col > 0) & + diag_4l(i,j,k,diag_pt%qsdt_tiny) = & + diag_4l(i,j,k,diag_pt%qsdt_tiny) - qs(i,k)/deltat + + qstend1(i,k) = qstend1(i,k) - qs(i,k)/deltat + qs(i,k) = 0.0 + + qvlat1(i,k) = qvlat1(i,k) + qs(i,k)/deltat + q(i,k) = q(i,k) + qs(i,k) + tlat1(i,k) = tlat1(i,k) - qs(i,k)/deltat*xxls + t(i,k) = t(i,k) - qs(i,k)*xxls/cpp + endif + enddo + enddo + + do k=1, nlev + do i=1, mgncol + if ( ns(i,k).lt. qsmall ) then + if (diag_id%qnsdt_tiny + diag_id%qns_tiny_col > 0) & + diag_4l(i,j,k,diag_pt%qnsdt_tiny) = & + diag_4l(i,j,k,diag_pt%qnsdt_tiny) - ns(i,k)/deltat + + nstend1(i,k) = nstend1(i,k) - ns(i,k)/deltat + ns(i,k) = 0.0 + endif + enddo + enddo + + do k=1, nlev + do i=1, mgncol + if ( qc(i,k).lt. qsmall ) then + if (diag_id%qldt_tiny + diag_id%ql_tiny_col > 0) & + diag_4l(i,j,k,diag_pt%qldt_tiny) = & + diag_4l(i,j,k,diag_pt%qldt_tiny) - qc(i,k)/deltat + qctend1(i,k) = qctend1(i,k) - qc(i,k)/deltat + qc(i,k) = 0.0 + + qvlat1(i,k) = qvlat1(i,k) + qc(i,k)/deltat + q(i,k) = q(i,k) + qc(i,k) + tlat1(i,k) = tlat1(i,k) - qc(i,k)/deltat*xxlv + t(i,k) = t(i,k) - qc(i,k)*xxlv/cpp + endif + enddo + enddo + + do k=1, nlev + do i=1, mgncol + if ( nc(i,k).lt.qsmall ) then + if (diag_id%qndt_tiny + diag_id%qn_tiny_col > 0) & + diag_4l(i,j,k,diag_pt%qndt_tiny) = & + diag_4l(i,j,k,diag_pt%qndt_tiny) - nc(i,k)/deltat + + nctend1(i,k) = nctend1(i,k) - nc(i,k)/deltat + nc(i,k) = 0.0 + endif + enddo + enddo + + do k=1, nlev + do i=1, mgncol + if ( qr(i,k).lt. qsmall ) then + if (diag_id%qrdt_tiny + diag_id%qr_tiny_col > 0) & + diag_4l(i,j,k,diag_pt%qrdt_tiny) = & + diag_4l(i,j,k,diag_pt%qrdt_tiny) - qr(i,k)/deltat + qrtend1(i,k) = qrtend1(i,k) - qr(i,k)/deltat + qr(i,k) = 0.0 + + qvlat1(i,k) = qvlat1(i,k) + qr(i,k)/deltat + q(i,k) = q(i,k) + qr(i,k) + tlat1(i,k) = tlat1(i,k) - qr(i,k)/deltat*xxlv + t(i,k) = t(i,k) - qr(i,k)*xxlv/cpp + endif + enddo + enddo + + do k=1, nlev + do i=1, mgncol + if ( nr(i,k).lt. qsmall ) then + if (diag_id%qnrdt_tiny + diag_id%qnr_tiny_col > 0) & + diag_4l(i,j,k,diag_pt%qnrdt_tiny) = & + diag_4l(i,j,k,diag_pt%qnrdt_tiny) - nr(i,k)/deltat + + nrtend1(i,k) = nrtend1(i,k) - nr(i,k)/deltat + nr(i,k) = 0.0 + endif + enddo + enddo + +!<-- h1g, 2019-12-12 + + + npccno = npccno + npccn2 + nprao = nprao - npra*lcldm + nprc1o = nprc1o - nprc1*lcldm + nerosco = nerosco + nerosc*lcldm + + nnuccco = nnuccco - nnuccc*lcldm + nnuccto = nnuccto - nnucct*lcldm + npsacwso = npsacwso - npsacws*lcldm + nsubco = nsubco + nsubc*lcldm + nucclimo = nucclimo + nucclim + + nnuccdo = nnuccdo + nnuccd + nerosio = nerosio + nerosi*icldm + nsacwio = nsacwio + nsacwi*lcldm + nsubio = nsubio + nsubi*icldm + nprcio = nprcio - nprci*icldm + npraio = npraio - nprai*icldm + nnuccrio = nnuccrio+ nnuccri*precip_frac + nucclim1io = nucclim1io + nucclim1i + +end do substepping ! iter loop, sub-step + deltat = deltatin + +prect = prect/real(iter) +preci = preci/real(iter) + +lflx = lflx /real(iter) +iflx = iflx /real(iter) +rflx = rflx /real(iter) +sflx = sflx /real(iter) + +qcsedten = qcsedten/real(iter) +qisedten = qisedten/real(iter) +qrsedten = qrsedten/real(iter) +qssedten = qssedten/real(iter) + +diag_4l(:,j,:,diag_pt%qndt_sedi) = diag_4l(:,j,:,diag_pt%qndt_sedi) /real(iter) +diag_4l(:,j,:,diag_pt%qnidt_sedi) = diag_4l(:,j,:,diag_pt%qnidt_sedi) /real(iter) +diag_4l(:,j,:,diag_pt%rain_num_sedi) = diag_4l(:,j,:,diag_pt%rain_num_sedi)/real(iter) +diag_4l(:,j,:,diag_pt%snow_num_sedi) = diag_4l(:,j,:,diag_pt%snow_num_sedi)/real(iter) + + ! assign variables back to start-of-timestep values before updating after sub-steps + !================================================================================ + + t = tn + q = qn + qc = qcn + nc = ncn + qi = qin + ni = nin + qr = qrn + nr = nrn + qs = qsn + ns = nsn + + tlat = tlat1/real(iter) + qvlat = qvlat1/real(iter) + qctend = qctend1/real(iter) + qitend = qitend1/real(iter) + nctend = nctend1/real(iter) + nitend = nitend1/real(iter) + + qrtend = qrtend1/real(iter) + qstend = qstend1/real(iter) + nrtend = nrtend1/real(iter) + nstend = nstend1/real(iter) + + diag_4l(:,j,:,diag_pt%qidt_tiny) = diag_4l(:,j,:,diag_pt%qidt_tiny)/real(iter) + diag_4l(:,j,:,diag_pt%qnidt_tiny) = diag_4l(:,j,:,diag_pt%qnidt_tiny)/real(iter) + + diag_4l(:,j,:,diag_pt%qsdt_tiny) = diag_4l(:,j,:,diag_pt%qsdt_tiny)/real(iter) + diag_4l(:,j,:,diag_pt%qnsdt_tiny) = diag_4l(:,j,:,diag_pt%qnsdt_tiny)/real(iter) + + diag_4l(:,j,:,diag_pt%qldt_tiny) = diag_4l(:,j,:,diag_pt%qldt_tiny)/real(iter) + diag_4l(:,j,:,diag_pt%qndt_tiny) = diag_4l(:,j,:,diag_pt%qndt_tiny)/real(iter) + + diag_4l(:,j,:,diag_pt%qrdt_tiny) = diag_4l(:,j,:,diag_pt%qrdt_tiny)/real(iter) + diag_4l(:,j,:,diag_pt%qnrdt_tiny) = diag_4l(:,j,:,diag_pt%qnrdt_tiny)/real(iter) + + + + ! divide output precip q and N by number of sub-steps to get average over time step + !================================================================================ + + qrout = qrout/real(iter) + qsout = qsout/real(iter) + nrout = nrout/real(iter) + nsout = nsout/real(iter) + + ! divide trop_mozart variables by number of sub-steps to get average over time step + !================================================================================ + + nevapr = nevapr/real(iter) + evapsnow = evapsnow/real(iter) + prain = prain/real(iter) + prodsnow = prodsnow/real(iter) + + cmeout = cmeout/real(iter) + + cmeitot = cmeitot/real(iter) + meltsdttot = meltsdttot/real(iter) + frzrdttot = frzrdttot /real(iter) + + qcsinksum_rate1ord = qcsinksum_rate1ord/qc/real(iter) + + preo = preo/real(iter) + prdso = prdso/real(iter) + + cmelo =cmelo/real(iter) + + eroslo=eroslo/real(iter) + erosio=erosio/real(iter) + + pratot=pratot/real(iter) + prctot=prctot/real(iter) + mnuccctot=mnuccctot/real(iter) + mnuccttot=mnuccttot/real(iter) + mnuccdtot=mnuccdtot/real(iter) + + msacwitot=msacwitot/real(iter) + psacwstot=psacwstot/real(iter) + bergstot=bergstot/real(iter) + bergtot=bergtot/real(iter) + prcitot=prcitot/real(iter) + praitot=praitot/real(iter) + + mnuccrtot =mnuccrtot/real(iter) + mnuccritot=mnuccritot/real(iter) ! h1g, 2020-02-11 + pracstot =pracstot /real(iter) + + npccno = npccno/real(iter) ! h1g, 2020-03-09 + nprc1o = nprc1o/real(iter) ! h1g, 2020-03-09 + nprao = nprao/real(iter) ! h1g, 2020-03-09 + nerosco= nerosco/real(iter) ! h1g, 2020-03-09 + nnuccco= nnuccco/real(iter) ! h1g, 2020-03-09 + nnuccto= nnuccto/real(iter) ! h1g, 2020-03-09 + npsacwso= npsacwso/real(iter) ! h1g, 2020-03-09 + nsubco = nsubco/real(iter) ! h1g, 2020-03-09 + + nnuccdo = nnuccdo/real(iter) ! h1g, 2020-06-29 + nerosio = nerosio/real(iter) ! h1g, 2020-06-30 + nsacwio = nsacwio/real(iter) ! h1g, 2020-06-29 + nsubio = nsubio/real(iter) ! h1g, 2020-06-29 + nprcio = nprcio/real(iter) ! h1g, 2020-06-29 + npraio = npraio/real(iter) ! h1g, 2020-06-29 + nnuccrio = nnuccrio/real(iter) ! h1g, 2020-06-30 + nucclim1io = nucclim1io/real(iter) ! h1g, 2020-06-29 + + + + if (diag_id%snow_inst + diag_id%snow_inst_col > 0) & + diag_4l(:,j,:,diag_pt%snow_inst ) = diag_4l(:,j,:,diag_pt%snow_inst )/real(iter) + if (diag_id%snow_num_inst + diag_id%snow_num_inst_col > 0) & + diag_4l(:,j,:,diag_pt%snow_num_inst ) = diag_4l(:,j,:,diag_pt%snow_num_inst)/real(iter) + if (diag_id%rain_inst + diag_id%rain_inst_col > 0) & + diag_4l(:,j,:,diag_pt%rain_inst ) = diag_4l(:,j,:,diag_pt%rain_inst )/real(iter) + if (diag_id%rain_num_inst + diag_id%rain_num_inst_col > 0) & + diag_4l(:,j,:,diag_pt%rain_num_inst ) = diag_4l(:,j,:,diag_pt%rain_num_inst )/real(iter) + + + + + + !ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc + + ! get new update for variables that includes sedimentation tendency + ! note : here dum variables are grid-average, NOT in-cloud + + do k=1,nlev + do i=1,mgncol + dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8) + dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8) + dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8) + dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8) + + dumr(i,k) = max(qr(i,k)+qrtend(i,k)*deltat,0._r8) + dumnr(i,k) = max(nr(i,k)+nrtend(i,k)*deltat,0._r8) + dums(i,k) = max(qs(i,k)+qstend(i,k)*deltat,0._r8) + dumns(i,k) = max(ns(i,k)+nstend(i,k)*deltat,0._r8) + + ! switch for specification of droplet and crystal number + if (nccons) then + dumnc(i,k)=ncnst/rho(i,k)*lcldm(i,k) + end if + + ! switch for specification of cloud ice number + if (nicons) then + dumni(i,k)=ninst/rho(i,k)*icldm(i,k) + end if + + if (dumc(i,k).lt.qsmall) dumnc(i,k)=0._r8 + if (dumi(i,k).lt.qsmall) dumni(i,k)=0._r8 + if (dumr(i,k).lt.qsmall) dumnr(i,k)=0._r8 + if (dums(i,k).lt.qsmall) dumns(i,k)=0._r8 + + enddo + enddo + + ! calculate instantaneous processes (melting, homogeneous freezing) + !==================================================================== + + ! melting of snow at +2 C + do k=1,nlev + + do i=1,mgncol + + if (t(i,k)+tlat(i,k)/cpp*deltat > snowmelt) then + if (dums(i,k) > 0._r8) then + + ! make sure melting snow doesn't reduce temperature below threshold + dum = -xlf/cpp*dums(i,k) + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt. snowmelt) then + dum = (t(i,k)+tlat(i,k)/cpp*deltat-snowmelt)*cpp/xlf + dum = dum/dums(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qstend(i,k)=qstend(i,k)-dum*dums(i,k)/deltat + nstend(i,k)=nstend(i,k)-dum*dumns(i,k)/deltat + qrtend(i,k)=qrtend(i,k)+dum*dums(i,k)/deltat + nrtend(i,k)=nrtend(i,k)+dum*dumns(i,k)/deltat + + if (diag_id%snow_melt + diag_id%snow_melt_col > 0) & + diag_4l(i,j,k, diag_pt%snow_melt) = diag_4l(i,j,k, diag_pt%snow_melt)-dum*dums(i,k)/deltat + if (diag_id%snow_num_melt + diag_id%snow_num_melt_col > 0) & + diag_4l(i,j,k, diag_pt%snow_num_melt) = diag_4l(i,j,k, diag_pt%snow_num_melt)-dum*dumns(i,k)/deltat + + dum1=-xlf*dum*dums(i,k)/deltat + tlat(i,k)=tlat(i,k)+dum1 + + meltsdttot(i,k)=meltsdttot(i,k) + dum1 + end if + end if + enddo + enddo + do k=1,nlev + do i=1,mgncol + + ! freezing of rain at -5 C + + if (t(i,k)+tlat(i,k)/cpp*deltat < rainfrze) then + + if (dumr(i,k) > 0._r8) then + + ! make sure freezing rain doesn't increase temperature above threshold + dum = xlf/cpp*dumr(i,k) + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.rainfrze) then + dum = -(t(i,k)+tlat(i,k)/cpp*deltat-rainfrze)*cpp/xlf + dum = dum/dumr(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qrtend(i,k)=qrtend(i,k)-dum*dumr(i,k)/deltat + nrtend(i,k)=nrtend(i,k)-dum*dumnr(i,k)/deltat + + ! get mean size of rain = 1/lamr, add frozen rain to either snow or cloud ice + ! depending on mean rain size + + call size_dist_param_basic(mg_rain_props, dumr(i,k), dumnr(i,k), & + lamr(i,k)) + + if (lamr(i,k) < 1._r8/Dcs) then + qstend(i,k)=qstend(i,k)+dum*dumr(i,k)/deltat + nstend(i,k)=nstend(i,k)+dum*dumnr(i,k)/deltat + + if (diag_id%srfrain_accrs + diag_id%srfrain_accrs_col > 0) & + diag_4l(i,j,k,diag_pt%srfrain_accrs) = diag_4l(i,j,k,diag_pt%srfrain_accrs)-dum*dumr(i,k)/deltat + + if (diag_id%rain_num2snow + diag_id%rain_num2snow_col > 0) & + diag_4l(i,j,k,diag_pt%rain_num2snow ) = diag_4l(i,j,k,diag_pt%rain_num2snow )-dum*dumnr(i,k)/deltat + + else + qitend(i,k)=qitend(i,k)+dum*dumr(i,k)/deltat + nitend(i,k)=nitend(i,k)+dum*dumnr(i,k)/deltat + if (diag_id%qidt_rain2ice + diag_id%qi_rain2ice_col > 0) & + diag_4l(i,j,k, diag_pt%qidt_rain2ice) = diag_4l(i,j,k, diag_pt%qidt_rain2ice)+dum*dumr(i,k)/deltat + if (diag_id%qnidt_rain2ice + diag_id%qni_rain2ice_col > 0) & + diag_4l(i,j,k, diag_pt%qnidt_rain2ice) = diag_4l(i,j,k, diag_pt%qnidt_rain2ice)+dum*dumnr(i,k)/deltat + end if + + ! heating tendency + dum1 = xlf*dum*dumr(i,k)/deltat + frzrdttot(i,k)=frzrdttot(i,k) + dum1 + tlat(i,k)=tlat(i,k)+dum1 + end if + end if + + enddo + enddo + if (do_cldice) then + do k=1,nlev + do i=1,mgncol + if (t(i,k)+tlat(i,k)/cpp*deltat > tmelt) then + if (dumi(i,k) > 0._r8) then + + ! limit so that melting does not push temperature below freezing + !----------------------------------------------------------------- + dum = -dumi(i,k)*xlf/cpp + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.lt.tmelt) then + dum = (t(i,k)+tlat(i,k)/cpp*deltat-tmelt)*cpp/xlf + dum = dum/dumi(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qctend(i,k)=qctend(i,k)+dum*dumi(i,k)/deltat + + ! for output + melttot(i,k)= dum*dumi(i,k)/deltat + + ! assume melting ice produces droplet + ! mean volume radius of 8 micron + + IF (diag_id%qndt_melt + diag_id%qn_melt_col > 0) & + diag_4l(i,j,k,diag_pt%qndt_melt) = diag_4l(i,j,k,diag_pt%qndt_melt) & + + 3._r8*dum*dumi(i,k)/deltat/ & + (4._r8*pi*5.12e-16_r8*rhow) + IF (diag_id%qidt_melt2 + diag_id%qi_melt2_col > 0) & + diag_4l(i,j,k,diag_pt%qidt_melt2) = qitend(i,k) + IF (diag_id%qnidt_melt + diag_id%qni_melt_col > 0) & + diag_4l(i,j,k,diag_pt%qnidt_melt) = nitend(i,k) + + nctend(i,k)=nctend(i,k)+3._r8*dum*dumi(i,k)/deltat/ & + (4._r8*pi*5.12e-16_r8*rhow) + + qitend(i,k)=((1._r8-dum)*dumi(i,k)-qi(i,k))/deltat + nitend(i,k)=((1._r8-dum)*dumni(i,k)-ni(i,k))/deltat + tlat(i,k)=tlat(i,k)-xlf*dum*dumi(i,k)/deltat + + IF (diag_id%qidt_melt2 + diag_id%qi_melt2_col > 0) & + diag_4l(i,j,k,diag_pt%qidt_melt2) = & + qitend(i,k) - diag_4l(i,j,k,diag_pt%qidt_melt2) + IF (diag_id%qnidt_melt + diag_id%qni_melt_col > 0) & + diag_4l(i,j,k,diag_pt%qnidt_melt) = & + nitend(i,k) - diag_4l(i,j,k,diag_pt%qnidt_melt) + end if + end if + enddo + enddo + + ! homogeneously freeze droplets at -40 C + !----------------------------------------------------------------- + + do k=1,nlev + do i=1,mgncol + if (t(i,k)+tlat(i,k)/cpp*deltat < 233.15_r8) then + if (dumc(i,k) > 0._r8) then + + ! limit so that freezing does not push temperature above threshold + dum = dumc(i,k)*xlf/cpp + if (t(i,k)+tlat(i,k)/cpp*deltat+dum.gt.233.15_r8) then + dum = -(t(i,k)+tlat(i,k)/cpp*deltat-233.15_r8)*cpp/xlf + dum = dum/dumc(i,k) + dum = max(0._r8,dum) + dum = min(1._r8,dum) + else + dum = 1._r8 + end if + + qitend(i,k)=qitend(i,k)+dum*dumc(i,k)/deltat + ! for output + homotot(i,k)=dum*dumc(i,k)/deltat + + IF (diag_id%qldt_freez + diag_id%ql_freez_col > 0) & + diag_4l(i,j,k,diag_pt%qldt_freez) = qctend(i,k) + sum_freeze(i,k) = qctend(i,k) + IF ( diag_id%qndt_ihom + diag_id%qn_ihom_col > 0) & + diag_4l(i,j,k,diag_pt%qndt_ihom) = nctend(i,k) + + ! assume 25 micron mean volume radius of homogeneously frozen droplets + ! consistent with size of detrained ice in stratiform.F90 + nitend(i,k)=nitend(i,k)+dum*3._r8*dumc(i,k)/(4._r8*3.14_r8*1.563e-14_r8* & + 500._r8)/deltat + qctend(i,k)=((1._r8-dum)*dumc(i,k)-qc(i,k))/deltat + + if ( do_liq_num_ihom ) & ! h1g, 2020-06-22 + nctend(i,k)=((1._r8-dum)*dumnc(i,k)-nc(i,k))/deltat + + tlat(i,k)=tlat(i,k)+xlf*dum*dumc(i,k)/deltat + + if( isnan( tlat(i,k) ) ) & + write(*,'(a, 2i5, 5f8.2, i5 )') 'NaN@2907', i, k, tlat(i,k), xlf, dum, dumc(i,k), deltat + + + IF (diag_id%qldt_freez + diag_id%ql_freez_col > 0) & + diag_4l(i,j,k,diag_pt%qldt_freez) = & + qctend(i,k) - diag_4l(i,j,k,diag_pt%qldt_freez) + sum_freeze(i,k) = -(qctend(i,k) - sum_freeze(i,k)) + IF (diag_id%qndt_ihom + diag_id%qn_ihom_col > 0) & + diag_4l(i,j,k,diag_pt%qndt_ihom) = & + nctend(i,k) - diag_4l(i,j,k,diag_pt%qndt_ihom) + IF ( diag_id%qnidt_ihom + diag_id%qni_ihom_col > 0 ) & + diag_4l(i,j,k,diag_pt%qnidt_ihom) = & + dum*3._r8*dumc(i,k)/ & + (4._r8*3.14_r8*1.563e-14_r8*500._r8)/deltat + end if + end if + enddo + enddo + ! remove any excess over-saturation, which is possible due to non-linearity when adding + ! together all microphysical processes + !----------------------------------------------------------------- + ! follow code similar to old CAM scheme + + do k=1,nlev + do i=1,mgncol + + qtmp=q(i,k)+qvlat(i,k)*deltat + ttmp=t(i,k)+tlat(i,k)/cpp*deltat + + if ( ttmp .lt.-150.0+273.15 .or. ttmp .gt.90+273.15) & + write(*,'(a,6f8.2)') 'MG2: bad temperature@2930', & + ttmp, t(i,k), tlat(i,k)/cpp*deltat, tlat(i,k), cpp, deltat + + ! use rhw to allow ice supersaturation + call compute_qs(ttmp, p(i,k), qvn, q = q(i,k), & + esat = esn, es_over_liq = .true.) + + if (qtmp > qvn .and. qvn > 0 .and. allow_sed_supersat) then + ! expression below is approximate since there may be ice deposition + dum = (qtmp-qvn)/(1._r8+xxlv_squared*qvn/(cpp*rv*ttmp**2))/deltat + ! add to output cme + cmeout(i,k) = cmeout(i,k)+dum + ! now add to tendencies, partition between liquid and ice based on temperature + + if( remove_super_RK ) then ! h1g, 2020-03-30 + if (ttmp > 233.15_r8) then + dum1=0.0_r8 + if ( tiedtke_macrophysics ) ssat_disposal(i,k) = 1._r8 + else + dum1=1.0_r8 + if ( tiedtke_macrophysics ) ssat_disposal(i,k) = 2._r8 + endif + else ! h1g, 2020-03-30 + + if (ttmp > 268.15_r8) then + dum1=0.0_r8 + ! now add to tendencies, partition between liquid and ice based on temperature + if ( tiedtke_macrophysics ) ssat_disposal(i,k) = 1._r8 + !------------------------------------------------------- + else if (ttmp < 238.15_r8) then + dum1=1.0_r8 + if ( tiedtke_macrophysics ) ssat_disposal(i,k) = 2._r8 + else + dum1=(268.15_r8-ttmp)/30._r8 + if ( tiedtke_macrophysics ) ssat_disposal(i,k) = 2._r8 + end if + endif ! h1g, 2020-03-30 + + dum = (qtmp-qvn)/(1._r8+(xxls*dum1+xxlv*(1._r8-dum1))**2 & + *qvn/(cpp*rv*ttmp**2))/deltat + qctend(i,k)=qctend(i,k)+dum*(1._r8-dum1) + ! for output + qcrestot(i,k)=dum*(1._r8-dum1) + qitend(i,k)=qitend(i,k)+dum*dum1 + qirestot(i,k)=dum*dum1 + qvlat(i,k)=qvlat(i,k)-dum + ! for output + qvres(i,k)=-dum + tlat(i,k)=tlat(i,k)+dum*(1._r8-dum1)*xxlv+dum*dum1*xxls + end if + enddo + enddo + end if + + ! calculate effective radius for pass to radiation code + !========================================================= + ! if no cloud water, default value is 10 micron for droplets, + ! 25 micron for cloud ice + + ! update cloud variables after instantaneous processes to get effective radius + ! variables are in-cloud to calculate size dist parameters + do k=1,nlev + do i=1,mgncol + dumc(i,k) = max(qc(i,k)+qctend(i,k)*deltat,0._r8)/lcldm(i,k) + dumi(i,k) = max(qi(i,k)+qitend(i,k)*deltat,0._r8)/icldm(i,k) + dumnc(i,k) = max(nc(i,k)+nctend(i,k)*deltat,0._r8)/lcldm(i,k) + dumni(i,k) = max(ni(i,k)+nitend(i,k)*deltat,0._r8)/icldm(i,k) + + dumr(i,k) = max(qr(i,k)+qrtend(i,k)*deltat,0._r8)/precip_frac(i,k) + dumnr(i,k) = max(nr(i,k)+nrtend(i,k)*deltat,0._r8)/precip_frac(i,k) + dums(i,k) = max(qs(i,k)+qstend(i,k)*deltat,0._r8)/precip_frac(i,k) + dumns(i,k) = max(ns(i,k)+nstend(i,k)*deltat,0._r8)/precip_frac(i,k) + + ! switch for specification of droplet and crystal number + if (nccons) then + dumnc(i,k)=ncnst/rho(i,k) + end if + + ! switch for specification of cloud ice number + if (nicons) then + dumni(i,k)=ninst/rho(i,k) + end if + + ! limit in-cloud mixing ratio to reasonable value of 5 g kg-1 + dumc(i,k)=min(dumc(i,k),5.e-3_r8) + dumi(i,k)=min(dumi(i,k),5.e-3_r8) + ! limit in-precip mixing ratios + dumr(i,k)=min(dumr(i,k),10.e-3_r8) + dums(i,k)=min(dums(i,k),10.e-3_r8) + enddo + enddo + ! cloud ice effective radius + !----------------------------------------------------------------- + + if (do_cldice) then + do k=1,nlev + do i=1,mgncol + if (dumi(i,k).ge.qsmall) then + + dum_2D(i,k) = dumni(i,k) + call size_dist_param_basic(mg_ice_props, dumi(i,k), dumni(i,k), & + lami(i,k), dumni0) + + if (dumni(i,k) /=dum_2D(i,k)) then + ! adjust number conc if needed to keep mean size in reasonable range + if (diag_id%qnidt_size_adj + diag_id%qni_size_adj_col > 0) & + diag_4l(i,j,k,diag_pt%qnidt_size_adj) = nitend(i,k) + + if ( do_ice_num_adjust ) & ! h1g, 2020-07-01 + nitend(i,k)=(dumni(i,k)*icldm(i,k)-ni(i,k))/deltat + + if (diag_id%qnidt_size_adj + diag_id%qni_size_adj_col > 0) & + diag_4l(i,j,k,diag_pt%qnidt_size_adj) = nitend(i,k) & + - diag_4l(i,j,k,diag_pt%qnidt_size_adj) + end if + + effi(i,k) = 1.5_r8/lami(i,k)*1.e6_r8 + sadice(i,k) = 2._r8*pi*(lami(i,k)**(-3))*dumni0*rho(i,k)*1.e-2_r8 ! m2/m3 -> cm2/cm3 + + else + effi(i,k) = 25._r8 + sadice(i,k) = 0._r8 + end if + + ! ice effective diameter for david mitchell's optics + deffi(i,k)=effi(i,k)*rhoi/rhows*2._r8 + enddo + enddo + else + do k=1,nlev + do i=1,mgncol + ! NOTE: If CARMA is doing the ice microphysics, then the ice effective + ! radius has already been determined from the size distribution. + effi(i,k) = re_ice(i,k) * 1.e6_r8 ! m -> um + deffi(i,k)=effi(i,k) * 2._r8 + sadice(i,k) = 4._r8*pi*(effi(i,k)**2)*ni(i,k)*rho(i,k)*1e-2_r8 + enddo + enddo + end if + + ! cloud droplet effective radius + !----------------------------------------------------------------- + do k=1,nlev + do i=1,mgncol + if (dumc(i,k).ge.qsmall .and. do_liq_num_adjust) then + + ! switch for specification of droplet and crystal number + if (nccons) then + ! make sure nc is consistence with the constant N by adjusting tendency, need + ! to multiply by cloud fraction + ! note that nctend may be further adjusted below if mean droplet size is + ! out of bounds + nctend(i,k)=(ncnst/rho(i,k)*lcldm(i,k)-nc(i,k))/deltat + end if + IF (diag_id%qndt_size_adj + diag_id%qn_size_adj_col > 0) & + diag_4l(i,j,k,diag_pt%qndt_size_adj ) = nctend(i,k) + + dum = dumnc(i,k) + call size_dist_param_liq(mg_liq_props, dumc(i,k), dumnc(i,k), rho(i,k), & + pgam(i,k), lamc(i,k)) + + if (dum /= dumnc(i,k)) then + ! adjust number conc if needed to keep mean size in reasonable range + nctend(i,k)=(dumnc(i,k)*lcldm(i,k)-nc(i,k))/deltat + end if + IF (diag_id%qndt_size_adj + diag_id%qn_size_adj_col > 0) & + diag_4l(i,j,k,diag_pt%qndt_size_adj ) = & + nctend(i,k) - diag_4l(i,j,k,diag_pt%qndt_size_adj ) + + effc(i,k) = (pgam(i,k)+3._r8)/lamc(i,k)/2._r8*1.e6_r8 + !assign output fields for shape here + lamcrad(i,k)=lamc(i,k) + pgamrad(i,k)=pgam(i,k) + + + ! recalculate effective radius for constant number, in order to separate + ! first and second indirect effects + !====================================== + ! assume constant number of 10^8 kg-1 + + dumnc(i,k)=1.e8_r8 + + ! Pass in "false" adjust flag to prevent number from being changed within + ! size distribution subroutine. + call size_dist_param_liq(mg_liq_props, dumc(i,k), dumnc(i,k), rho(i,k), & + pgam(i,k), lamc(i,k)) + + effc_fn(i,k) = (pgam(i,k)+3._r8)/lamc(i,k)/2._r8*1.e6_r8 + + else + effc(i,k) = 10._r8 + lamcrad(i,k)=0._r8 + pgamrad(i,k)=0._r8 + effc_fn(i,k) = 10._r8 + end if + enddo + enddo + ! recalculate 'final' rain size distribution parameters + ! to ensure that rain size is in bounds, adjust rain number if needed + do k=1,nlev + do i=1,mgncol + + if (dumr(i,k).ge.qsmall) then + + dum = dumnr(i,k) + + call size_dist_param_basic(mg_rain_props, dumr(i,k), dumnr(i,k), & + lamr(i,k)) + + if (dum /= dumnr(i,k)) then + if (diag_id%rain_num_adj + diag_id%rain_num_adj_col > 0) & + diag_4l(:,j,:,diag_pt%rain_num_adj) = nrtend(i,k) + + ! adjust number conc if needed to keep mean size in reasonable range + nrtend(i,k)=(dumnr(i,k)*precip_frac(i,k)-nr(i,k))/deltat + + if (diag_id%rain_num_adj + diag_id%rain_num_adj_col > 0) & + diag_4l(:,j,:,diag_pt%rain_num_adj) = nrtend(i,k)-diag_4l(:,j,:,diag_pt%rain_num_adj) + + end if + + end if + enddo + enddo + ! recalculate 'final' snow size distribution parameters + ! to ensure that snow size is in bounds, adjust snow number if needed + do k=1,nlev + do i=1,mgncol + if (dums(i,k).ge.qsmall) then + + dum = dumns(i,k) + + call size_dist_param_basic(mg_snow_props, dums(i,k), dumns(i,k), & + lams(i,k), n0=dumns0) + + if (dum /= dumns(i,k)) then + if (diag_id%snow_num_adj + diag_id%snow_num_adj_col > 0) & + diag_4l(:,j,:,diag_pt%snow_num_adj) = nstend(i,k) + + ! adjust number conc if needed to keep mean size in reasonable range + nstend(i,k)=(dumns(i,k)*precip_frac(i,k)-ns(i,k))/deltat + + if (diag_id%snow_num_adj + diag_id%snow_num_adj_col > 0) & + diag_4l(:,j,:,diag_pt%snow_num_adj) = nstend(i,k)-diag_4l(:,j,:,diag_pt%snow_num_adj) + end if + + sadsnow(i,k) = 2._r8*pi*(lams(i,k)**(-3))*dumns0*rho(i,k)*1.e-2_r8 ! m2/m3 -> cm2/cm3 + + end if + + + end do ! vertical k loop + enddo + + ! DO STUFF FOR OUTPUT: + !================================================== + ! averaging for snow and rain number and diameter + !-------------------------------------------------- + + ! drout2/dsout2: + ! diameter of rain and snow + ! dsout: + ! scaled diameter of snow (passed to radiation in CAM) + ! reff_rain/reff_snow: + ! calculate effective radius of rain and snow in microns for COSP using Eq. 9 of COSP v1.3 manual + + where (qrout .gt. 1.e-7_r8 & + .and. nrout.gt.0._r8) + qrout2 = qrout * precip_frac + nrout2 = nrout * precip_frac + ! The avg_diameter call does the actual calculation; other diameter + ! outputs are just drout2 times constants. + drout2 = avg_diameter(qrout, nrout, rho, rhow) + freqr = precip_frac + + reff_rain=1.5_r8*drout2*1.e6_r8 + elsewhere + qrout2 = 0._r8 + nrout2 = 0._r8 + drout2 = 0._r8 + freqr = 0._r8 + reff_rain = 0._r8 + end where + + where (qsout .gt. 1.e-7_r8 & + .and. nsout.gt.0._r8) + qsout2 = qsout * precip_frac + nsout2 = nsout * precip_frac + ! The avg_diameter call does the actual calculation; other diameter + ! outputs are just dsout2 times constants. + dsout2 = avg_diameter(qsout, nsout, rho, rhosn) + freqs = precip_frac + + dsout=3._r8*rhosn/rhows*dsout2 + + reff_snow=1.5_r8*dsout2*1.e6_r8 + elsewhere + dsout = 0._r8 + qsout2 = 0._r8 + nsout2 = 0._r8 + dsout2 = 0._r8 + freqs = 0._r8 + reff_snow=0._r8 + end where + +!--> h1g, 2010-01-15, add limits for rain drop radius +#ifdef GFDL_COMPATIBLE_MICROP + reff_rain = max( 30.0_r8, reff_rain ) + reff_rain = min( 750.0_r8, reff_rain ) +#endif +!<-- h1g, 2010-01-15, add limits for rain drop radius + + + +#ifdef GFDL_COMPATIBLE_MICROP +! diagnostics for water tendencies +! water vapor specific humicity + + ! if (diag_id%qdt_cond > 0) & + ! diag_4l(:,j,:,diag_pt%qdt_cond) = -cmelo(:,:) + + if (diag_id%qdt_deposition > 0) & + diag_4l(:,j,:,diag_pt%qdt_deposition ) = -cmeitot( : , : ) + if (diag_id%qdt_sedi_ice2vapor> 0) & + diag_4l(:,j,:,diag_pt%qdt_sedi_ice2vapor) = qisevap( : , : ) + if (diag_id%qdt_sedi_liquid2vapor> 0) & + diag_4l(:,j,:,diag_pt%qdt_sedi_liquid2vapor) = qcsevap( : , : ) + if (diag_id%qdt_super_sat_rm > 0) & + diag_4l(:,j,:,diag_pt%qdt_super_sat_rm) = qvres( : , : ) + +! cloud liquid water + if (diag_id%qldt_accr + diag_id%ql_accr_col > 0) & + diag_4l(:,j,:,diag_pt%qldt_accr) = - pratot(:,:) + if (diag_id%qldt_auto + diag_id%ql_auto_col > 0)& + diag_4l(:,j,:,diag_pt%qldt_auto) = -prctot(:,:) + if (diag_id%qldt_freez2 + diag_id%ql_freez2_col > 0) & + diag_4l(:,j,:,diag_pt%qldt_freez2) = & + -(mnuccctot(:,:) + mnuccttot(:,:) ) + sum_freeze2(:,:) = mnuccctot(:,:) + mnuccttot(:,:) + if (diag_id%qldt_accrs + diag_id%ql_accrs_col > 0) & + diag_4l(:,j,:,diag_pt%qldt_accrs) = -psacwstot(:,:) + sum_rime(:,:) = psacwstot(:,:) + if (diag_id%qldt_HM_splinter + diag_id%ql_HM_splinter_col > 0)& + diag_4l(:,j,:,diag_pt%qldt_HM_splinter) = -msacwitot(:,:) + sum_splinter(:,:) = msacwitot(:,:) + if (diag_id%qldt_bergs + diag_id%ql_bergs_col > 0) & + diag_4l(:,j,:,diag_pt%qldt_bergs) = -bergstot(:,:) + sum_bergs(:,:) = bergstot (:,:) + + + if (diag_id%qidt_dep + diag_id%qi_dep_col > 0) & + diag_4l(:,j,:,diag_pt%qidt_dep) = max(cmeitot(:,:),0._r8) + if (diag_id%qidt_subl + diag_id%qi_subl_col > 0) & + diag_4l(:,j,:,diag_pt%qidt_subl) = - max(-1._r8*cmeitot(:,:),0._r8) + + sum_cond(:,:) = max(cmeitot(:,:),0._r8) + + if (diag_id%qldt_cond + diag_id%ql_cond_col > 0) & + diag_4l(:,j,:,diag_pt%qldt_cond) = max(cmelo(:,:), 0._r8) + if (diag_id%qldt_evap + diag_id%ql_evap_col > 0) & + diag_4l(:,j,:,diag_pt%qldt_evap) = & + - max(-1._r8*cmelo(:,:),0._r8) + + + if (diag_id%qldt_eros + diag_id%ql_eros_col > 0) & + diag_4l(:,j,:,diag_pt%qldt_eros) = eroslo(:,:) + if (diag_id%qdt_eros_l > 0) & + diag_4l(:,j,:,diag_pt%qdt_eros_l) = -eroslo(:,:) + + if (diag_id%qidt_eros + diag_id%qi_eros_col > 0) & + diag_4l(:,j,:,diag_pt%qidt_eros) = erosio(:,:) + if (diag_id%qdt_eros_i > 0) & + diag_4l(:,j,:,diag_pt%qdt_eros_i) = -erosio(:,:) + + + if (diag_id%qldt_berg + diag_id%ql_berg_col > 0) & + diag_4l(:,j,:,diag_pt%qldt_berg) = -bergtot(:,:) + sum_berg(:,:) = bergtot(:,:) + IF ( diag_id%qldt_sedi + diag_id%ql_sedi_col > 0 ) & + diag_4l(:,j,1:nlev,diag_pt%qldt_sedi) = qcsedten(:,:) + IF ( diag_id%liq_adj + diag_id%liq_adj_col > 0 ) & + diag_4l(:,j,:,diag_pt%liq_adj) = qcrestot(:,:) + +! cloud ice water + if (diag_id%qidt_auto + diag_id%qi_auto_col > 0) & + diag_4l(:,j,:,diag_pt%qidt_auto) = -prcitot(:,:) + if (diag_id%qidt_accr + diag_id%qi_accr_col > 0) & + diag_4l(:,j,:,diag_pt%qidt_accr) = -praitot(:,:) + if (diag_id%qidt_rain2ice + diag_id%qi_rain2ice_col > 0) & + diag_4l(:,j,:,diag_pt%qidt_rain2ice) = diag_4l(:,j,:,diag_pt%qidt_rain2ice) & + + mnuccritot(:,:) + IF ( diag_id%qidt_fall + diag_id%qi_fall_col > 0 ) & + diag_4l(:,j,1:nlev,diag_pt%qidt_fall) = qisedten(:,1:nlev) + IF ( diag_id%ice_adj + diag_id%ice_adj_col > 0 ) & + diag_4l(:,j,:,diag_pt%ice_adj) = qirestot(:,:) + sum_ice_adj(:,:) = qirestot(:,:) + +! ---> rain water mixing ratio + if (diag_id%srfrain_accrs + diag_id%srfrain_accrs_col > 0) & + diag_4l(:,j,:,diag_pt%srfrain_accrs) = diag_4l(:,j,:,diag_pt%srfrain_accrs) & + -pracstot(:,:) + if (diag_id%rain_freeze + diag_id%rain_freeze_col > 0) & + diag_4l(:,j,:,diag_pt%rain_freeze) = -mnuccrtot(:,:) + if (diag_id%rain_evap + diag_id%rain_evap_col > 0) & + diag_4l(:,j,:,diag_pt%rain_evap) = pre( : , : )*precip_frac(:,:) + if (diag_id%rain_sedi + diag_id%rain_sedi_col > 0) & + diag_4l(:,j,:,diag_pt%rain_sedi) = qrsedten(:,:) + +! ---> snow mixing ratio + if (diag_id%qdt_snow_sublim + diag_id%q_snow_sublim_col > 0 ) & + diag_4l(:,j,:,diag_pt%qdt_snow_sublim ) = -prds( : , : )*precip_frac(:,:) + if (diag_id%snow_sedi + diag_id%snow_sedi_col > 0) & + diag_4l(:,j,:,diag_pt%snow_sedi) = qssedten(:,:) + +! ---> rain number mixing ratio + if ( diag_id%rain_num2snow + diag_id%rain_num2snow_col ) & + diag_4l(:,j,:,diag_pt%rain_num2snow) = diag_4l(:,j,:,diag_pt%rain_num2snow) & + -npracs(:,:)*precip_frac(:,:) + if ( diag_id%rain_num_evap + diag_id%rain_num_evap_col ) & + diag_4l(:,j,:,diag_pt%rain_num_evap) = nsubr( : , : )*precip_frac(:,:) + + if ( diag_id%rain_num_freez + diag_id%rain_num_freez_col ) & + diag_4l(:,j,:,diag_pt%rain_num_freez) = -nnuccr( : , : )*precip_frac(:,:) + + +! --->liquid droplet number +! if ( diag_id%qndt_cond + diag_id%qn_cond_col > 0 ) & +! diag_4l(:,j,:,diag_pt%qndt_cond) = npccn2(:,:) + if (diag_id%qndt_cond + diag_id%qn_cond_col > 0) & + diag_4l(:,j,:,diag_pt%qndt_cond) = npccno(:,:) + if (diag_id%qndt_eros + diag_id%qn_eros_col > 0) & + diag_4l(:,j,:,diag_pt%qndt_eros) = nerosco(:,:) + if (diag_id%qndt_pra + diag_id%qn_pra_col > 0) & + diag_4l(:,j,:,diag_pt%qndt_pra) = nprao(:,:) + if (diag_id%qndt_auto + diag_id%qn_auto_col > 0) & + diag_4l(:,j,:,diag_pt%qndt_auto) = nprc1o(:,:) + if (diag_id%qndt_freez + diag_id%qn_freez_col > 0) & + diag_4l(:,j,:,diag_pt%qndt_freez) = nnuccco(:,:) + if (diag_id%qndt_contact_frz + diag_id%qn_contact_frz_col > 0) & + diag_4l(:,j,:,diag_pt%qndt_contact_frz) = nnuccto(:,:) + if (diag_id%qndt_sacws + diag_id%qn_sacws_col > 0) & + diag_4l(:,j,:,diag_pt%qndt_sacws) = npsacwso(:,:) + if (diag_id%qndt_evap + diag_id%qn_evap_col > 0) & + diag_4l(:,j,:,diag_pt%qndt_evap) = nsubco(:,:) + +! ---> ice number + if (diag_id%qnidt_nnuccd + diag_id%qni_nnuccd_col > 0) & + diag_4l(:,j,:,diag_pt%qnidt_nnuccd) = nnuccdo(:,:) + if (diag_id%qnidt_nsacwi> 0) & + diag_4l(:,j,:,diag_pt%qnidt_nsacwi) = nsacwio + + if (diag_id%qnidt_nsubi + diag_id%qni_nsubi_col > 0) & + diag_4l(:,j,:,diag_pt%qnidt_nsubi) = nsubio(:,:) + if (diag_id%qnidt_nerosi + diag_id%qni_nerosi_col > 0) & + diag_4l(:,j,:,diag_pt%qnidt_nerosi) = nerosio + if (diag_id%qnidt_auto + diag_id%qni_auto_col > 0) & + diag_4l(:,j,:,diag_pt%qnidt_auto) = nprcio + if (diag_id%qnidt_accr + diag_id%qni_accr_col > 0) & + diag_4l(:,j,:,diag_pt%qnidt_accr) = npraio + if (diag_id%qnidt_rain2ice + diag_id%qni_rain2ice_col > 0) & + diag_4l(:,j,:,diag_pt%qnidt_rain2ice) = diag_4l(:,j,:,diag_pt%qnidt_rain2ice) & + +nnuccrio + +!10/23/13: NOTE: STILL NEEDS CONVERSION !!!! +!RSH: +! calculate fraction of total ice / snow creation that requires +! ice-forming nuclei + do k=1,nlev + do i=1,mgncol + qldt_sum = sum_cond(i,k) + sum_rime(i,k) + sum_berg(i,k) + & + sum_ice_adj(i,k) + MAX(sum_bergs(i,k), 0.0) + & + sum_freeze(i,k) + sum_freeze2(i,k) + sum_splinter(i,k) + if ( ABS(qldt_sum) > 0.0 ) then +! ---> h1g, 2014-07-18, add option of including contact freeze in bergeron + if( include_contact_freeze_in_berg ) then + f_snow_berg(i,k) = (sum_berg(i,k) + sum_cond(i,k) + & + sum_ice_adj(i,k) + & + MAX( sum_bergs(i,k), 0.0) + & + sum_freeze (i,k) + sum_freeze2(i,k) )/qldt_sum + else + f_snow_berg(i,k) = (sum_berg(i,k) + sum_cond(i,k) + & + sum_ice_adj(i,k) + & + MAX( sum_bergs(i,k), 0.0) + & + sum_freeze (i,k) + mnuccctot(i,k) )/qldt_sum ! h1g 2015-06-05 + + endif +! <--- h1g, 2014-07-18 + else + f_snow_berg(i,k) = 0._r8 + endif + end do + end do + +#endif +end subroutine micro_mg2_tend + + +!======================================================================== +!OUTPUT CALCULATIONS +!======================================================================== + +subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol) + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: lamr ! rain size parameter (slope) + real(r8), dimension(mgncol), intent(in) :: n0r ! rain size parameter (intercept) + real(r8), dimension(mgncol), intent(in) :: lamc ! size distribution parameter (slope) + real(r8), dimension(mgncol), intent(in) :: pgam ! droplet size parameter + real(r8), dimension(mgncol), intent(in) :: qric ! in-cloud rain mass mixing ratio + real(r8), dimension(mgncol), intent(in) :: qcic ! in-cloud cloud liquid + real(r8), dimension(mgncol), intent(in) :: ncic ! in-cloud droplet number concentration + + real(r8), dimension(mgncol), intent(inout) :: rercld ! effective radius calculation for rain + cloud + + ! combined size of precip & cloud drops + real(r8) :: Atmp + + integer :: i + + do i=1,mgncol + ! Rain drops + if (lamr(i) > 0._r8) then + Atmp = n0r(i) * pi / (2._r8 * lamr(i)**3._r8) + else + Atmp = 0._r8 + end if + + ! Add cloud drops + if (lamc(i) > 0._r8) then + Atmp = Atmp + & + ncic(i) * pi * rising_factorial(pgam(i)+1._r8, 2)/(4._r8 * lamc(i)**2._r8) + end if + + if (Atmp > 0._r8) then + rercld(i) = rercld(i) + 3._r8 *(qric(i) + qcic(i)) / (4._r8 * rhow * Atmp) + end if + enddo +end subroutine calc_rercld + + +!======================================================================== +!UTILITIES +!======================================================================== + + subroutine micro_mg2_get_cols(ncol, nlev, top_lev, qcn, qin, & + qrn, qsn, mgncol, mgcols) + + ! Determines which columns microphysics should operate over by + ! checking for non-zero cloud water/ice. + + integer, intent(in) :: ncol ! Number of columns with meaningful data + integer, intent(in) :: nlev ! Number of levels to use + integer, intent(in) :: top_lev ! Top level for microphysics + + real(r8), intent(in) :: qcn(:,:) ! cloud water mixing ratio (kg/kg) + real(r8), intent(in) :: qin(:,:) ! cloud ice mixing ratio (kg/kg) + real(r8), intent(in) :: qrn(:,:) ! rain mixing ratio (kg/kg) + real(r8), intent(in) :: qsn(:,:) ! snow mixing ratio (kg/kg) + + integer, intent(out) :: mgncol ! Number of columns MG will use + integer, allocatable, intent(out) :: mgcols(:) ! column indices + + integer :: lev_offset ! top_lev - 1 (defined here for consistency) + logical :: ltrue(ncol) ! store tests for each column + + integer :: i, ii ! column indices + + if (allocated(mgcols)) deallocate(mgcols) + + lev_offset = top_lev - 1 + + ! Using "any" along dimension 2 collapses across levels, but + ! not columns, so we know if water is present at any level + ! in each column. + + ltrue = any(qcn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + ltrue = ltrue .or. any(qin(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + ltrue = ltrue .or. any(qrn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + ltrue = ltrue .or. any(qsn(:ncol,top_lev:(nlev+lev_offset)) >= qsmall, 2) + + ! Scan for true values to get a usable list of indices. + + mgncol = count(ltrue) + allocate(mgcols(mgncol)) + i = 0 + do ii = 1,ncol + if (ltrue(ii)) then + i = i + 1 + mgcols(i) = ii + end if + end do + +end subroutine micro_mg2_get_cols + + + + +! ======================================================================= +! time - implicit monotonic scheme +! developed by sj lin, 2016 +! ======================================================================= + +subroutine implicit_fall (dt, ktop, kbot, ze, vt, dp, q, precip, m1) + + implicit none + + integer, intent (in) :: ktop, kbot + + real(r8), intent (in) :: dt + + real(r8), intent (in), dimension (ktop:kbot + 1) :: ze + + real(r8), intent (in), dimension (ktop:kbot) :: vt, dp + + real(r8), intent (inout), dimension (ktop:kbot) :: q + + real(r8), intent (out), dimension (ktop:kbot) :: m1 + + real(r8), intent (out) :: precip + + real(r8), dimension (ktop:kbot) :: dz, qm, dd + + integer :: k + + do k = ktop, kbot + dz (k) = ze (k) - ze (k + 1) + dd (k) = dt * vt (k) + q (k) = q (k) * dp (k) + enddo + + ! ----------------------------------------------------------------------- + ! sedimentation: non - vectorizable loop + ! ----------------------------------------------------------------------- + + qm (ktop) = q (ktop) / (dz (ktop) + dd (ktop)) + do k = ktop + 1, kbot + qm (k) = (q (k) + dd (k - 1) * qm (k - 1)) / (dz (k) + dd (k)) + enddo + + ! ----------------------------------------------------------------------- + ! qm is density at this stage + ! ----------------------------------------------------------------------- + + do k = ktop, kbot + qm (k) = qm (k) * dz (k) + enddo + + ! ----------------------------------------------------------------------- + ! output mass fluxes: non - vectorizable loop + ! ----------------------------------------------------------------------- + + m1 (ktop) = q (ktop) - qm (ktop) + do k = ktop + 1, kbot + m1 (k) = m1 (k - 1) + q (k) - qm (k) + enddo + precip = m1 (kbot) + + ! ----------------------------------------------------------------------- + ! update: + ! ----------------------------------------------------------------------- + + do k = ktop, kbot + q (k) = qm (k) / dp (k) + enddo + +end subroutine implicit_fall + + + + +end module micro_mg2_mod + diff --git a/atmos_param/microphysics/micro_mg2_utils.F90 b/atmos_param/microphysics/micro_mg2_utils.F90 new file mode 100644 index 00000000..e2e4a72e --- /dev/null +++ b/atmos_param/microphysics/micro_mg2_utils.F90 @@ -0,0 +1,1708 @@ +module micro_mg2_utils + +!-------------------------------------------------------------------------- +! +! This module contains process rates and utility functions used by the MG +! microphysics. +! +! Original MG authors: Andrew Gettelman, Hugh Morrison +! Contributions from: Peter Caldwell, Xiaohong Liu and Steve Ghan +! +! Separated from MG 1.5 by B. Eaton. +! Separated module switched to MG 2.0 and further changes by S. Santos. +! +! for questions contact Hugh Morrison, Andrew Gettelman +! e-mail: morrison@ucar.edu, andrew@ucar.edu +! +!-------------------------------------------------------------------------- +! +! List of required external functions that must be supplied: +! gamma --> standard mathematical gamma function (if gamma is an +! intrinsic, define HAVE_GAMMA_INTRINSICS) +! +!-------------------------------------------------------------------------- +! +! Constants that must be specified in the "init" method (module variables): +! +! kind kind of reals (to verify correct linkage only) - +! gravit acceleration due to gravity m s-2 +! rair dry air gas constant for air J kg-1 K-1 +! rh2o gas constant for water vapor J kg-1 K-1 +! cpair specific heat at constant pressure for dry air J kg-1 K-1 +! tmelt temperature of melting point for water K +! latvap latent heat of vaporization J kg-1 +! latice latent heat of fusion J kg-1 +! +!-------------------------------------------------------------------------- + +use gamma_mg_mod, only: gamma =>gamma_mg + +implicit none +private +save + +public :: & + micro_mg_utils_init, & + size_dist_param_liq, & + size_dist_param_basic, & + avg_diameter, & + rising_factorial, & + ice_deposition_sublimation, & + sb2001v2_liq_autoconversion,& + sb2001v2_accre_cld_water_rain,& + kk2000_liq_autoconversion, & + ice_autoconversion, & + immersion_freezing, & + contact_freezing, & + snow_self_aggregation, & + accrete_cloud_water_snow, & + secondary_ice_production, & + accrete_rain_snow, & + heterogeneous_rain_freezing, & + accrete_cloud_water_rain, & + self_collection_rain, & + accrete_cloud_ice_snow, & + evaporate_sublimate_precip, & + bergeron_process_snow, & ! h1g, 2020-03-23 + cotton_liq_autoconversion ! h1g, 2020-03-23 + + +! 8 byte real and integer +integer, parameter, public :: r8 = selected_real_kind(12) +integer, parameter, public :: i8 = selected_int_kind(18) + +public :: MGHydrometeorProps + +type :: MGHydrometeorProps + ! Density (kg/m^3) + real(r8) :: rho + ! Information for size calculations. + ! Basic calculation of mean size is: + ! lambda = (shape_coef*nic/qic)^(1/eff_dim) + ! Then lambda is constrained by bounds. + real(r8) :: eff_dim + real(r8) :: shape_coef + real(r8) :: lambda_bounds(2) + ! Minimum average particle mass (kg). + ! Limit is applied at the beginning of the size distribution calculations. + real(r8) :: min_mean_mass +end type MGHydrometeorProps + +interface MGHydrometeorProps + module procedure NewMGHydrometeorProps +end interface + +type(MGHydrometeorProps), public :: mg_liq_props +type(MGHydrometeorProps), public :: mg_ice_props +type(MGHydrometeorProps), public :: mg_rain_props +type(MGHydrometeorProps), public :: mg_snow_props + +interface size_dist_param_liq + module procedure size_dist_param_liq_vect + module procedure size_dist_param_liq_line +end interface +interface size_dist_param_basic + module procedure size_dist_param_basic_vect + module procedure size_dist_param_basic_line +end interface + +!================================================= +! Public module parameters (mostly for MG itself) +!================================================= + +! Pi to 20 digits; more than enough to reach the limit of double precision. +real(r8), parameter, public :: pi = 3.14159265358979323846_r8 + +! "One minus small number": number near unity for round-off issues. +real(r8), parameter, public :: omsm = 1._r8 - 1.e-5_r8 + +! Smallest mixing ratio considered in microphysics. +real(r8), parameter, public :: qsmall = 1.e-18_r8 + +! minimum allowed cloud fraction +real(r8), parameter, public :: mincld = 0.0001_r8 + +!--> h1g-2020-02-20 save the CAM default values +!real(r8), parameter, public :: rhosn = 250._r8 ! bulk density snow +real(r8), parameter, public :: rhosn = 250._r8 ! bulk density snow +!<-- h1g-2020-02-20 + +real(r8), parameter, public :: rhoi = 500._r8 ! bulk density ice +real(r8), parameter, public :: rhow = 1000._r8 ! bulk density liquid +real(r8), parameter, public :: rhows = 917._r8 ! bulk density water solid + +! fall speed parameters, V = aD^b (V is in m/s) +! droplets +real(r8), parameter, public :: ac = 3.e7_r8 +real(r8), parameter, public :: bc = 2._r8 +! snow +real(r8), parameter, public :: as = 11.72_r8 +real(r8), parameter, public :: bs = 0.41_r8 +! cloud ice +real(r8), parameter, public :: ai = 700._r8 +real(r8), parameter, public :: bi = 1._r8 +! small cloud ice (r< 10 um) - sphere, bulk density +real(r8), parameter, public :: aj = ac*((rhoi/rhows)**(bc/3._r8))*rhows/rhow +real(r8), parameter, public :: bj = bc +! rain +real(r8), parameter, public :: ar = 841.99667_r8 +real(r8), parameter, public :: br = 0.8_r8 + +! mass of new crystal due to aerosol freezing and growth (kg) +! Make this consistent with the lower bound, to support UTLS and +! stratospheric ice, and the smaller ice size limit. +real(r8), parameter, public :: mi0 = 4._r8/3._r8*pi*rhoi*(1.e-6_r8)**3 + +!================================================= +! Private module parameters +!================================================= + +! Signaling NaN bit pattern that represents a limiter that's turned off. +integer(i8), parameter :: limiter_off = int(Z'7FF1111111111111', i8) + +! alternate threshold used for some in-cloud mmr +real(r8), parameter :: icsmall = 1.e-8_r8 + +! particle mass-diameter relationship +! currently we assume spherical particles for cloud ice/snow +! m = cD^d +! exponent +real(r8), parameter :: dsph = 3._r8 + +! Bounds for mean diameter for different constituents. +real(r8), parameter :: lam_bnd_rain(2) = 1._r8/[500.e-6_r8, 20.e-6_r8] +!real(r8), parameter :: lam_bnd_snow(2) = 1._r8/[2000.e-6_r8, 10.e-6_r8] ! h1g, 2020-07-30 + +! Minimum average mass of particles. +real(r8), parameter :: min_mean_mass_liq = 1.e-20_r8 +real(r8), parameter :: min_mean_mass_ice = 1.e-20_r8 + +! ventilation parameters +! for snow +real(r8), parameter :: f1s = 0.86_r8 +real(r8), parameter :: f2s = 0.28_r8 +! for rain +real(r8), parameter :: f1r = 0.78_r8 +real(r8), parameter :: f2r = 0.308_r8 + +! collection efficiencies +! aggregation of cloud ice and snow +real(r8), parameter :: eii = 0.5_r8 + + +! immersion freezing parameters, bigg 1953 +real(r8), parameter :: bimm = 100._r8 +real(r8), parameter :: aimm = 0.66_r8 + +! Mass of each raindrop created from autoconversion. +real(r8), parameter :: droplet_mass_25um = 4._r8/3._r8*pi*rhow*(25.e-6_r8)**3 +real(r8), parameter :: droplet_mass_40um = 4._r8/3._r8*pi*rhow*(40.e-6_r8)**3 + +!========================================================= +! Constants set in initialization +!========================================================= + +! Set using arguments to micro_mg_init +real(r8) :: rv ! water vapor gas constant +real(r8) :: cpp ! specific heat of dry air +real(r8) :: tmelt ! freezing point of water (K) + +! latent heats of: +real(r8) :: xxlv ! vaporization +real(r8) :: xlf ! freezing +real(r8) :: xxls ! sublimation + +! additional constants to help speed up code +real(r8) :: gamma_bs_plus3 +real(r8) :: gamma_half_br_plus5 +real(r8) :: gamma_half_bs_plus5 + +!========================================================= +! Utilities that are cheaper if the compiler knows that +! some argument is an integer. +!========================================================= + +interface rising_factorial + module procedure rising_factorial_r8 + module procedure rising_factorial_integer +end interface rising_factorial + +interface var_coef + module procedure var_coef_r8 + module procedure var_coef_integer +end interface var_coef + +!========================================================================== +contains +!========================================================================== + +! Initialize module variables. +! +! "kind" serves no purpose here except to check for unlikely linking +! issues; always pass in the kind for a double precision real. +! +! "errstring" is the only output; it is blank if there is no error, or set +! to a message if there is an error. +! +! Check the list at the top of this module for descriptions of all other +! arguments. +subroutine micro_mg_utils_init( kind, rh2o, cpair, tmelt_in, latvap, & + latice, dcs, errstring) + + integer, intent(in) :: kind + real(r8), intent(in) :: rh2o + real(r8), intent(in) :: cpair + real(r8), intent(in) :: tmelt_in + real(r8), intent(in) :: latvap + real(r8), intent(in) :: latice + real(r8), intent(in) :: dcs + + character(128), intent(out) :: errstring + + ! Name this array to workaround an XLF bug (otherwise could just use the + ! expression that sets it). + real(r8) :: ice_lambda_bounds(2) + real(r8) :: lam_bnd_snow(2) ! h1g, 2020-07-30 + !----------------------------------------------------------------------- + + errstring = ' ' + + if( kind .ne. r8 ) then + errstring = 'micro_mg_init: KIND of reals does not match' + return + endif + + ! declarations for MG code (transforms variable names) + + rv= rh2o ! water vapor gas constant + cpp = cpair ! specific heat of dry air + tmelt = tmelt_in + + ! latent heats + + xxlv = latvap ! latent heat vaporization + xlf = latice ! latent heat freezing + xxls = xxlv + xlf ! latent heat of sublimation + + ! Define constants to help speed up code (this limits calls to gamma function) + gamma_bs_plus3=gamma(3._r8+bs) + gamma_half_br_plus5=gamma(5._r8/2._r8+br/2._r8) + gamma_half_bs_plus5=gamma(5._r8/2._r8+bs/2._r8) + + ! Don't specify lambda bounds for cloud liquid, as they are determined by + ! pgam dynamically. + mg_liq_props = MGHydrometeorProps(rhow, dsph, & + min_mean_mass=min_mean_mass_liq) + + ! Mean ice diameter can not grow bigger than twice the autoconversion + ! threshold for snow. + ice_lambda_bounds = 1._r8/[2._r8*dcs, 1.e-6_r8] + + lam_bnd_snow = 1._r8/[2000.e-6_r8, 2._r8*dcs] ! h1g, 2020-07-30 +! lam_bnd_snow = 1._r8/[5000.e-6_r8, 2._r8*dcs] ! h1g, 2020-08-08 + + mg_ice_props = MGHydrometeorProps(rhoi, dsph, & + ice_lambda_bounds, min_mean_mass_ice) + + mg_rain_props = MGHydrometeorProps(rhow, dsph, lam_bnd_rain) + mg_snow_props = MGHydrometeorProps(rhosn, dsph, lam_bnd_snow) + +end subroutine micro_mg_utils_init + +! Constructor for a constituent property object. +function NewMGHydrometeorProps(rho, eff_dim, lambda_bounds, min_mean_mass) & + result(res) + real(r8), intent(in) :: rho, eff_dim + real(r8), intent(in), optional :: lambda_bounds(2), min_mean_mass + type(MGHydrometeorProps) :: res + + res%rho = rho + res%eff_dim = eff_dim + if (present(lambda_bounds)) then + res%lambda_bounds = lambda_bounds + else + res%lambda_bounds = no_limiter() + end if + if (present(min_mean_mass)) then + res%min_mean_mass = min_mean_mass + else + res%min_mean_mass = no_limiter() + end if + + res%shape_coef = rho*pi*gamma(eff_dim+1._r8)/6._r8 + +end function NewMGHydrometeorProps + +!======================================================================== +!FORMULAS +!======================================================================== + +! Use gamma function to implement rising factorial extended to the reals. +function rising_factorial_r8(x, n) result(res) + real(r8), intent(in) :: x, n + real(r8) :: res + + res = gamma(x+n)/gamma(x) + +end function rising_factorial_r8 + +! Rising factorial can be performed much cheaper if n is a small integer. +function rising_factorial_integer(x, n) result(res) + real(r8), intent(in) :: x + integer, intent(in) :: n + real(r8) :: res + + integer :: i + real(r8) :: factor + + res = 1._r8 + factor = x + + do i = 1, n + res = res * factor + factor = factor + 1._r8 + end do + +end function rising_factorial_integer + +! Calculate correction due to latent heat for evaporation/sublimation +elemental function calc_ab(t, qv, xxl) result(ab) + real(r8), intent(in) :: t ! Temperature + real(r8), intent(in) :: qv ! Saturation vapor pressure + real(r8), intent(in) :: xxl ! Latent heat + + real(r8) :: ab + + real(r8) :: dqsdt + + dqsdt = xxl*qv / (rv * t**2) + ab = 1._r8 + dqsdt*xxl/cpp + +end function calc_ab + +! get cloud droplet size distribution parameters +subroutine size_dist_param_liq_line(props, qcic, ncic, rho, pgam, lamc) + type(MGHydrometeorProps), intent(in) :: props + real(r8), intent(in) :: qcic + real(r8), intent(inout) :: ncic + real(r8), intent(in) :: rho + + real(r8), intent(out) :: pgam + real(r8), intent(out) :: lamc + + type(MGHydrometeorProps) :: props_loc + + if (qcic > qsmall) then + + ! Local copy of properties that can be modified. + ! (Elemental routines that operate on arrays can't modify scalar + ! arguments.) + props_loc = props + + ! Get pgam from fit to observations of martin et al. 1994 + pgam = 1.0_r8 - 0.7_r8 * exp(-0.008_r8*1.e-6_r8*ncic*rho) + pgam = 1._r8/(pgam**2) - 1._r8 + pgam = max(pgam, 2._r8) + + ! Set coefficient for use in size_dist_param_basic. + ! The 3D case is so common and optimizable that we specialize it: + if (props_loc%eff_dim == 3._r8) then + props_loc%shape_coef = pi / 6._r8 * props_loc%rho * & + ! rising_factorial(pgam+1._r8, 3) + gamma(pgam+4._r8)/gamma(pgam+1._r8) ! h1g, 2016-12-09 + else + props_loc%shape_coef = pi / 6._r8 * props_loc%rho * & + ! rising_factorial(pgam+1._r8, props_loc%eff_dim) + gamma(pgam+1._r8+props_loc%eff_dim)/gamma(pgam+1._r8) ! h1g, 2016-12-09 + end if + + ! Limit to between 2 and 50 microns mean size. + props_loc%lambda_bounds = (pgam+1._r8)*1._r8/[50.e-6_r8, 2.e-6_r8] + + call size_dist_param_basic(props_loc, qcic, ncic, lamc) + + else + ! pgam not calculated in this case, so set it to a value likely to + ! cause an error if it is accidentally used + ! (gamma function undefined for negative integers) + pgam = -100._r8 + lamc = 0._r8 + end if + +end subroutine size_dist_param_liq_line + +! get cloud droplet size distribution parameters + +subroutine size_dist_param_liq_vect(props, qcic, ncic, rho, pgam, lamc, mgncol) + + type(mghydrometeorprops), intent(in) :: props + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: qcic + real(r8), dimension(mgncol), intent(inout) :: ncic + real(r8), dimension(mgncol), intent(in) :: rho + real(r8), dimension(mgncol), intent(out) :: pgam + real(r8), dimension(mgncol), intent(out) :: lamc + type(mghydrometeorprops) :: props_loc + integer :: i + + do i=1,mgncol + if (qcic(i) > qsmall) then + ! Local copy of properties that can be modified. + ! (Elemental routines that operate on arrays can't modify scalar + ! arguments.) + props_loc = props + ! Get pgam from fit to observations of martin et al. 1994 + pgam(i) = 1.0_r8 - 0.7_r8 * exp(-0.008_r8*1.e-6_r8*ncic(i)*rho(i)) + pgam(i) = 1._r8/(pgam(i)**2) - 1._r8 + pgam(i) = max(pgam(i), 2._r8) + endif + enddo + do i=1,mgncol + if (qcic(i) > qsmall) then + ! Set coefficient for use in size_dist_param_basic. + ! The 3D case is so common and optimizable that we specialize + ! it: + if (props_loc%eff_dim == 3._r8) then + props_loc%shape_coef = pi / 6._r8 * props_loc%rho * & + ! rising_factorial(pgam(i)+1._r8, 3) + gamma(pgam(i)+4._r8)/gamma(pgam(i)+1._r8) ! h1g 2016-12-09 + else + props_loc%shape_coef = pi / 6._r8 * props_loc%rho * & + ! rising_factorial(pgam(i)+1._r8, props_loc%eff_dim) + gamma(pgam(i)+1._r8+props_loc%eff_dim)/gamma(pgam(i)+1._r8) ! h1g 2016-12-09 + end if + ! Limit to between 2 and 50 microns mean size. + props_loc%lambda_bounds(1) = (pgam(i)+1._r8)*1._r8/50.e-6_r8 + props_loc%lambda_bounds(2) = (pgam(i)+1._r8)*1._r8/2.e-6_r8 + call size_dist_param_basic(props_loc, qcic(i), ncic(i), lamc(i)) + endif + enddo + do i=1,mgncol + if (qcic(i) <= qsmall) then + ! pgam not calculated in this case, so set it to a value likely to + ! cause an error if it is accidentally used + ! (gamma function undefined for negative integers) + pgam(i) = -100._r8 + lamc(i) = 0._r8 + end if + enddo + +end subroutine size_dist_param_liq_vect + +! Basic routine for getting size distribution parameters. +elemental subroutine size_dist_param_basic_line(props, qic, nic, lam, n0) + type(MGHydrometeorProps), intent(in) :: props + real(r8), intent(in) :: qic + real(r8), intent(inout) :: nic + + real(r8), intent(out) :: lam + real(r8), intent(out), optional :: n0 + + if (qic > qsmall) then + + ! add upper limit to in-cloud number concentration to prevent + ! numerical error + if (limiter_is_on(props%min_mean_mass)) then + nic = min(nic, qic / props%min_mean_mass) + end if + + ! lambda = (c n/q)^(1/d) + lam = (props%shape_coef * nic/qic)**(1._r8/props%eff_dim) + + ! check for slope + ! adjust vars + if (lam < props%lambda_bounds(1)) then + lam = props%lambda_bounds(1) + nic = lam**(props%eff_dim) * qic/props%shape_coef + else if (lam > props%lambda_bounds(2)) then + lam = props%lambda_bounds(2) + nic = lam**(props%eff_dim) * qic/props%shape_coef + end if + + else + lam = 0._r8 + end if + + if (present(n0)) n0 = nic * lam + +end subroutine size_dist_param_basic_line + +subroutine size_dist_param_basic_vect(props, qic, nic, lam, mgncol, n0) + + type (mghydrometeorprops), intent(in) :: props + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: qic + real(r8), dimension(mgncol), intent(inout) :: nic + real(r8), dimension(mgncol), intent(out) :: lam + real(r8), dimension(mgncol), intent(out), optional :: n0 + integer :: i + do i=1,mgncol + + if (qic(i) > qsmall) then + + ! add upper limit to in-cloud number concentration to prevent + ! numerical error + if (limiter_is_on(props%min_mean_mass)) then + nic(i) = min(nic(i), qic(i) / props%min_mean_mass) + end if + + ! lambda = (c n/q)^(1/d) + lam(i) = (props%shape_coef * nic(i)/qic(i))**(1._r8/props%eff_dim) + + ! check for slope + ! adjust vars + if (lam(i) < props%lambda_bounds(1)) then + lam(i) = props%lambda_bounds(1) + nic(i) = lam(i)**(props%eff_dim) * qic(i)/props%shape_coef + else if (lam(i) > props%lambda_bounds(2)) then + lam(i) = props%lambda_bounds(2) + nic(i) = lam(i)**(props%eff_dim) * qic(i)/props%shape_coef + end if + + else + lam(i) = 0._r8 + end if + + enddo + + if (present(n0)) n0 = nic * lam + +end subroutine size_dist_param_basic_vect + + +real(r8) elemental function avg_diameter(q, n, rho_air, rho_sub) + ! Finds the average diameter of particles given their density, and + ! mass/number concentrations in the air. + ! Assumes that diameter follows an exponential distribution. + real(r8), intent(in) :: q ! mass mixing ratio + real(r8), intent(in) :: n ! number concentration (per volume) + real(r8), intent(in) :: rho_air ! local density of the air + real(r8), intent(in) :: rho_sub ! density of the particle substance + + avg_diameter = (pi * rho_sub * n/(q*rho_air))**(-1._r8/3._r8) + +end function avg_diameter + +function var_coef_r8(relvar, a) result(res) + ! Finds a coefficient for process rates based on the relative variance + ! of cloud water. + real(r8), intent(in) :: relvar + real(r8), intent(in) :: a + real(r8) :: res + +! res = rising_factorial(relvar, a) / relvar**a + res = gamma(relvar+a)/gamma(relvar)/ relvar**a ! h1g, 2016-12-09 + +end function var_coef_r8 + +function var_coef_integer(relvar, a) result(res) + ! Finds a coefficient for process rates based on the relative variance + ! of cloud water. + real(r8), intent(in) :: relvar + integer, intent(in) :: a + real(r8) :: res + +! res = rising_factorial(relvar, a) / relvar**a + res = gamma(relvar+a)/gamma(relvar)/ relvar**a ! h1g, 2016-12-09 + +end function var_coef_integer + +!======================================================================== +!MICROPHYSICAL PROCESS CALCULATIONS +!======================================================================== +!======================================================================== +! Initial ice deposition and sublimation loop. +! Run before the main loop +! This subroutine written by Peter Caldwell + +subroutine ice_deposition_sublimation(t, qv, qc, qi, ni, & ! h1g 2020-03-31 + icldm, rho, dv,qvl, qvi, & + berg, vap_dep, ice_sublim, mgncol) + + !INPUT VARS: + !=============================================== + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t + real(r8), dimension(mgncol), intent(in) :: qv + real(r8), dimension(mgncol), intent(in) :: qc ! h1g 2020-03-31 + real(r8), dimension(mgncol), intent(in) :: qi + real(r8), dimension(mgncol), intent(in) :: ni + real(r8), dimension(mgncol), intent(in) :: icldm + real(r8), dimension(mgncol), intent(in) :: rho + real(r8), dimension(mgncol), intent(in) :: dv + real(r8), dimension(mgncol), intent(in) :: qvl + real(r8), dimension(mgncol), intent(in) :: qvi + + !OUTPUT VARS: + !=============================================== + real(r8), dimension(mgncol), intent(out) :: vap_dep !ice deposition (cell-ave value) + real(r8), dimension(mgncol), intent(out) :: ice_sublim !ice sublimation (cell-ave value) + real(r8), dimension(mgncol), intent(out) :: berg !bergeron enhancement (cell-ave value) + + !INTERNAL VARS: + !=============================================== + real(r8) :: ab + real(r8) :: epsi + real(r8) :: qiic + real(r8) :: niic + real(r8) :: lami + real(r8) :: n0i + integer :: i + + do i=1,mgncol + if (qi(i)>=qsmall) then + + !GET IN-CLOUD qi, ni + !=============================================== + qiic = qi(i)/icldm(i) + niic = ni(i)/icldm(i) + + !Compute linearized condensational heating correction + ab=calc_ab(t(i), qvi(i), xxls) + !Get slope and intercept of gamma distn for ice. + call size_dist_param_basic(mg_ice_props, qiic, niic, lami, n0i) + !Get depletion timescale=1/eps + epsi = 2._r8*pi*n0i*rho(i)*Dv(i)/(lami*lami) + + !Compute deposition/sublimation + vap_dep(i) = epsi/ab*(qv(i) - qvi(i)) + + !Make this a grid-averaged quantity + vap_dep(i)=vap_dep(i)*icldm(i) + + !Split into deposition or sublimation. + if (t(i) < tmelt .and. vap_dep(i)>0._r8) then + ice_sublim(i)=0._r8 + else + ! make ice_sublim negative for consistency with other evap/sub processes + ice_sublim(i)=min(vap_dep(i),0._r8) + vap_dep(i)=0._r8 + end if + + !sublimation occurs @ any T. Not so for berg. + if ( t(i)>tmelt-40.0 .and. t(i)qsmall ) then ! h1g 2020-06-25 + + !Compute bergeron rate assuming cloud for whole step. + berg(i) = max(epsi/ab*(qvl(i) - qvi(i)), 0._r8) + berg(i) = berg(i) * icldm(i) + else !T>frz + berg(i)=0._r8 + end if !Tqsmall + enddo +end subroutine ice_deposition_sublimation + + +!======================================================================== +! autoconversion of cloud liquid water to rain +! formula from Manton and Cotton (1977). +! This formula has been used in Chen and Cotton (1987), +! modified for sub-grid distribution of qc +! minimum qc of 1 x 10^-8 prevents floating point error + +subroutine cotton_liq_autoconversion(microp_uniform, qcic, & + ncic, rho, relvar, rthresh, prc, nprc, nprc1, mgncol) + + integer, intent(in) :: mgncol + logical, intent(in) :: microp_uniform + + real(r8), intent(in) :: rthresh + + real(r8), dimension(mgncol), intent(in) :: qcic + real(r8), dimension(mgncol), intent(in) :: ncic + real(r8), dimension(mgncol), intent(in) :: rho + + real(r8), dimension(mgncol), intent(in) :: relvar + + real(r8), dimension(mgncol), intent(out) :: prc + real(r8), dimension(mgncol), intent(out) :: nprc + real(r8), dimension(mgncol), intent(out) :: nprc1 + + real(r8), dimension(mgncol) :: prc_coef + integer :: i + real(r8) :: rad_liq + + ! Take variance into account, or use uniform value. + if (.not. microp_uniform) then + ! prc_coef(:) = var_coef(relvar(:), 2.47_r8) + do i=1,mgncol + prc_coef(i) = gamma(relvar(i)+2.33_r8)/gamma(relvar(i))/ relvar(i)**2.33 ! h1g, 2016-12-09 + enddo + else + prc_coef(:) = 1._r8 + end if + + do i=1,mgncol + rad_liq = 620350.49* (qcic(i)/max(ncic(i),icsmall)/rhow)**(0.33_r8) + if (qcic(i) >= icsmall .and. rad_liq > rthresh ) then + + ! nprc is increase in rain number conc due to autoconversion + ! nprc1 is decrease in cloud droplet conc due to autoconversion + + ! assume exponential sub-grid distribution of qc, resulting in additional + ! factor related to qcvar below + ! switch for sub-columns, don't include sub-grid qc + + prc(i) = prc_coef(i) * & + 32681. * qcic(i)**2.33_r8 * (ncic(i)*rho(i)*rhow)**(-0.33_r8) + nprc(i) = prc(i) * (1._r8/droplet_mass_25um) + nprc1(i) = prc(i)*ncic(i)/qcic(i) + + else + prc(i)=0._r8 + nprc(i)=0._r8 + nprc1(i)=0._r8 + end if + enddo +end subroutine cotton_liq_autoconversion + + +!======================================================================== +! autoconversion of cloud liquid water to rain +! formula from Khrouditnov and Kogan (2000), modified for sub-grid distribution of qc +! minimum qc of 1 x 10^-8 prevents floating point error + +subroutine kk2000_liq_autoconversion(microp_uniform, qcic, & + ncic, rho, relvar, prc, nprc, nprc1, mgncol) + + integer, intent(in) :: mgncol + logical, intent(in) :: microp_uniform + + real(r8), dimension(mgncol), intent(in) :: qcic + real(r8), dimension(mgncol), intent(in) :: ncic + real(r8), dimension(mgncol), intent(in) :: rho + + real(r8), dimension(mgncol), intent(in) :: relvar + + real(r8), dimension(mgncol), intent(out) :: prc + real(r8), dimension(mgncol), intent(out) :: nprc + real(r8), dimension(mgncol), intent(out) :: nprc1 + + real(r8), dimension(mgncol) :: prc_coef + integer :: i + + ! Take variance into account, or use uniform value. + if (.not. microp_uniform) then + ! prc_coef(:) = var_coef(relvar(:), 2.47_r8) + do i=1,mgncol + prc_coef(i) = gamma(relvar(i)+2.47_r8)/gamma(relvar(i))/ relvar(i)**2.47 ! h1g, 2016-12-09 + enddo + else + prc_coef(:) = 1._r8 + end if + + do i=1,mgncol + if (qcic(i) >= icsmall) then + + ! nprc is increase in rain number conc due to autoconversion + ! nprc1 is decrease in cloud droplet conc due to autoconversion + + ! assume exponential sub-grid distribution of qc, resulting in additional + ! factor related to qcvar below + ! switch for sub-columns, don't include sub-grid qc + + prc(i) = prc_coef(i) * & + 0.01_r8 * 1350._r8 * qcic(i)**2.47_r8 * (ncic(i)*1.e-6_r8*rho(i))**(-1.1_r8) + nprc(i) = prc(i) * (1._r8/droplet_mass_25um) + nprc1(i) = prc(i)*ncic(i)/qcic(i) + + else + prc(i)=0._r8 + nprc(i)=0._r8 + nprc1(i)=0._r8 + end if + enddo +end subroutine kk2000_liq_autoconversion + + !======================================================================== +subroutine sb2001v2_liq_autoconversion(pgam,qc,nc,qr,rho,relvar,au,nprc,nprc1,mgncol) + ! + ! --------------------------------------------------------------------- + ! AUTO_SB: calculates the evolution of mass- and number mxg-ratio for + ! drizzle drops due to autoconversion. The autoconversion rate assumes + ! f(x)=A*x**(nu_c)*exp(-Bx) in drop MASS x. + + ! Code from Hugh Morrison, Sept 2014 + + ! autoconversion + ! use simple lookup table of dnu values to get mass spectral shape parameter + ! equivalent to the size spectral shape parameter pgam + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent (in) :: pgam + real(r8), dimension(mgncol), intent (in) :: qc ! = qc (cld water mixing ratio) + real(r8), dimension(mgncol), intent (in) :: nc ! = nc (cld water number conc /kg) + real(r8), dimension(mgncol), intent (in) :: qr ! = qr (rain water mixing ratio) + real(r8), dimension(mgncol), intent (in) :: rho ! = rho : density profile + real(r8), dimension(mgncol), intent (in) :: relvar + + real(r8), dimension(mgncol), intent (out) :: au ! = prc autoconversion rate + real(r8), dimension(mgncol), intent (out) :: nprc1 ! = number tendency + real(r8), dimension(mgncol), intent (out) :: nprc ! = number tendency fixed size for rain + + ! parameters for droplet mass spectral shape, + !used by Seifert and Beheng (2001) + ! warm rain scheme only (iparam = 1) + real(r8), parameter :: dnu(16) = [0._r8,-0.557_r8,-0.430_r8,-0.307_r8, & + -0.186_r8,-0.067_r8,0.050_r8,0.167_r8,0.282_r8,0.397_r8,0.512_r8, & + 0.626_r8,0.739_r8,0.853_r8,0.966_r8,0.966_r8] + + ! parameters for Seifert and Beheng (2001) autoconversion/accretion + real(r8), parameter :: kc = 9.44e9_r8 + real(r8), parameter :: kr = 5.78e3_r8 + real(r8) :: dum, dum1, nu, pra_coef + integer :: dumi, i + + do i=1,mgncol + + pra_coef = var_coef(relvar(i), 4._r8) + + if (qc(i) > qsmall) then + dumi=int(pgam(i)) + nu=dnu(dumi)+(dnu(dumi+1)-dnu(dumi))* & + (pgam(i)-dumi) + + dum = 1._r8-qc(i)/(qc(i)+qr(i)) + dum1 = 600._r8*dum**0.68_r8*(1._r8-dum**0.68_r8)**3 + + au(i) = pra_coef * kc/(20._r8*2.6e-7_r8)* & + (nu+2._r8)*(nu+4._r8)/(nu+1._r8)**2._r8* & + (rho(i)*qc(i)/1000._r8)**4._r8/(rho(i)*nc(i)/1.e6_r8)**2._r8* & + (1._r8+dum1/(1._r8-dum)**2)*1000._r8 / rho(i) + + nprc1(i) = au(i)*2._r8/2.6e-7_r8*1000._r8 + nprc(i) = au(i)/droplet_mass_40um + else + au(i) = 0._r8 + nprc1(i) = 0._r8 + nprc(i)=0._r8 + end if + + enddo + + end subroutine sb2001v2_liq_autoconversion + +!======================================================================== +!SB2001 Accretion V2 + +subroutine sb2001v2_accre_cld_water_rain(qc,nc,qr,rho,relvar,pra,npra,mgncol) + ! + ! --------------------------------------------------------------------- + ! ACCR_SB calculates the evolution of mass mxng-ratio due to accretion + ! and self collection following Seifert & Beheng (2001). + ! + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent (in) :: qc ! = qc (cld water mixing ratio) + real(r8), dimension(mgncol), intent (in) :: nc ! = nc (cld water number conc /kg) + real(r8), dimension(mgncol), intent (in) :: qr ! = qr (rain water mixing ratio) + real(r8), dimension(mgncol), intent (in) :: rho ! = rho : density profile + real(r8), dimension(mgncol), intent (in) :: relvar + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: pra ! MMR + real(r8), dimension(mgncol), intent(out) :: npra ! Number + + ! parameters for Seifert and Beheng (2001) autoconversion/accretion + real(r8), parameter :: kc = 9.44e9_r8 + real(r8), parameter :: kr = 5.78e3_r8 + + real(r8) :: dum, dum1, pra_coef + integer :: i + + ! accretion + + do i =1,mgncol + + pra_coef = var_coef(relvar(i), 1._r8) + + if (qc(i) > qsmall) then + dum = 1._r8-qc(i)/(qc(i)+qr(i)) + dum1 = (dum/(dum+5.e-4_r8))**4._r8 + pra(i) = pra_coef *kr*rho(i)*0.001_r8*qc(i)*qr(i)*dum1 + npra(i) = pra(i)*rho(i)*0.001_r8*(nc(i)*rho(i)*1.e-6_r8)/ & + (qc(i)*rho(i)*0.001_r8)*1.e6_r8 / rho(i) + else + pra(i) = 0._r8 + npra(i) = 0._r8 + end if + + enddo + + end subroutine sb2001v2_accre_cld_water_rain + +!======================================================================== +! Autoconversion of cloud ice to snow +! similar to Ferrier (1994) + +subroutine ice_autoconversion(t, qiic, lami, n0i, dcs, prci, nprci, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t + real(r8), dimension(mgncol), intent(in) :: qiic + real(r8), dimension(mgncol), intent(in) :: lami + real(r8), dimension(mgncol), intent(in) :: n0i + real(r8), intent(in) :: dcs + + real(r8), dimension(mgncol), intent(out) :: prci + real(r8), dimension(mgncol), intent(out) :: nprci + + ! Assume autoconversion timescale of 180 seconds. + real(r8), parameter :: ac_time = 180._r8 + + ! Average mass of an ice particle. + real(r8) :: m_ip + ! Ratio of autoconversion diameter to average diameter. + real(r8) :: d_rat + integer :: i + + do i=1,mgncol + if (t(i) <= tmelt .and. qiic(i) >= qsmall) then + + d_rat = lami(i)*dcs + + ! Rate of ice particle conversion (number). + nprci(i) = n0i(i)/(lami(i)*ac_time)*exp(-d_rat) + + m_ip = (rhoi*pi/6._r8) / lami(i)**3 + + ! Rate of mass conversion. + ! Note that this is: + ! m n (d^3 + 3 d^2 + 6 d + 6) + prci(i) = m_ip * nprci(i) * & + (((d_rat + 3._r8)*d_rat + 6._r8)*d_rat + 6._r8) + + else + prci(i) = 0._r8 + nprci(i) = 0._r8 + end if + enddo +end subroutine ice_autoconversion + +! immersion freezing (Bigg, 1953) +!=================================== + +subroutine immersion_freezing(microp_uniform, t, pgam, lamc, & + qcic, ncic, relvar, mnuccc, nnuccc, mgncol) + + integer, intent(in) :: mgncol + logical, intent(in) :: microp_uniform + + ! Temperature + real(r8), dimension(mgncol), intent(in) :: t + + ! Cloud droplet size distribution parameters + real(r8), dimension(mgncol), intent(in) :: pgam + real(r8), dimension(mgncol), intent(in) :: lamc + + ! MMR and number concentration of in-cloud liquid water + real(r8), dimension(mgncol), intent(in) :: qcic + real(r8), dimension(mgncol), intent(in) :: ncic + + ! Relative variance of cloud water + real(r8), dimension(mgncol), intent(in) :: relvar + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: mnuccc ! MMR + real(r8), dimension(mgncol), intent(out) :: nnuccc ! Number + + ! Coefficients that will be omitted for sub-columns + real(r8), dimension(mgncol) :: dum + integer :: i + + if (.not. microp_uniform) then +! dum(:) = var_coef(relvar, 2) + do i=1,mgncol + dum(i) = gamma(relvar(i)+2)/gamma(relvar(i))/ relvar(i)**2 ! h1g, 2016-12-09 + enddo + else + dum(:) = 1._r8 + end if + do i=1,mgncol + + if (qcic(i) >= qsmall .and. t(i) < 269.15_r8) then + + nnuccc(i) = & + pi/6._r8*ncic(i)*rising_factorial(pgam(i)+1._r8, 3)* & + bimm*(exp(aimm*(tmelt - t(i)))-1._r8)/lamc(i)**3 + + mnuccc(i) = dum(i) * nnuccc(i) * & + pi/6._r8*rhow* & + rising_factorial(pgam(i)+4._r8, 3)/lamc(i)**3 + + else + mnuccc(i) = 0._r8 + nnuccc(i) = 0._r8 + end if ! qcic > qsmall and t < 4 deg C + enddo + +end subroutine immersion_freezing + +! contact freezing (-40= qsmall .and. t(i) < 269.15_r8) then + + if (.not. microp_uniform) then + dum = var_coef(relvar(i), 4._r8/3._r8) + dum1 = var_coef(relvar(i), 1._r8/3._r8) + else + dum = 1._r8 + dum1 = 1._r8 + endif + + tcnt=(270.16_r8-t(i))**1.3_r8 + viscosity = 1.8e-5_r8*(t(i)/298.0_r8)**0.85_r8 ! Viscosity (kg/m/s) + mfp = 2.0_r8*viscosity/ & ! Mean free path (m) + (p(i)*sqrt( 8.0_r8*28.96e-3_r8/(pi*8.314409_r8*t(i)) )) + + ! Note that these two are vectors. + nslip = 1.0_r8+(mfp/rndst(i,:))*(1.257_r8+(0.4_r8*exp(-(1.1_r8*rndst(i,:)/mfp))))! Slip correction factor + + ndfaer = 1.381e-23_r8*t(i)*nslip/(6._r8*pi*viscosity*rndst(i,:)) ! aerosol diffusivity (m2/s) + + contact_factor = dot_product(ndfaer,nacon(i,:)*tcnt) * pi * & + ncic(i) * (pgam(i) + 1._r8) / lamc(i) + + mnucct(i) = dum * contact_factor * & + pi/3._r8*rhow*rising_factorial(pgam(i)+2._r8, 3)/lamc(i)**3 + + nnucct(i) = dum1 * 2._r8 * contact_factor + + else + + mnucct(i)=0._r8 + nnucct(i)=0._r8 + + end if ! qcic > qsmall and t < 4 deg C + end do + +end subroutine contact_freezing + +! snow self-aggregation from passarelli, 1978, used by reisner, 1998 +!=================================================================== +! this is hard-wired for bs = 0.4 for now +! ignore self-collection of cloud ice + +subroutine snow_self_aggregation(t, rho, asn, rhosn, qsic, nsic, nsagg, mgncol) + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + real(r8), dimension(mgncol), intent(in) :: rho ! Density + real(r8), dimension(mgncol), intent(in) :: asn ! fall speed parameter for snow + real(r8), intent(in) :: rhosn ! density of snow + + ! In-cloud snow + real(r8), dimension(mgncol), intent(in) :: qsic ! MMR + real(r8), dimension(mgncol), intent(in) :: nsic ! Number + + ! Output number tendency + real(r8), dimension(mgncol), intent(out) :: nsagg + + integer :: i + + do i=1,mgncol + if (qsic(i) >= qsmall .and. t(i) <= tmelt) then + nsagg(i) = -1108._r8*eii/(4._r8*720._r8*rhosn)*asn(i)*qsic(i)*nsic(i)*rho(i)*& + ((qsic(i)/nsic(i))*(1._r8/(rhosn*pi)))**((bs-1._r8)/3._r8) + else + nsagg(i)=0._r8 + end if + enddo +end subroutine snow_self_aggregation + +! accretion of cloud droplets onto snow/graupel +!=================================================================== +! here use continuous collection equation with +! simple gravitational collection kernel +! ignore collisions between droplets/cloud ice +! since minimum size ice particle for accretion is 50 - 150 micron + +subroutine accrete_cloud_water_snow(t, rho, asn, uns, mu, qcic, ncic, qsic, & + pgam, lamc, lams, n0s, psacws, npsacws, use_const_ELI, ELI, mgncol) !h1g, 2020-04-16 + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + real(r8), dimension(mgncol), intent(in) :: rho ! Density + real(r8), dimension(mgncol), intent(in) :: asn ! Fallspeed parameter (snow) + real(r8), dimension(mgncol), intent(in) :: uns ! Current fallspeed (snow) + real(r8), dimension(mgncol), intent(in) :: mu ! Viscosity + + ! In-cloud liquid water + real(r8), dimension(mgncol), intent(in) :: qcic ! MMR + real(r8), dimension(mgncol), intent(in) :: ncic ! Number + + ! In-cloud snow + real(r8), dimension(mgncol), intent(in) :: qsic ! MMR + + ! Cloud droplet size parameters + real(r8), dimension(mgncol), intent(in) :: pgam + real(r8), dimension(mgncol), intent(in) :: lamc + + ! Snow size parameters + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + +!--> h1g, 2020-04-16 + logical, intent(in) :: use_const_ELI + real(r8), intent(in) :: ELI +!<-- h1g, 2020-04-16 + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: psacws ! Mass mixing ratio + real(r8), dimension(mgncol), intent(out) :: npsacws ! Number concentration + + real(r8) :: dc0 ! Provisional mean droplet size + real(r8) :: dum + real(r8) :: eci ! collection efficiency for riming of snow by droplets + + ! Fraction of cloud droplets accreted per second + real(r8) :: accrete_rate + integer :: i + + ! ignore collision of snow with droplets above freezing + + do i=1,mgncol + if (qsic(i) >= qsmall .and. t(i) <= tmelt .and. qcic(i) >= qsmall) then + + ! put in size dependent collection efficiency + ! mean diameter of snow is area-weighted, since + ! accretion is function of crystal geometric area + ! collection efficiency is approximation based on stoke's law (Thompson et al. 2004) + + dc0 = (pgam(i)+1._r8)/lamc(i) + dum = dc0*dc0*uns(i)*rhow*lams(i)/(9._r8*mu(i)) + eci = dum*dum/((dum+0.4_r8)*(dum+0.4_r8)) + + eci = max(eci,0._r8) + eci = min(eci,1._r8) + +!--> h1g, 2020-04-16 + if ( use_const_ELI ) eci = ELI +!<-- h1g, 2020-04-16 + + + ! no impact of sub-grid distribution of qc since psacws + ! is linear in qc + accrete_rate = pi/4._r8*asn(i)*rho(i)*n0s(i)*eci*gamma_bs_plus3 / lams(i)**(bs+3._r8) + psacws(i) = accrete_rate*qcic(i) + npsacws(i) = accrete_rate*ncic(i) + else + psacws(i) = 0._r8 + npsacws(i) = 0._r8 + end if + enddo +end subroutine accrete_cloud_water_snow + +! add secondary ice production due to accretion of droplets by snow +!=================================================================== +! (Hallet-Mossop process) (from Cotton et al., 1986) + +subroutine secondary_ice_production(t, psacws, msacwi, nsacwi, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + + ! Accretion of cloud water to snow tendencies + real(r8), dimension(mgncol), intent(inout) :: psacws ! MMR + + ! Output (ice) tendencies + real(r8), dimension(mgncol), intent(out) :: msacwi ! MMR + real(r8), dimension(mgncol), intent(out) :: nsacwi ! Number + integer :: i + + do i=1,mgncol + if((t(i) < 270.16_r8) .and. (t(i) >= 268.16_r8)) then + nsacwi(i) = 3.5e8_r8*(270.16_r8-t(i))/2.0_r8*psacws(i) + else if((t(i) < 268.16_r8) .and. (t(i) >= 265.16_r8)) then + nsacwi(i) = 3.5e8_r8*(t(i)-265.16_r8)/3.0_r8*psacws(i) + else + nsacwi(i) = 0.0_r8 + endif + enddo + + do i=1,mgncol + msacwi(i) = min(nsacwi(i)*mi0, psacws(i)) + psacws(i) = psacws(i) - msacwi(i) + enddo +end subroutine secondary_ice_production + +! accretion of rain water by snow +!=================================================================== +! formula from ikawa and saito, 1991, used by reisner et al., 1998 + +subroutine accrete_rain_snow(t, rho, umr, ums, unr, uns, qric, qsic, & + lamr, n0r, lams, n0s, pracs, npracs, mgncol) + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + real(r8), dimension(mgncol), intent(in) :: rho ! Density + + ! Fallspeeds + ! mass-weighted + real(r8), dimension(mgncol), intent(in) :: umr ! rain + real(r8), dimension(mgncol), intent(in) :: ums ! snow + ! number-weighted + real(r8), dimension(mgncol), intent(in) :: unr ! rain + real(r8), dimension(mgncol), intent(in) :: uns ! snow + + ! In cloud MMRs + real(r8), dimension(mgncol), intent(in) :: qric ! rain + real(r8), dimension(mgncol), intent(in) :: qsic ! snow + + ! Size distribution parameters + ! rain + real(r8), dimension(mgncol), intent(in) :: lamr + real(r8), dimension(mgncol), intent(in) :: n0r + ! snow + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: pracs ! MMR + real(r8), dimension(mgncol), intent(out) :: npracs ! Number + + ! Collection efficiency for accretion of rain by snow + real(r8), parameter :: ecr = 1.0_r8 + + ! Ratio of average snow diameter to average rain diameter. + real(r8) :: d_rat + ! Common factor between mass and number expressions + real(r8) :: common_factor + integer :: i + + do i=1,mgncol + if (qric(i) >= icsmall .and. qsic(i) >= icsmall .and. t(i) <= tmelt) then + + common_factor = pi*ecr*rho(i)*n0r(i)*n0s(i)/(lamr(i)**3 * lams(i)) + + d_rat = lamr(i)/lams(i) + + pracs(i) = common_factor*pi*rhow* & + sqrt((1.2_r8*umr(i)-0.95_r8*ums(i))**2 + 0.08_r8*ums(i)*umr(i)) / lamr(i)**3 * & + ((0.5_r8*d_rat + 2._r8)*d_rat + 5._r8) + + npracs(i) = common_factor*0.5_r8* & + sqrt(1.7_r8*(unr(i)-uns(i))**2 + 0.3_r8*unr(i)*uns(i)) * & + ((d_rat + 1._r8)*d_rat + 1._r8) + + else + pracs(i) = 0._r8 + npracs(i) = 0._r8 + end if + enddo +end subroutine accrete_rain_snow + +! heterogeneous freezing of rain drops +!=================================================================== +! follows from Bigg (1953) + +subroutine heterogeneous_rain_freezing(t, qric, nric, lamr, mnuccr, nnuccr, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + + ! In-cloud rain + real(r8), dimension(mgncol), intent(in) :: qric ! MMR + real(r8), dimension(mgncol), intent(in) :: nric ! Number + real(r8), dimension(mgncol), intent(in) :: lamr ! size parameter + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: mnuccr ! MMR + real(r8), dimension(mgncol), intent(out) :: nnuccr ! Number + integer :: i + + do i=1,mgncol + + if (t(i) < 269.15_r8 .and. qric(i) >= qsmall) then + nnuccr(i) = pi*nric(i)*bimm* & + (exp(aimm*(tmelt - t(i)))-1._r8)/lamr(i)**3 + + mnuccr(i) = nnuccr(i) * 20._r8*pi*rhow/lamr(i)**3 + + else + mnuccr(i) = 0._r8 + nnuccr(i) = 0._r8 + end if + enddo +end subroutine heterogeneous_rain_freezing + +! accretion of cloud liquid water by rain +!=================================================================== +! formula from Khrouditnov and Kogan (2000) +! gravitational collection kernel, droplet fall speed neglected + +subroutine accrete_cloud_water_rain(microp_uniform, qric, qcic, & + ncic, relvar, pra, npra, mgncol) + + logical, intent(in) :: microp_uniform + integer, intent(in) :: mgncol + ! In-cloud rain + real(r8), dimension(mgncol), intent(in) :: qric ! MMR + + ! Cloud droplets + real(r8), dimension(mgncol), intent(in) :: qcic ! MMR + real(r8), dimension(mgncol), intent(in) :: ncic ! Number + + ! SGS variability + real(r8), dimension(mgncol), intent(in) :: relvar +! real(r8), dimension(mgncol), intent(in) :: accre_enhan + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: pra ! MMR + real(r8), dimension(mgncol), intent(out) :: npra ! Number + + ! Coefficient that varies for subcolumns + real(r8), dimension(mgncol) :: pra_coef + + integer :: i + + if (.not. microp_uniform) then + do i=1, mgncol + pra_coef(i) = gamma(relvar(i)+1.15_r8)/gamma(relvar(i))/ relvar(i)**1.15 ! h1g, 2016-12-09 + enddo + else + pra_coef(:) = 1._r8 + end if + + do i=1,mgncol + + if (qric(i) >= qsmall .and. qcic(i) >= qsmall) then + + ! include sub-grid distribution of cloud water + pra(i) = pra_coef(i) * 67._r8*(qcic(i)*qric(i))**1.15_r8 + + npra(i) = pra(i)*ncic(i)/qcic(i) + + else + pra(i) = 0._r8 + npra(i) = 0._r8 + end if + end do +end subroutine accrete_cloud_water_rain + +! Self-collection of rain drops +!=================================================================== +! from Beheng(1994) + +subroutine self_collection_rain(rho, qric, nric, nragg, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: rho ! Air density + + ! Rain + real(r8), dimension(mgncol), intent(in) :: qric ! MMR + real(r8), dimension(mgncol), intent(in) :: nric ! Number + + ! Output number tendency + real(r8), dimension(mgncol), intent(out) :: nragg + + integer :: i + + do i=1,mgncol + if (qric(i) >= qsmall) then + nragg(i) = -8._r8*nric(i)*qric(i)*rho(i) + else + nragg(i) = 0._r8 + end if + enddo +end subroutine self_collection_rain + + +! Accretion of cloud ice by snow +!=================================================================== +! For this calculation, it is assumed that the Vs >> Vi +! and Ds >> Di for continuous collection + +subroutine accrete_cloud_ice_snow(t, rho, asn, qiic, niic, qsic, & + lams, n0s, prai, nprai, mgncol) + + integer, intent(in) :: mgncol + real(r8), dimension(mgncol), intent(in) :: t ! Temperature + real(r8), dimension(mgncol), intent(in) :: rho ! Density + + real(r8), dimension(mgncol), intent(in) :: asn ! Snow fallspeed parameter + + ! Cloud ice + real(r8), dimension(mgncol), intent(in) :: qiic ! MMR + real(r8), dimension(mgncol), intent(in) :: niic ! Number + + real(r8), dimension(mgncol), intent(in) :: qsic ! Snow MMR + + ! Snow size parameters + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: prai ! MMR + real(r8), dimension(mgncol), intent(out) :: nprai ! Number + + ! Fraction of cloud ice particles accreted per second + real(r8) :: accrete_rate + + integer :: i + + do i=1,mgncol + if (qsic(i) >= qsmall .and. qiic(i) >= qsmall .and. t(i) <= tmelt) then + + accrete_rate = pi/4._r8 * eii * asn(i) * rho(i) * n0s(i) * gamma_bs_plus3/ & + lams(i)**(bs+3._r8) + + prai(i) = accrete_rate * qiic(i) + nprai(i) = accrete_rate * niic(i) + + else + prai(i) = 0._r8 + nprai(i) = 0._r8 + end if + enddo +end subroutine accrete_cloud_ice_snow + +! calculate evaporation/sublimation of rain and snow +!=================================================================== +! note: evaporation/sublimation occurs only in cloud-free portion of grid cell +! in-cloud condensation/deposition of rain and snow is neglected +! except for transfer of cloud water to snow through bergeron process + +subroutine evaporate_sublimate_precip(t, rho, dv, mu, sc, q, qvl, qvi, & + lcldm, precip_frac, arn, asn, qcic, qiic, qric, qsic, lamr, n0r, lams, n0s, & + pre, prds, am_evp_st, mgncol) + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent(in) :: t ! temperature + real(r8), dimension(mgncol), intent(in) :: rho ! air density + real(r8), dimension(mgncol), intent(in) :: dv ! water vapor diffusivity + real(r8), dimension(mgncol), intent(in) :: mu ! viscosity + real(r8), dimension(mgncol), intent(in) :: sc ! schmidt number + real(r8), dimension(mgncol), intent(in) :: q ! humidity + real(r8), dimension(mgncol), intent(in) :: qvl ! saturation humidity (water) + real(r8), dimension(mgncol), intent(in) :: qvi ! saturation humidity (ice) + real(r8), dimension(mgncol), intent(in) :: lcldm ! liquid cloud fraction + real(r8), dimension(mgncol), intent(in) :: precip_frac ! precipitation fraction (maximum overlap) + + ! fallspeed parameters + real(r8), dimension(mgncol), intent(in) :: arn ! rain + real(r8), dimension(mgncol), intent(in) :: asn ! snow + + ! In-cloud MMRs + real(r8), dimension(mgncol), intent(in) :: qcic ! cloud liquid + real(r8), dimension(mgncol), intent(in) :: qiic ! cloud ice + real(r8), dimension(mgncol), intent(in) :: qric ! rain + real(r8), dimension(mgncol), intent(in) :: qsic ! snow + + ! Size parameters + ! rain + real(r8), dimension(mgncol), intent(in) :: lamr + real(r8), dimension(mgncol), intent(in) :: n0r + ! snow + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: pre + real(r8), dimension(mgncol), intent(out) :: prds + real(r8), dimension(mgncol), intent(out) :: am_evp_st ! Fractional area where rain evaporates. + + real(r8) :: qclr ! water vapor mixing ratio in clear air + real(r8) :: ab ! correction to account for latent heat + real(r8) :: eps ! 1/ sat relaxation timescale + + real(r8), dimension(mgncol) :: dum + + integer :: i + + am_evp_st = 0._r8 + ! set temporary cloud fraction to zero if cloud water + ice is very small + ! this will ensure that evaporation/sublimation of precip occurs over + ! entire grid cell, since min cloud fraction is specified otherwise + do i=1,mgncol + if (qcic(i)+qiic(i) < 1.e-6_r8) then + dum(i) = 0._r8 + else + dum(i) = lcldm(i) + end if + enddo + do i=1,mgncol + ! only calculate if there is some precip fraction > cloud fraction + + if (precip_frac(i) > dum(i)) then + + if (qric(i) >= qsmall .or. qsic(i) >= qsmall) then + am_evp_st(i) = precip_frac(i) - dum(i) + + ! calculate q for out-of-cloud region + qclr=(q(i)-dum(i)*qvl(i))/(1._r8-dum(i)) + end if + + ! evaporation of rain + if (qric(i) >= qsmall) then + + ab = calc_ab(t(i), qvl(i), xxlv) + eps = 2._r8*pi*n0r(i)*rho(i)*Dv(i)* & + (f1r/(lamr(i)*lamr(i))+ & + f2r*(arn(i)*rho(i)/mu(i))**0.5_r8* & + sc(i)**(1._r8/3._r8)*gamma_half_br_plus5/ & + (lamr(i)**(5._r8/2._r8+br/2._r8))) + + pre(i) = eps*(qclr-qvl(i))/ab + + ! only evaporate in out-of-cloud region + ! and distribute across precip_frac + pre(i)=min(pre(i)*am_evp_st(i),0._r8) + pre(i)=pre(i)/precip_frac(i) + else + pre(i) = 0._r8 + end if + + ! sublimation of snow + if (qsic(i) >= qsmall) then + ab = calc_ab(t(i), qvi(i), xxls) + eps = 2._r8*pi*n0s(i)*rho(i)*Dv(i)* & + (f1s/(lams(i)*lams(i))+ & + f2s*(asn(i)*rho(i)/mu(i))**0.5_r8* & + sc(i)**(1._r8/3._r8)*gamma_half_bs_plus5/ & + (lams(i)**(5._r8/2._r8+bs/2._r8))) + prds(i) = eps*(qclr-qvi(i))/ab + + ! only sublimate in out-of-cloud region and distribute over precip_frac + prds(i)=min(prds(i)*am_evp_st(i),0._r8) + prds(i)=prds(i)/precip_frac(i) + else + prds(i) = 0._r8 + end if + + else + prds(i) = 0._r8 + pre(i) = 0._r8 + end if + enddo + +end subroutine evaporate_sublimate_precip + +! bergeron process - evaporation of droplets and deposition onto snow +!=================================================================== + +subroutine bergeron_process_snow(t, rho, dv, mu, sc, qvl, qvi, asn, & + qcic, qsic, lams, n0s, bergs, mgncol) + + integer, intent(in) :: mgncol + + real(r8), dimension(mgncol), intent(in) :: t ! temperature + real(r8), dimension(mgncol), intent(in) :: rho ! air density + real(r8), dimension(mgncol), intent(in) :: dv ! water vapor diffusivity + real(r8), dimension(mgncol), intent(in) :: mu ! viscosity + real(r8), dimension(mgncol), intent(in) :: sc ! schmidt number + real(r8), dimension(mgncol), intent(in) :: qvl ! saturation humidity (water) + real(r8), dimension(mgncol), intent(in) :: qvi ! saturation humidity (ice) + + ! fallspeed parameter for snow + real(r8), dimension(mgncol), intent(in) :: asn + + ! In-cloud MMRs + real(r8), dimension(mgncol), intent(in) :: qcic ! cloud liquid + real(r8), dimension(mgncol), intent(in) :: qsic ! snow + + ! Size parameters for snow + real(r8), dimension(mgncol), intent(in) :: lams + real(r8), dimension(mgncol), intent(in) :: n0s + + ! Output tendencies + real(r8), dimension(mgncol), intent(out) :: bergs + + real(r8) :: ab ! correction to account for latent heat + real(r8) :: eps ! 1/ sat relaxation timescale + + integer :: i + + do i=1,mgncol + ! if (qsic(i) >= qsmall.and. qcic(i) >= qsmall .and. t(i) < tmelt) then ! h1g 2020-04-01 + if (qsic(i)>= qsmall .and. t(i)tmelt-40.0 ) then ! h1g 2020-06-25 + ab = calc_ab(t(i), qvi(i), xxls) + eps = 2._r8*pi*n0s(i)*rho(i)*Dv(i)* & + (f1s/(lams(i)*lams(i))+ & + f2s*(asn(i)*rho(i)/mu(i))**0.5_r8* & + sc(i)**(1._r8/3._r8)*gamma_half_bs_plus5/ & + (lams(i)**(5._r8/2._r8+bs/2._r8))) + bergs(i) = eps*(qvl(i)-qvi(i))/ab + else + bergs(i) = 0._r8 + end if + enddo +end subroutine bergeron_process_snow + +!======================================================================== +!UTILITIES +!======================================================================== + +pure function no_limiter() + real(r8) :: no_limiter + + no_limiter = transfer(limiter_off, no_limiter) + +end function no_limiter + +pure function limiter_is_on(lim) + real(r8), intent(in) :: lim + logical :: limiter_is_on + + limiter_is_on = transfer(lim, limiter_off) /= limiter_off + +end function limiter_is_on + +end module micro_mg2_utils diff --git a/atmos_param/moist_processes/moist_processes.F90 b/atmos_param/moist_processes/moist_processes.F90 index 8604d7df..c454fea9 100644 --- a/atmos_param/moist_processes/moist_processes.F90 +++ b/atmos_param/moist_processes/moist_processes.F90 @@ -713,7 +713,7 @@ subroutine moist_processes ( is, ie, js, je, npz, Time, dt, land, ustar, & qdt_dif, Moist_clouds_block, Aerosol=Aerosol) call lscloud_driver & - (is, ie, js, je, Time, dt, Input_mp, & + (is, ie, js, je, Time, dt, lon, lat, Input_mp, & Physics_tendency_block%qdiag, Tend_mp, C2ls_mp, & Output_mp, Removal_mp, & Moist_clouds_block%cloud_data(istrat), & @@ -1504,11 +1504,24 @@ subroutine combined_MP_diagnostics & !--------------------------------------------------------------------- ! define the total and convective ice and ice water path. !--------------------------------------------------------------------- + +!--> h1g, 2020-01-07, "ice_amt" in RK microphysics includes both ice and snow. +! "ice_amt" in MG, MG1.5, and MG2 only include ice. +!in order to compare orange with orange, I added large-scale snow in "ice_amt". + +! if (id_tot_ice_amt > 0 ) & +! used = send_data (id_tot_ice_amt, & +! (Moist_clouds_block%cloud_data(i_lsc)%ice_amt + tot_conv_ice)/ & +! (1.0 + total_conv_cloud), & +! Time, is, js, 1) + if (id_tot_ice_amt > 0 ) & used = send_data (id_tot_ice_amt, & - (Moist_clouds_block%cloud_data(i_lsc)%ice_amt + tot_conv_ice)/ & + (Moist_clouds_block%cloud_data(i_lsc)%ice_amt + tot_conv_ice+Moist_clouds_block%cloud_data(i_lsc)%snow)/ & (1.0 + total_conv_cloud), & Time, is, js, 1) +!<-- h1g, 2020-01-07 + if (query_cmip_diag_id(ID_cli)) then used = send_cmip_data_3d (ID_cli, & diff --git a/atmos_param/physics_driver/physics_driver.F90 b/atmos_param/physics_driver/physics_driver.F90 index ecd4b409..daef46cd 100644 --- a/atmos_param/physics_driver/physics_driver.F90 +++ b/atmos_param/physics_driver/physics_driver.F90 @@ -550,6 +550,11 @@ module physics_driver_mod type(precip_flux_type) :: Precip_flux + +!--> h1g, 2019-11-25 +integer :: itrac +!<-- h1g, 2019-11-25 + contains @@ -810,6 +815,8 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & Physics%control%nqr = get_tracer_index (MODEL_ATMOS, 'rainwat') Physics%control%nqs = get_tracer_index (MODEL_ATMOS, 'snowwat') Physics%control%nqg = get_tracer_index (MODEL_ATMOS, 'graupel') + Physics%control%nqnr = get_tracer_index (MODEL_ATMOS, 'rain_num') + Physics%control%nqns = get_tracer_index (MODEL_ATMOS, 'snow_num') !----------------------------------------------------------------------- ! allocate a logical array to define whether a tracer is a cloud tracer @@ -846,6 +853,12 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & if (Physics%control%nqg /= NO_TRACER) then Physics%control%cloud_tracer(Physics%control%nqg ) = .TRUE. endif + if (Physics%control%nqnr /= NO_TRACER) then + Physics%control%cloud_tracer(Physics%control%nqnr ) = .TRUE. + endif + if (Physics%control%nqns /= NO_TRACER) then + Physics%control%cloud_tracer(Physics%control%nqns ) = .TRUE. + endif !---------------------------------------------------------------------- ! define logical variable indicating whether prognostic clouds (using diff --git a/atmos_param/physics_driver/physics_types.F90 b/atmos_param/physics_driver/physics_types.F90 index 4a1a6737..3ee14be0 100644 --- a/atmos_param/physics_driver/physics_types.F90 +++ b/atmos_param/physics_driver/physics_types.F90 @@ -11,6 +11,7 @@ module physics_types_mod type physics_control_type integer :: sphum integer :: nsphum, nql, nqi, nqa, nqn, nqni, nqr, nqs, nqg + integer :: nqnr, nqns integer :: num_prog_tracers logical :: hydrostatic, phys_hydrostatic, do_uni_zfull !miz logical :: l_host_applies_sfc_fluxes diff --git a/atmos_shared/tracer_driver/aer_ccn_act/ice_nucl.F90 b/atmos_shared/tracer_driver/aer_ccn_act/ice_nucl.F90 index b4fa25b5..77814bea 100644 --- a/atmos_shared/tracer_driver/aer_ccn_act/ice_nucl.F90 +++ b/atmos_shared/tracer_driver/aer_ccn_act/ice_nucl.F90 @@ -25,6 +25,7 @@ MODULE ice_nucl_mod !--interfaces------------------------------------------------------------- public ice_nucl_wpdf, ice_nucl_wpdf_init, ice_nucl_wpdf_end +public ice_nucl_wpdf_Fan ! Gaussian integration over Fan'shomogeneous nucleation h1g, 2020-05-17 private ice_nucl_k, fast, slow, bc_het !------------------------------------------------------------------------ @@ -74,6 +75,8 @@ MODULE ice_nucl_mod ! d_bc = 0.07e-6 !Pueschel et al., GRL,1992 ! d_bc = 0.04e-6 +real :: nbc_max = 100.0 ! maximum BC particle number concentration (/cm3) h1g, 2020-07-03 + real :: rh_crit_het = 1.2 ! real :: dust_surf = 0.5 ! real :: dust_frac_min = 0.0 ! @@ -83,13 +86,20 @@ MODULE ice_nucl_mod !RSH: Should this be 150. or 1.5 (150 %) ???? real :: rh_dust_max = 150. ! maximum ice supersaturation in the ! presence of dust +! h1g, 2020-02-20 +real :: Nimax = 1.e8 ! maximum nucleated ice number concentration (#/m3) +! h1g, 2020-05-24 +real :: Nimax_heteo = 40.0e3 ! Songmiao Fan's maximum heterogeneous nucleated ice number concentration (#/m3) +real :: Nice_het_fac = 1.0 namelist / ice_nucl_nml / dust_opt, do_het, use_dust_instead_of_bc, & limit_immersion_frz, limit_rhil, & do_ice_nucl_ss_wpdf, d_sulf, & d_bc, rh_crit_het, dust_surf, dust_frac_min, & - dust_frac_max, dust_frac, rh_dust_max, retain_ice_nucl_bug + dust_frac_max, dust_frac, rh_dust_max, retain_ice_nucl_bug, & + Nimax, Nimax_heteo, Nice_het_fac, nbc_max ! h1g, 2020-05-24 + integer, parameter :: npoints = 64 ! # for Gauss-Hermite quadrature real, parameter :: wp2_eps = 0.0001 ! w variance threshold @@ -390,7 +400,7 @@ SUBROUTINE ice_nucl_k (zfull, T1, rhi_in, rhl_in, W1, TotalMass, & ! black carbon is activated. 1.e-6 is conversion from from m^-3 to cm^-3. !------------------------------------------------------------------------- nbc = MIN(imass(6)*1.e-6*6./(rho_bc*pi*d_bc**3)* & - exp(-9./2. * (log(sigma_bc))**2), 1.e10) + exp(-9./2. * (log(sigma_bc))**2), nbc_max) ENDIF !------------------------------------------------------------------------- @@ -432,7 +442,7 @@ SUBROUTINE ice_nucl_k (zfull, T1, rhi_in, rhl_in, W1, TotalMass, & !------------------------------------------------------------------------- else do_hom = .TRUE. - endif + endif ! nbc .GT. nbccrit !------------------------------------------------------------------------- ! if insufficient humidty for heterogenous nucleation, @@ -440,7 +450,7 @@ SUBROUTINE ice_nucl_k (zfull, T1, rhi_in, rhl_in, W1, TotalMass, & !------------------------------------------------------------------------- else do_hom = .TRUE. - endif + endif !1.e2*rhl .GE. rhl_thresh !------------------------------------------------------------------------- ! if heterogeneous nucleation was not requested, or the vertical velocity @@ -449,7 +459,7 @@ SUBROUTINE ice_nucl_k (zfull, T1, rhi_in, rhl_in, W1, TotalMass, & !------------------------------------------------------------------------- else do_hom = .TRUE. - endif + endif ! do_het .and. w1 .GE. w_het_thresh !------------------------------------------------------------------------- ! calculate homogeneous nucleation. @@ -528,8 +538,8 @@ SUBROUTINE ice_nucl_k (zfull, T1, rhi_in, rhl_in, W1, TotalMass, & ! convert the activated number to m-3. !------------------------------------------------------------------------ Ni_sulf = MAX(1.e6 * Ni_sulf, 0.) - END IF - END IF + END IF ! 1.e2*rhl .GE. rhl_thresh + END IF ! do_hom .and. w1 .GE. w_hom_thresh !------------------------------------------------------------------------- ! calculate activated ice nuclei when temperature is between -5C and @@ -645,7 +655,8 @@ SUBROUTINE ice_nucl_k (zfull, T1, rhi_in, rhl_in, W1, TotalMass, & ! sum the total available ice nulei. limit the number to be between 0 ! and 1.0e8. !------------------------------------------------------------------------- - Ni = MIN( MAX(Ni_sulf + Ni_dust + Ni_bc, 0.), 1.e8) + + Ni = MIN( MAX(Ni_sulf + Ni_dust + Ni_bc, 0.), Nimax) !------------------------------------------------------------------------- ! define output variable hom to be 1 when homogeneous nucleation has @@ -784,4 +795,160 @@ END SUBROUTINE S_max !------------------------------------------------------------------------ +SUBROUTINE ice_nucl_wpdf_Fan (T, p, wm, wp2, concen_dust_sub, crystal, Nidust) +! --------------------------------------------------------------------- +! subroutine ice_nucl_wpdf computes ice nucleation assuming a normal +! distribution of w given by its mean (wm) and second moment (wp2) +!------------------------------------------------------------------------ +real, intent(in) :: P, T, wm, wp2, concen_dust_sub +real, intent(out) :: crystal ! homegeneously nucleated ice number (#/m3) +real, intent(out) :: Nidust ! heteorogeously nucleated ice number (#/m3) + + +!-------------------------------------------------------------------------- +!---local variables + + logical lintegrate + integer ia, ib + real wtmp + real(kind=8) :: tmp, a, b, sum1, sum2 + integer iw + +!------------------------------------------------------------------------- +! determine whether integration is needed to compute number of nucleated +! crystals. lintegrate = .true. indicates that numerical integration is +! to be performed. +!------------------------------------------------------------------------- + if (wp2 .gt. wp2_eps) then + +!------------------------------------------------------------------------- +! integration bounds: from wmin to wmax (0 to 10 m/s) +!------------------------------------------------------------------------- + tmp = 1.0d0/sqrt(2.0*wp2) + a = (wmin - wm)*tmp + b = (wmax - wm)*tmp + +!------------------------------------------------------------------------- +! locate indices within integration bounds +!------------------------------------------------------------------------- + call dlocate( x, npoints, a, ia ) + call dlocate( x, npoints, b, ib ) + +!------------------------------------------------------------------------- +! ia (ib) is zero if a (b) is smaller than the lowest abscissa. +! in that case, start the integration with the first abscissa. +!------------------------------------------------------------------------- + ia = ia +1 + ia = min(max(ia,1),size(x)) + ib = min(max(ib,1),size(x)) + if (ib .gt. ia) then + lintegrate = .true. + else + lintegrate = .false. + endif + else + lintegrate = .false. + endif + +!------------------------------------------------------------------------- +! compute number of nucleated crystals. +!------------------------------------------------------------------------- + if (lintegrate ) then + sum1 = 0.0d0 + sum2 = 0.0d0 + tmp = sqrt(2.0*wp2) + do iw=ia,ib + wtmp = tmp * x(iw) + wm + call Nice_cirrus ( T, P, wtmp, concen_dust_sub, crystal) + sum1 = sum1 + w(iw)*crystal + sum2 = sum2 + w(iw) + enddo + +!------------------------------------------------------------------------- +! normalize over the distribution. +!------------------------------------------------------------------------- + crystal = sum1 / sum2 + else + ! otherwise no need to integrate, use single point (wm) + call Nice_cirrus ( T, P, wm, concen_dust_sub, crystal) + endif + +! heteogeneous nucleation + call Nice_sc_dust ( T, P, concen_dust_sub, Nidust) + +end subroutine ice_nucl_wpdf_Fan + + + +subroutine Nice_cirrus (temp, p, wmps, concen_dust, nice) + real, intent(in) :: temp, p, wmps, concen_dust ! Pa, K, m/s, ug/m3 + real, intent(out) :: nice ! (#/m3) + + real fact ! active fraction + real dust, delt, wcmps, sech + real tmp0, tmp1, tmp2, tmp3, tmp4 + + + fact = 1.0 + nice = 0. + dust = concen_dust * fact + nice = 0.0 + wcmps = 100. * wmps + if (wcmps .lt. 0.01) return + tmp0 = log(wcmps) + tmp1 = 0. + tmp2 = 0. + tmp3 = 0. + tmp4 = 0. + + if (temp .gt. 180. .and. temp .le. 210.) then + delt = temp - 197. + sech = 2. / (exp(0.19 * delt) + exp(-0.19 * delt)) + tmp1 = wcmps * (0.075 + 0.0062 * tmp0) + tmp2 = dust**0.3 * sech * tmp1 + nice = min(tmp2, 4.1 * dust) + else if (temp .gt. 210. .and. temp .le. 220.) then + delt = temp - 197. + sech = 2. / (exp(0.19 * delt) + exp(-0.19 * delt)) + tmp1 = wcmps * (0.075 + 0.0062 * tmp0) + tmp2 = dust**0.3 * sech * tmp1 + + delt = temp - 227. + tmp3 = -5.67+1.04*tmp0 & + + (0.0424 - 0.0626*tmp0 + 0.00865*tmp0*tmp0)*delt + tmp4 = dust**0.3 * exp(tmp3) + + nice = max(min(tmp2, 4.1 * dust), min(tmp4, 4.1 * dust)) + else if (temp .gt. 220. .and. temp .le. 240.) then + delt = temp - 227. + tmp3 = -5.67+1.04*tmp0 & + + (0.0424 - 0.0626*tmp0 + 0.00865*tmp0*tmp0)*delt + tmp4 = dust**0.3 * exp(tmp3) + nice = min(tmp4, 4.1 * dust) + else + nice = 0. +! print *, ' Temperature out of range 180 K to 240 K ' + end if + + nice = nice * 1.e6 ! convert from #/cm3 to #/m3 + + nice = nice * p / 30000.0 +end subroutine Nice_cirrus +!------------------------------------------------------------------------- + + +subroutine Nice_sc_dust (temp, p, concen_dust, nice) + real, intent(in) :: temp, p, concen_dust ! K, Pa, microg/m3 + real, intent(out) :: nice ! (#/m3) + + nice = Nice_het_fac * 0.00274 * concen_dust * & + exp(0.412*(273.16 - temp)) ! nice #/L + nice = nice * 1.e3 ! from /L to /m3 + nice = min(Nimax_heteo, nice) + + nice = nice * p/95000.0 +end subroutine Nice_sc_dust + + + END MODULE ice_nucl_mod From 7ecc59f1efaaef3f835b6cd3deed727e7eb59476 Mon Sep 17 00:00:00 2001 From: Huan Guo Date: Mon, 23 Nov 2020 11:38:29 -0500 Subject: [PATCH 2/9] Fix rain_num2snow, rain_num_evap, rain_num_freez to avoid gFortran compile failure --- atmos_param/microphysics/micro_mg2.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/atmos_param/microphysics/micro_mg2.F90 b/atmos_param/microphysics/micro_mg2.F90 index 037c8483..8714fd4e 100644 --- a/atmos_param/microphysics/micro_mg2.F90 +++ b/atmos_param/microphysics/micro_mg2.F90 @@ -4036,13 +4036,13 @@ subroutine micro_mg2_tend ( lon, lat, & diag_4l(:,j,:,diag_pt%snow_sedi) = qssedten(:,:) ! ---> rain number mixing ratio - if ( diag_id%rain_num2snow + diag_id%rain_num2snow_col ) & + if ( diag_id%rain_num2snow + diag_id%rain_num2snow_col > 0 ) & diag_4l(:,j,:,diag_pt%rain_num2snow) = diag_4l(:,j,:,diag_pt%rain_num2snow) & -npracs(:,:)*precip_frac(:,:) - if ( diag_id%rain_num_evap + diag_id%rain_num_evap_col ) & + if ( diag_id%rain_num_evap + diag_id%rain_num_evap_col > 0 ) & diag_4l(:,j,:,diag_pt%rain_num_evap) = nsubr( : , : )*precip_frac(:,:) - if ( diag_id%rain_num_freez + diag_id%rain_num_freez_col ) & + if ( diag_id%rain_num_freez + diag_id%rain_num_freez_col > 0 ) & diag_4l(:,j,:,diag_pt%rain_num_freez) = -nnuccr( : , : )*precip_frac(:,:) From b44474c113ab37fd03da89bf1a718c148743a0c3 Mon Sep 17 00:00:00 2001 From: Huan Guo Date: Mon, 21 Jun 2021 21:09:55 -0400 Subject: [PATCH 3/9] merge to 2021.02 --- atmos_param/microphysics/micro_mg2.F90 | 4 +- .../moist_processes/moist_processes.F90 | 233 +++++------ atmos_param/physics_driver/physics_driver.F90 | 365 +++++++++++------- 3 files changed, 355 insertions(+), 247 deletions(-) diff --git a/atmos_param/microphysics/micro_mg2.F90 b/atmos_param/microphysics/micro_mg2.F90 index 8714fd4e..f0e65841 100644 --- a/atmos_param/microphysics/micro_mg2.F90 +++ b/atmos_param/microphysics/micro_mg2.F90 @@ -3305,7 +3305,9 @@ subroutine micro_mg2_tend ( lon, lat, & meltsdttot = meltsdttot/real(iter) frzrdttot = frzrdttot /real(iter) - qcsinksum_rate1ord = qcsinksum_rate1ord/qc/real(iter) + where (qc(i,j) .gt. 0.0) + qcsinksum_rate1ord = qcsinksum_rate1ord/qc/real(iter) + end where preo = preo/real(iter) prdso = prdso/real(iter) diff --git a/atmos_param/moist_processes/moist_processes.F90 b/atmos_param/moist_processes/moist_processes.F90 index c454fea9..7f4d4f48 100644 --- a/atmos_param/moist_processes/moist_processes.F90 +++ b/atmos_param/moist_processes/moist_processes.F90 @@ -4,7 +4,7 @@ module moist_processes_mod ! ! interface module for moisture processes ! --------------------------------------- -! 1) sets up needed derived-type variables related to +! 1) sets up needed derived-type variables related to ! condensation / convection parameterizations ! 2) calls convection_driver to process model convection ! 3) calls lscloud_driver to process large-scale clouds @@ -20,21 +20,22 @@ module moist_processes_mod use diag_axis_mod, only: get_axis_num use diag_data_mod, only: CMOR_MISSING_VALUE +use mpp_domains_mod, only: domain2D use mpp_mod, only: input_nml_file use fms_mod, only: error_mesg, FATAL, NOTE, & - file_exist, check_nml_error, & - open_namelist_file, close_file, & + check_nml_error, & write_version_number, stdout, & mpp_pe, mpp_root_pe, stdlog, & mpp_clock_id, mpp_clock_begin, & mpp_clock_end, CLOCK_MODULE, & - MPP_CLOCK_SYNC, read_data, write_data + MPP_CLOCK_SYNC +use fms2_io_mod, only: file_exists use field_manager_mod, only: MODEL_ATMOS use tracer_manager_mod, only: get_tracer_index,& get_tracer_names, & NO_TRACER use constants_mod, only: CP_AIR, GRAV, HLV, HLS, HLF, & - TFREEZE, WTMAIR, SECONDS_PER_DAY,WTMN + TFREEZE, WTMAIR, SECONDS_PER_DAY, WTMN ! atmos_param modules use physics_types_mod, only : physics_control_type, & physics_tendency_block_type, & @@ -44,7 +45,7 @@ module moist_processes_mod use physics_radiation_exch_mod, & only : clouds_from_moist_block_type, & exchange_control_type -use lscloud_driver_mod, only : lscloud_driver_init, lscloud_driver, & +use lscloud_driver_mod, only : lscloud_driver_init, lscloud_driver, & lscloud_driver_time_vary, & lscloud_driver_endts, & lscloud_driver_end @@ -56,6 +57,7 @@ module moist_processes_mod convection_driver_restart, & convection_driver_end, & id_pr_g, id_prc_g, id_prsn_g +use convection_utilities_mod, only: mp2uwconv_type use diag_integral_mod, only : diag_integral_field_init, & sum_diag_integral_field use atmos_global_diag_mod, only: register_global_diag_field, & @@ -63,14 +65,16 @@ module moist_processes_mod send_global_diag use vert_diff_driver_mod, only : surf_diff_type use aerosol_types_mod, only : aerosol_type +use atmos_tracer_utilities_mod, only : get_cmip_param, get_chem_param use moist_proc_utils_mod, only : tempavg, column_diag, rh_calc, & MP_input_type, MP_nml_type, & mp_tendency_type, mp_removal_type, & mp_removal_control_type, & + define_removal_mp_control_type, & + deallocate_mp_removal_control_type, & mp_conv2ls_type, mp_output_type ! atmos_shared modules -use atmos_tracer_utilities_mod, only : get_cmip_param, get_chem_param use atmos_dust_mod, only : atmos_dust_init, dust_tracers, & n_dust_tracers, do_dust, & atmos_dust_wetdep_flux_set @@ -94,7 +98,7 @@ module moist_processes_mod moist_processes_restart, & moist_processes_endts, moist_processes_end, & set_cosp_precip_sources, define_cosp_precip_fluxes - + !----------------------------------------------------------------------- !-------------------- private data ------------------------------------- @@ -113,8 +117,8 @@ module moist_processes_mod !---------------- namelist variable definitions ------------------------ ! -! do_unified_clouds = -! switch to turn on/off a unified (LS + conv) cloud +! do_unified_clouds = +! switch to turn on/off a unified (LS + conv) cloud ! scheme (not yet available) ! [logical, default: do_unified_clouds=false ] ! do_lsc = switch to turn on/off large scale condensation @@ -164,9 +168,9 @@ module moist_processes_mod ! carbon for nucleation ! -logical :: do_unified_clouds = .false. +logical :: do_unified_clouds = .false. logical :: do_lsc = .false. -logical :: do_mca=.false. +logical :: do_mca=.false. logical :: do_ras=.false. logical :: do_uw_conv=.false. logical :: do_donner_deep=.false. @@ -220,14 +224,15 @@ module moist_processes_mod integer, dimension(:), allocatable :: id_wetdep integer, dimension(:), allocatable :: id_wetdep_uw, id_wetdep_donner, & - id_wetdepc_donner, id_wetdepm_donner !f1p + id_wetdepc_donner, id_wetdepm_donner !f1p integer, dimension(:), allocatable :: id_wetdep_kg_m2_s real, dimension(:), allocatable :: conv_wetdep, conv_wetdep_kg_m2_s, nb_N_ox, nb_N_red, nb_N real :: missing_value = -999. ! cmip names, long_names, standard names for wetdep diag fields -integer :: id_wetpoa_cmip, id_wetsoa_cmip, id_wetoa_cmip, id_wetbc_cmip, id_wetdust_cmip, & +integer :: id_wetpoa_cmip, id_wetsoa_cmip, id_wetoa_cmip, id_wetbc_cmip, & + id_wetdust_cmip, & id_wetss_cmip, id_wetso4_cmip, id_wetso2_cmip, id_wetdms_cmip, id_wetnh4_cmip integer, parameter :: NCMIP_NAMES = 10 character(len=8), dimension(NCMIP_NAMES) :: cmip_names = & @@ -238,12 +243,12 @@ module moist_processes_mod "Dry Aerosol Secondary Organic Matter", & "Dry Aerosol Total Organic Matter", & "Black Carbon Aerosol Mass", & - "Dust", "Seasalt", "SO4", "SO2", "DMS", "NH4+NH3"] + "Dust", "Seasalt", "SO4", "SO2", "DMS", "NH4+NH3"] character(len=64), dimension(NCMIP_NAMES) :: cmip_stdnames = & [ character(len=64) :: & "primary_particulate_organic_matter_dry_aerosol", & "secondary_particulate_organic_matter_dry_aerosol", & - "particulate_organic_matter_dry_aerosol", & + "particulate_organic_matter_dry_aerosol ", & "elemental_carbon_dry_aerosol", "dust_dry_aerosol", & "seasalt_dry_aerosol", "sulfate_dry_aerosol", & "sulfur_dioxide", "dimethyl_sulfide", "ammonium_dry_aerosol"] @@ -295,7 +300,7 @@ module moist_processes_mod logical :: use_tau integer :: nsphum, nql, nqi, nqa, nqn, nqni, nqr, nqs, nqg integer :: num_prog_tracers - +real :: dt contains @@ -304,11 +309,12 @@ module moist_processes_mod !######################################################################## -subroutine moist_processes_init ( id, jd, kd, lonb, latb, & +subroutine moist_processes_init ( domain, id, jd, kd, lonb, latb, & lon, lat, phalf, pref, axes, Time, & Physics_control, Exch_ctrl) !----------------------------------------------------------------------- +type(domain2D), target, intent(in) :: domain !< Atmosphere domain integer, intent(in) :: id, jd, kd, axes(4) real, dimension(:,:), intent(in) :: lonb, latb real,dimension(:,:), intent(in) :: lon, lat ! h1g @@ -379,19 +385,9 @@ subroutine moist_processes_init ( id, jd, kd, lonb, latb, & !----------------------------------------------------------------------- ! process the moist_processes_nml. !----------------------------------------------------------------------- - if ( file_exist('input.nml')) then -#ifdef INTERNAL_FILE_NML + if ( file_exists('input.nml')) then read (input_nml_file, nml=moist_processes_nml, iostat=io) ierr = check_nml_error(io,'moist_processes_nml') -#else - - unit = open_namelist_file ( ) - ierr=1; do while (ierr /= 0) - read (unit, nml=moist_processes_nml, iostat=io, end=10) - ierr = check_nml_error(io,'moist_processes_nml') - enddo - 10 call close_file (unit) -#endif !--------- write version and namelist to standard log ------------ @@ -422,12 +418,12 @@ subroutine moist_processes_init ( id, jd, kd, lonb, latb, & endif !---------------------------------------------------------------------- -! create an mp_nml_type variable (Nml_mp) so that moist_processes_nml +! create an mp_nml_type variable (Nml_mp) so that moist_processes_nml ! variables may be made available to other related modules as needed, -! obviating the need for the occurrence of the same variable in mutiple +! obviating the need for the occurrence of the same variable in mutiple ! namelists. !---------------------------------------------------------------------- - call create_Nml_mp + call create_Nml_mp !----------------------------------------------------------------------- ! consistency checks for thes namelist variables @@ -436,7 +432,7 @@ subroutine moist_processes_init ( id, jd, kd, lonb, latb, & call error_mesg ('moist_processes_init', & 'rh_clouds cannot be active when prognostic clouds are', FATAL) - if (do_donner_deep .and. do_rh_clouds) & + if (do_donner_deep .and. do_rh_clouds) & call error_mesg ('moist_processes_init', & 'Cannot currently activate donner_deep_mod with rh_clouds', & FATAL) @@ -500,43 +496,20 @@ subroutine moist_processes_init ( id, jd, kd, lonb, latb, & ! the number of tracers being affected by each available convective ! scheme. !------------------------------------------------------------------------ -! allocate (Removal_mp%control%tracers_in_donner(num_prog_tracers)) -! allocate (Removal_mp%control%tracers_in_ras(num_prog_tracers)) -! allocate (Removal_mp%control%tracers_in_uw(num_prog_tracers)) -! allocate (Removal_mp%control%tracers_in_mca(num_prog_tracers)) -! Removal_mp%control%tracers_in_donner = .false. -! Removal_mp%control%tracers_in_ras = .false. -! Removal_mp%control%tracers_in_uw = .false. -! Removal_mp%control%tracers_in_mca = .false. -! Removal_mp%control%num_mca_tracers = 0 -! Removal_mp%control%num_ras_tracers = 0 -! Removal_mp%control%num_donner_tracers = 0 -! Removal_mp%control%num_uw_tracers = 0 - allocate (Removal_mp_control%tracers_in_donner(num_prog_tracers)) - allocate (Removal_mp_control%tracers_in_ras(num_prog_tracers)) - allocate (Removal_mp_control%tracers_in_uw(num_prog_tracers)) - allocate (Removal_mp_control%tracers_in_mca(num_prog_tracers)) - Removal_mp_control%tracers_in_donner = .false. - Removal_mp_control%tracers_in_ras = .false. - Removal_mp_control%tracers_in_uw = .false. - Removal_mp_control%tracers_in_mca = .false. - Removal_mp_control%num_mca_tracers = 0 - Removal_mp_control%num_ras_tracers = 0 - Removal_mp_control%num_donner_tracers = 0 - Removal_mp_control%num_uw_tracers = 0 + call define_removal_mp_control_type (Removal_mp_control, & + num_prog_tracers) !----------------------------------------------------------------------- ! call convection_driver_init to initialize the convection scheme(s). !----------------------------------------------------------------------- - call convection_driver_init (id, jd, kd, axes, Time, & + call convection_driver_init (domain, id, jd, kd, axes, Time, & Physics_control, Exch_ctrl, Nml_mp, & -! Removal_mp%control, lonb, latb, pref) Removal_mp_control, lonb, latb, pref) !----------------------------------------------------------------------- ! call lscloud_driver_init to initialize the large-scale cloud scheme. !----------------------------------------------------------------------- - call lscloud_driver_init (id,jd,kd, axes, Time, Exch_ctrl, Nml_mp, & + call lscloud_driver_init (domain, id,jd,kd, axes, Time, Exch_ctrl, Nml_mp, & Physics_control, lon, lat, phalf, pref) !----------------------------------------------------------------------- @@ -555,15 +528,18 @@ subroutine moist_processes_init ( id, jd, kd, lonb, latb, & end subroutine moist_processes_init !##################################################################### + +subroutine moist_processes_time_vary (Time_in, dt_in, i_cell, i_meso, i_shallow) -subroutine moist_processes_time_vary (dt) - -real, intent(in) :: dt +real, intent(in) :: dt_in +type(time_type), intent(in) :: Time_in +integer, intent(in) :: i_cell, i_meso, i_shallow !----------------------------------------------------------------------- - call convection_driver_time_vary (dt) - call lscloud_driver_time_vary (dt) + dt = dt_in + call convection_driver_time_vary (Time_in, dt_in, i_cell, i_meso, i_shallow) + call lscloud_driver_time_vary (dt_in) end subroutine moist_processes_time_vary @@ -571,7 +547,7 @@ end subroutine moist_processes_time_vary !####################################################################### -subroutine moist_processes ( is, ie, js, je, npz, Time, dt, land, ustar, & +subroutine moist_processes ( is, ie, js, je, npz, Time, land, ustar, & bstar, qstar, area, lon, lat, & Physics_input_block, Moist_clouds_block, & Physics_tendency_block, Phys_mp_exch, & @@ -630,7 +606,6 @@ subroutine moist_processes ( is, ie, js, je, npz, Time, dt, land, ustar, & !----------------------------------------------------------------------- integer, intent(in) :: is,ie,js,je, npz type(time_type), intent(in) :: Time -real, intent(in) :: dt real, intent(in) , dimension(:,:) :: land, ustar, bstar, qstar real, intent(in) , dimension(:,:) :: area, lon, lat type(physics_input_block_type), & @@ -655,6 +630,7 @@ subroutine moist_processes ( is, ie, js, je, npz, Time, dt, land, ustar, & type(MP_output_type) :: Output_mp type(MP_tendency_type) :: Tend_mp type(MP_conv2ls_type) :: C2ls_mp + type(mp2uwconv_type) :: Mp2uwconv real, dimension(ie-is+1, je-js+1, npz) :: tdt_init real, dimension(ie-is+1, je-js+1, npz) :: tdt_dif, qdt_dif !miz @@ -682,19 +658,15 @@ subroutine moist_processes ( is, ie, js, je, npz, Time, dt, land, ustar, & !------------------------------------------------------------------------ tdt_init = Physics_tendency_block%t_dt qdt_init = Physics_tendency_block%q_dt - tdt_dif = Physics_tendency_block%t_dt !miz - qdt_dif = Physics_tendency_block%q_dt(:,:,:,nsphum) + & !miz - Physics_tendency_block%q_dt(:,:,:,nql) + & - Physics_tendency_block%q_dt(:,:,:,nqi) !------------------------------------------------------------------------- -! call MP_alloc to allocate and initialize (or associate) elements of +! call MP_alloc to allocate and initialize (or associate) elements of ! the derived type variables used in this subroutine. !------------------------------------------------------------------------- call MP_alloc (Physics_input_block, Physics_tendency_block, & Phys_mp_exch, dt, area, lon, lat, land, ustar, & bstar, qstar, Input_mp, Tend_mp, C2ls_mp, Output_mp,& - Removal_mp) + Removal_mp, Mp2uwconv, shflx, lhflx) !---------------------------------------------------------------------- ! call routines to process the model clouds. If a unified cloud scheme @@ -706,14 +678,11 @@ subroutine moist_processes ( is, ie, js, je, npz, Time, dt, land, ustar, & 'unified clouds not yet available', FATAL) else call convection_driver & - (is, ie, js, je, Time, dt, Input_mp, & - Tend_mp, C2ls_mp, Output_mp, Removal_mp, & - Removal_mp_control, & - Surf_diff, Phys_mp_exch, shflx, lhflx, tdt_dif, & - qdt_dif, Moist_clouds_block, Aerosol=Aerosol) - + (is, ie, js, je, Surf_diff, Phys_mp_exch, & + Moist_clouds_block, Input_mp, Tend_mp, C2ls_mp, & + Output_mp, Removal_mp, Aerosol=Aerosol) call lscloud_driver & - (is, ie, js, je, Time, dt, lon, lat, Input_mp, & + (is, ie, js, je, Time, dt, Input_mp, & Physics_tendency_block%qdiag, Tend_mp, C2ls_mp, & Output_mp, Removal_mp, & Moist_clouds_block%cloud_data(istrat), & @@ -746,7 +715,8 @@ subroutine moist_processes ( is, ie, js, je, npz, Time, dt, land, ustar, & !--------------------------------------------------------------------- ! deallocate the derived type variables resident in moist_processes_mod. !--------------------------------------------------------------------- - call MP_dealloc (Input_mp, Tend_mp, C2ls_mp, Output_mp, Removal_mp) + call MP_dealloc (Input_mp, Tend_mp, C2ls_mp, Output_mp, Removal_mp,& + Mp2uwconv) !----------------------------------------------------------------------- @@ -805,16 +775,13 @@ subroutine moist_processes_end ( ) deallocate (max_water_imbal) deallocate (max_enthalpy_imbal) - deallocate (Removal_mp_control%tracers_in_donner ) !---> h1g, 2017-02-02 - deallocate (Removal_mp_control%tracers_in_ras ) !---> h1g, 2017-02-02 - deallocate (Removal_mp_control%tracers_in_uw ) !---> h1g, 2017-02-02 - deallocate (Removal_mp_control%tracers_in_mca ) !---> h1g, 2017-02-02 + call deallocate_mp_removal_control_type (Removal_mp_control) deallocate (prec_intgl) !---> h1g, 2017-02-02 - if (allocated(id_wetdep_kg_m2_s)) deallocate(id_wetdep_kg_m2_s) if (allocated(conv_wetdep_kg_m2_s)) deallocate(conv_wetdep_kg_m2_s) if (allocated(conv_wetdep)) deallocate(conv_wetdep) + !-------------------------------------------------------------------- if (allocated(nb_N)) deallocate(nb_N) @@ -1165,10 +1132,11 @@ subroutine combined_MP_diagnostics & if (id_wetsoa_cmip > 0) then used = send_data (id_wetsoa_cmip, total_wetdep(:,:,nSOA) , Time, is,js) endif + if (id_wetoa_cmip > 0) then used = send_data (id_wetoa_cmip, & - total_wetdep(:,:,nomphilic)+total_wetdep(:,:,nomphobic)+total_wetdep(:,:,nSOA) , & - Time, is,js) + total_wetdep(:,:,nomphilic) + total_wetdep(:,:,nomphobic) + & + total_wetdep(:,:,nSOA) , Time, is,js) endif if (id_wetdep_bc > 0) then @@ -1258,6 +1226,7 @@ subroutine combined_MP_diagnostics & used = send_data ( id_n_red_wdep, total_wetdep_nred*wtmn/1000., Time, is, js) endif + endif ! (wetdep_diagnostics_desired) !--------------------------------------------------------------------- @@ -1461,7 +1430,7 @@ subroutine combined_MP_diagnostics & do k=1,kx tca2(:,:) = tca2(:,:)*(1.0 - total_cloud_area(:,:,k)) end do - tca2 = 100.*(1. - tca2) + tca2 = 100.*(1. - tca2) ! cmip6 = Cloud Cover Percentage used = send_data (id_tot_cld_amt, tca2, Time, is, js) endif @@ -1470,13 +1439,14 @@ subroutine combined_MP_diagnostics & do k=1,kx tca2(:,:) = tca2(:,:)*(1.0 - total_cloud_area(:,:,k)) end do - tca2 = 100.*(1. - tca2) ! cmip6 = Cloud Cover Percentage + tca2 = (1. - tca2) ! Cloud Area Fraction + tca2 = 100.*tca2 ! cmip6 = Cloud Cover Percentage used = send_data (id_clt, tca2, Time, is, js) endif IF (i_lsc > 0) then !--------------------------------------------------------------------- -! define the total and convective liquid and liquid water path. +! define the total and convective liquid and liquid water path. !--------------------------------------------------------------------- if (id_tot_liq_amt > 0 ) & used = send_data (id_tot_liq_amt, & @@ -1723,7 +1693,7 @@ end subroutine combined_MP_diagnostics subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & Phys_mp_exch, dt, area, lon, lat, land, ustar, & bstar, qstar, Input_mp,Tend_mp, C2ls_mp, Output_mp, & - Removal_mp) + Removal_mp, Mp2uwconv, shflx, lhflx) type(physics_input_block_type), & intent(in) :: Physics_input_block @@ -1732,12 +1702,14 @@ subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & type(phys_mp_exch_type), intent(in) :: Phys_mp_exch real, intent(in) :: dt real, dimension(:,:), intent(in) :: area, lon, lat +real, dimension(:,:), intent(in) :: shflx, lhflx real, dimension(:,:), intent(in) :: land, ustar, bstar, qstar type(MP_input_type), intent(inout) :: Input_mp type(MP_output_type), intent(inout) :: Output_mp type(MP_tendency_type), intent(inout) :: Tend_mp type(MP_conv2ls_type), intent(inout) :: C2ls_mp type(MP_removal_type), intent(inout) :: Removal_mp +type(mp2uwconv_type), intent(inout) :: Mp2uwconv !------------------------------------------------------------------------ @@ -1768,10 +1740,14 @@ subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & Input_mp%pfull => Physics_input_block%p_full Input_mp%zhalf => Physics_input_block%z_half Input_mp%zfull => Physics_input_block%z_full - allocate (Input_mp%tin (ix,jx,kx )) - allocate (Input_mp%qin (ix,jx,kx )) - allocate (Input_mp%uin (ix,jx,kx )) - allocate (Input_mp%vin (ix,jx,kx )) + allocate (Input_mp%tin (ix,jx,kx )) + allocate (Input_mp%tin_tentative (ix,jx,kx )) + Input_mp%tin_tentative = 0. + allocate (Input_mp%qin (ix,jx,kx )) + allocate (Input_mp%tin_orig (ix,jx,kx )) + allocate (Input_mp%qin_orig (ix,jx,kx )) + allocate (Input_mp%uin (ix,jx,kx )) + allocate (Input_mp%vin (ix,jx,kx )) Input_mp%t => Physics_input_block%t Input_mp%q => Physics_input_block%q(:,:,:,1) Input_mp%u => Physics_input_block%u @@ -1798,7 +1774,8 @@ subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & Input_mp%radturbten => Phys_mp_exch%radturbten Input_mp%diff_t => Phys_mp_exch%diff_t - allocate (Input_mp%tracer(ix,jx,kx, size(Physics_input_block%q,4) )) + allocate (Input_mp%tracer(ix,jx,kx, size(Physics_input_block%q,4) )) + allocate (Input_mp%tracer_orig(ix,jx,kx, size(Physics_input_block%q,4) )) allocate (Input_mp%area (ix,jx )) ; Input_mp%area = area allocate (Input_mp%lon (ix,jx )) ; Input_mp%lon = lon allocate (Input_mp%lat (ix,jx )) ; Input_mp%lat = lat @@ -1969,10 +1946,14 @@ subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & Output_mp%udt => Physics_tendency_block%u_dt Output_mp%vdt => Physics_tendency_block%v_dt Output_mp%rdt => Physics_tendency_block%q_dt + allocate (Output_mp%rdt_init (ix,jx,kx,nt)) ; Output_mp%rdt_init = 0. + allocate (Output_mp%rdt_tentative (ix,jx,kx,nt)) ; & + Output_mp%rdt_tentative = 0. Output_mp%convect => Phys_mp_exch%convect Output_mp%convect = .false. allocate ( Output_mp%lprec (ix,jx)) ; Output_mp%lprec = 0. allocate ( Output_mp%fprec (ix,jx)) ; Output_mp%fprec = 0. + allocate ( Output_mp%precip (ix,jx)) ; Output_mp%precip = 0. allocate ( Output_mp%gust_cv(ix,jx)) ; Output_mp%gust_cv = 0. Output_mp%diff_t_clubb => Phys_mp_exch%diff_t_clubb Output_mp%diff_t_clubb =0. @@ -2037,6 +2018,20 @@ subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & allocate ( Removal_mp%ls_wetdep (ix,jx,nt)) Removal_mp%ls_wetdep = 0. +!----------------------------------------------------------------------- +! probably associate the lhflx, shflx + + allocate ( Mp2uwconv%shflx (ix,jx)) + allocate ( Mp2uwconv%lhflx (ix,jx)) + allocate ( Mp2uwconv%tdt_dif (ix,jx,kx)) + allocate ( Mp2uwconv%qdt_dif (ix,jx,kx)) + Mp2uwconv%shflx = shflx + Mp2uwconv%lhflx = lhflx + Mp2uwconv%tdt_dif = Physics_tendency_block%t_dt !miz + Mp2uwconv%qdt_dif = Physics_tendency_block%q_dt(:,:,:,nsphum) + & !miz + Physics_tendency_block%q_dt(:,:,:,nql) + & + Physics_tendency_block%q_dt(:,:,:,nqi) + !------------------------------------------------------------------------- end subroutine MP_alloc @@ -2044,13 +2039,15 @@ end subroutine MP_alloc !######################################################################## -subroutine MP_dealloc (Input_mp, Tend_mp, C2ls_mp, Output_mp, Removal_mp) +subroutine MP_dealloc (Input_mp, Tend_mp, C2ls_mp, Output_mp, Removal_mp, & + Mp2uwconv) type(MP_input_type), intent(inout) :: Input_mp type(MP_tendency_type), intent(inout) :: Tend_mp type(MP_conv2ls_type), intent(inout) :: C2ls_mp type(MP_output_type), intent(inout) :: Output_mp type(MP_removal_type), intent(inout) :: Removal_mp +type(mp2uwconv_type), intent(inout) :: Mp2uwconv !------------------------------------------------------------------------ ! deallocate the components of the derived type variables defined in @@ -2063,7 +2060,10 @@ subroutine MP_dealloc (Input_mp, Tend_mp, C2ls_mp, Output_mp, Removal_mp) Input_mp%zfull => null() deallocate (Input_mp%tin ) + deallocate (Input_mp%tin_tentative ) deallocate (Input_mp%qin ) + deallocate (Input_mp%tin_orig ) + deallocate (Input_mp%qin_orig ) deallocate (Input_mp%uin ) deallocate (Input_mp%vin ) @@ -2085,6 +2085,7 @@ subroutine MP_dealloc (Input_mp, Tend_mp, C2ls_mp, Output_mp, Removal_mp) deallocate (Input_mp%lon ) deallocate (Input_mp%lat ) deallocate (Input_mp%tracer) + deallocate (Input_mp%tracer_orig) deallocate (Input_mp%land ) deallocate (Input_mp%ustar ) deallocate (Input_mp%bstar ) @@ -2146,14 +2147,22 @@ subroutine MP_dealloc (Input_mp, Tend_mp, C2ls_mp, Output_mp, Removal_mp) Output_mp%udt => null() Output_mp%vdt => null() Output_mp%rdt => null() + deallocate (Output_mp%rdt_init) + deallocate (Output_mp%rdt_tentative) deallocate (Output_mp%lprec ) deallocate (Output_mp%fprec ) + deallocate (Output_mp%precip ) deallocate (Output_mp%gust_cv) Output_mp%convect => null() Output_mp%diff_t_clubb => null() Output_mp%diff_cu_mo => null() + deallocate (Mp2uwconv%shflx ) + deallocate (Mp2uwconv%lhflx ) + deallocate (Mp2uwconv%tdt_dif) + deallocate (Mp2uwconv%qdt_dif) + !-------------------------------------------------------------------- end subroutine MP_dealloc @@ -2162,7 +2171,7 @@ end subroutine MP_dealloc !######################################################################## -subroutine create_Nml_mp +subroutine create_Nml_mp Nml_mp%do_mca = do_mca @@ -2218,8 +2227,10 @@ subroutine diag_field_init ( axes, Time ) 'Frozen precip rate from all sources', 'kg(h2o)/m2/s', & interp_method = "conserve_order1" ) + + id_prra = register_cmip_diag_field_2d ( mod_name, 'prra', Time, & - 'Rainfall Rate', 'kg m-2 s-1', & + 'Rainfall Rate', 'kg m-2 s-1', & standard_name = 'rainfall_flux', & interp_method = "conserve_order1" ) @@ -2228,7 +2239,6 @@ subroutine diag_field_init ( axes, Time ) standard_name = 'snowfall_flux', & interp_method = "conserve_order1" ) - id_max_enthalpy_imbal = register_diag_field & (mod_name, 'max_enth_imbal', axes(1:2), Time, & 'max enthalpy imbalance from moist_processes ', 'W/m2', & @@ -2252,6 +2262,7 @@ subroutine diag_field_init ( axes, Time ) 'Total precipitation rate', 'kg/m2/s', & interp_method = "conserve_order1" ) + id_pr = register_cmip_diag_field_2d ( mod_name, 'pr', Time, & 'Precipitation', 'kg m-2 s-1', & standard_name='precipitation_flux', & @@ -2261,8 +2272,9 @@ subroutine diag_field_init ( axes, Time ) 'WVP', axes(1:2), Time, & 'Column integrated water vapor', 'kg/m2' ) + id_prw = register_cmip_diag_field_2d ( mod_name, 'prw', Time, & - 'Water Vapor Path', 'kg m-2', & + 'Water Vapor Path', 'kg m-2', & standard_name = 'atmosphere_water_vapor_content' ) !----------------------------------------------------------------------- @@ -2279,6 +2291,7 @@ subroutine diag_field_init ( axes, Time ) 'total cloud amount', 'percent', & interp_method = 'conserve_order1' ) + id_clt = register_cmip_diag_field_2d (mod_name, 'clt', Time, & 'Total Cloud Cover Percentage', '%', & standard_name= 'cloud_area_fraction', & @@ -2291,8 +2304,8 @@ subroutine diag_field_init ( axes, Time ) ID_cl = register_cmip_diag_field_3d ( mod_name, 'cl', Time, & 'Percentage Cloud Cover', '%', & - standard_name='cloud_area_fraction_in_atmosphere_layer', & - interp_method='conserve_order1' ) + standard_name='cloud_area_fraction_in_atmosphere_layer', & + interp_method='conserve_order1' ) id_tot_h2o = register_diag_field ( mod_name, & 'tot_h2o', axes(1:3), Time, & @@ -2305,7 +2318,7 @@ subroutine diag_field_init ( axes, Time ) id_tot_liq_amt = register_diag_field ( mod_name, & 'tot_liq_amt', axes(1:3), Time, & 'Liquid amount -- all clouds', 'kg/kg', & - missing_value=missing_value, interp_method='conserve_order1' ) + missing_value=missing_value, interp_method='conserve_order1' ) ID_clw = register_cmip_diag_field_3d ( mod_name, 'clw', Time, & 'Mass Fraction of Cloud Liquid Water', 'kg kg-1', & @@ -2315,7 +2328,7 @@ subroutine diag_field_init ( axes, Time ) id_tot_ice_amt = register_diag_field ( mod_name, & 'tot_ice_amt', axes(1:3), Time, & 'Ice amount -- all clouds', 'kg/kg', & - missing_value=missing_value, interp_method='conserve_order1' ) + missing_value=missing_value, interp_method='conserve_order1' ) ID_cli = register_cmip_diag_field_3d ( mod_name, 'cli', Time, & 'Mass Fraction of Cloud Ice', 'kg kg-1', & @@ -2374,7 +2387,7 @@ subroutine diag_field_init ( axes, Time ) id_clivi = register_cmip_diag_field_2d ( mod_name, 'clivi', Time, & 'Ice Water Path', 'kg m-2', & - standard_name='atmosphere_mass_content_of_cloud_ice', & + standard_name='atmosphere_mass_content_of_cloud_ice', & interp_method='conserve_order1' ) endif @@ -2454,7 +2467,6 @@ subroutine diag_field_init ( axes, Time ) missing_value=missing_value) if (id_wetdep_dust > 0) wetdep_diagnostics_desired = .true. - id_n_ox_wdep = register_cmip_diag_field_2d ( mod_name, 'fam_noy_wetdep_kg_m2_s', Time, & 'wet deposition of noy incl aerosol nitrate', 'kg m-2 s-1', & standard_name='minus_tendency_of_atmosphere_mass_content_of_noy_expressed_as_nitrogen_due_to_wet_deposition' ) @@ -2463,7 +2475,7 @@ subroutine diag_field_init ( axes, Time ) id_n_red_wdep = register_cmip_diag_field_2d ( mod_name, 'fam_nhx_wetdep_kg_m2_s', Time, & 'wet deposition of nhx', 'kg m-2 s-1', & standard_name='minus_tendency_of_atmosphere_mass_content_of_nhx_expressed_as_nitrogen_due_to_wet_deposition' ) - + !-------- cmip wet deposition fields --------- do ic = 1, size(cmip_names,1) @@ -2624,9 +2636,8 @@ subroutine diag_field_init ( axes, Time ) conv_wetdep(n) = 1. conv_wetdep_kg_m2_s(n) = 1. ! no conversion needed - else - write(outunit,'(a)') 'unsupported tracer: '//trim(tracer_name)//', units='//trim(tracer_units) + write(outunit,'(a)') 'unsupported tracer: '//trim(tracer_name)//', units='//trim(tracer_units) conv_wetdep(n) = 0. conv_wetdep_kg_m2_s(n) = 0. end if diff --git a/atmos_param/physics_driver/physics_driver.F90 b/atmos_param/physics_driver/physics_driver.F90 index daef46cd..92fe93fe 100644 --- a/atmos_param/physics_driver/physics_driver.F90 +++ b/atmos_param/physics_driver/physics_driver.F90 @@ -64,20 +64,20 @@ module physics_driver_mod atmos_tracer_driver_endts, & atmos_tracer_driver, & atmos_tracer_driver_end -use mpp_mod, only: input_nml_file +use mpp_mod, only: input_nml_file, mpp_get_current_pelist +use mpp_domains_mod, only: domain2D, mpp_get_ntile_count use fms_mod, only: mpp_clock_id, mpp_clock_begin, & mpp_clock_end, CLOCK_MODULE_DRIVER, & - fms_init, & - open_namelist_file, stdlog, stdout, & - write_version_number, field_size, & - file_exist, error_mesg, FATAL, & - WARNING, NOTE, check_nml_error, & - close_file, mpp_pe, mpp_root_pe, & - mpp_error, mpp_chksum, string -use fms_io_mod, only: restore_state, & - register_restart_field, restart_file_type, & - save_restart, get_mosaic_tile_file - + fms_init, stdlog, stdout, & + write_version_number, & + error_mesg, FATAL, & + NOTE, check_nml_error, mpp_pe, & + mpp_root_pe, mpp_chksum, string, mpp_npes +use fms2_io_mod, only: FmsNetcdfFile_t, FmsNetcdfDomainFile_t, & + register_restart_field, register_axis, unlimited, & + open_file, read_restart, write_restart, close_file, & + register_field, write_data, get_global_io_domain_indices, & + register_variable_attribute, variable_exists use diag_manager_mod, only: register_diag_field, send_data ! shared atmospheric package modules: @@ -199,7 +199,7 @@ module physics_driver_mod check_args, & ! called from physics_driver_init: - physics_driver_register_restart, & + physics_driver_register_restart_domain, physics_driver_register_restart_scalars, & ! called from physics_driver_restart: physics_driver_netcdf, & @@ -480,10 +480,6 @@ module physics_driver_mod real, dimension(:,:,:), allocatable :: temp_last, q_last -!--- for netcdf restart -type(restart_file_type), pointer, save :: Phy_restart => NULL() -type(restart_file_type), pointer, save :: Til_restart => NULL() -logical :: in_different_file = .false. integer :: vers integer :: now_doing_strat = 0 integer :: now_doing_entrain = 0 @@ -549,8 +545,8 @@ module physics_driver_mod type(precip_flux_type) :: Precip_flux - - +integer :: i_cell, i_meso, i_shallow +type (domain2D) :: physics_domain !< Atmosphere domain !--> h1g, 2019-11-25 integer :: itrac !<-- h1g, 2019-11-25 @@ -663,7 +659,9 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & tracer_init_clock real, dimension(:,:,:), allocatable :: phalf real, dimension(:,:,:,:), allocatable :: trs - + type(FmsNetcdfFile_t) :: Phy_restart !< Fms2io fileobj + type(FmsNetcdfDomainFile_t) :: Til_restart !< Fms2io domain decomposed fileobj + integer, dimension(:), allocatable :: pes !< Array of pes in the current pelist !--------------------------------------------------------------------- ! local variables: ! @@ -699,19 +697,8 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & !-------------------------------------------------------------------- ! read namelist. !-------------------------------------------------------------------- -#ifdef INTERNAL_FILE_NML read (input_nml_file, nml=physics_driver_nml, iostat=io) ierr = check_nml_error(io,"physics_driver_nml") -#else - if ( file_exist('input.nml')) then - unit = open_namelist_file () - ierr=1; do while (ierr /= 0) - read (unit, nml=physics_driver_nml, iostat=io, end=10) - ierr = check_nml_error(io, 'physics_driver_nml') - enddo -10 call close_file (unit) - endif -#endif !-------------------------------------------------------------------- ! consistency checks for namelist options @@ -817,7 +804,7 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & Physics%control%nqg = get_tracer_index (MODEL_ATMOS, 'graupel') Physics%control%nqnr = get_tracer_index (MODEL_ATMOS, 'rain_num') Physics%control%nqns = get_tracer_index (MODEL_ATMOS, 'snow_num') - + physics_domain = Physics%control%domain !----------------------------------------------------------------------- ! allocate a logical array to define whether a tracer is a cloud tracer ! (one of those defined above), or not. @@ -954,7 +941,7 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & if (do_moist_processes) then call mpp_clock_begin ( moist_processes_init_clock ) - call moist_processes_init (id, jd, kd, lonb, latb, lon, lat, & + call moist_processes_init (physics_domain, id, jd, kd, lonb, latb, lon, lat, & phalf, Physics%glbl_qty%pref(:,1),& axes, Time, Physics%control, Exch_ctrl) @@ -968,7 +955,7 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & ! initialize damping_driver_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( damping_init_clock ) - call damping_driver_init (lonb, latb, Physics%glbl_qty%pref(:,1), & + call damping_driver_init (physics_domain, lonb, latb, Physics%glbl_qty%pref(:,1), & axes, Time, sgsmtn) call mpp_clock_end ( damping_init_clock ) @@ -976,7 +963,7 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & ! initialize vert_turb_driver_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( turb_init_clock ) - call vert_turb_driver_init (lonb, latb, id, jd, kd, axes, Time, & + call vert_turb_driver_init (physics_domain, lonb, latb, id, jd, kd, axes, Time, & Exch_ctrl, Physics%control, & doing_edt, doing_entrain, do_clubb) call mpp_clock_end ( turb_init_clock ) @@ -1011,7 +998,7 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & ! initialize atmos_tracer_driver_mod. !----------------------------------------------------------------------- call mpp_clock_begin ( tracer_init_clock ) - call atmos_tracer_driver_init (lonb, latb, trs, axes, Time, phalf) + call atmos_tracer_driver_init (physics_domain, lonb, latb, trs, axes, Time, phalf) call mpp_clock_end ( tracer_init_clock ) !--------------------------------------------------------------------- @@ -1078,6 +1065,13 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & call alloc_clouds_from_moist_type(Moist_clouds, Exch_ctrl, Atm_block) +!------------------------------------------------------------------------ +! save convective cloud indices to be passed to convection_driver_mod. +!------------------------------------------------------------------------ + i_shallow = Moist_clouds(1)%block(1)%index_uw_conv + i_cell = Moist_clouds(1)%block(1)%index_donner_cell + i_meso = Moist_clouds(1)%block(1)%index_donner_meso + !-------------------------------------------------------------------- ! call physics_driver_read_restart to obtain initial values for the module ! variables. Also register restart fields to be ready for intermediate @@ -1091,11 +1085,25 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & id, jd, kd, Restart%Cloud_data(nc)) enddo - call physics_driver_register_restart (Restart) - if(file_exist('INPUT/physics_driver.res.nc')) then - call restore_state(Phy_restart) - if(in_different_file) call restore_state(Til_restart) + !< Get the current pelist + allocate(pes(mpp_npes())) + call mpp_get_current_pelist(pes) + + !< Open the scalar file with the current pelist, so that only the root pe opens and reads the file and + !! distributes the data to the other pes + if (open_file(Phy_restart,"INPUT/physics_driver.res.nc","read", is_restart=.true., pelist=pes)) then !scalar file + call physics_driver_register_restart_scalars(Restart, Phy_restart) + call read_restart(Phy_restart) + call close_file(Phy_restart) endif + deallocate(pes) + + if (open_file(Til_restart,"INPUT/physics_driver.res.nc","read", physics_domain, is_restart=.true.)) then !domain file + call physics_driver_register_restart_domain(Restart, Til_restart) + call read_restart(Til_restart) + call close_file(Til_restart) + endif + !--------------------------------------------------------------------- ! convert the real variable (r_convect) indicating columns with ! convection to a logical variable (convect). this will be used in @@ -1470,7 +1478,7 @@ subroutine physics_driver_up_time_vary (Time, Time_next, dt, & ! call moist_processes_time_vary to pass needed time-dependent fields ! to subordinate modules. !---------------------------------------------------------------------- - call moist_processes_time_vary (dt) + call moist_processes_time_vary (Time_next, dt, i_cell, i_meso, i_shallow) endif !---------------------------------------------------------------------- ! call cosp_driver_time_vary to obtain satellite location at current @@ -2562,7 +2570,7 @@ subroutine physics_driver_up (is, ie, js, je, npz, & ! and processes involving condenstion. !----------------------------------------------------------------------- call moist_processes ( & - is, ie, js, je, npz, Time_next, dt, frac_land, u_star, & + is, ie, js, je, npz, Time_next, frac_land, u_star, & b_star, q_star, area, lon, lat, Physics_input_block, & Moist_clouds_block, Physics_tendency_block, Phys_mp_exch, & Surf_diff, Removal_mp, shflx, lhflx, & @@ -2620,8 +2628,8 @@ subroutine physics_driver_up (is, ie, js, je, npz, & if (query_cmip_diag_id(ID_tntmp) .or. query_cmip_diag_id(ID_tnhusmp)) then lphalf = log(p_half) endif - if (query_cmip_diag_id(ID_tntmp)) then - used = send_cmip_data_3d (ID_tntmp, tdt(:,:,:), Time_next, is, js, 1, phalf=lphalf) + if (query_cmip_diag_id(ID_tntmp)) then + used = send_cmip_data_3d (ID_tntmp, tdt(:,:,:), Time_next, is, js,1, phalf=lphalf) endif if (query_cmip_diag_id(ID_tnhusmp)) then used = send_cmip_data_3d (ID_tnhusmp, rdt(:,:,:,nsphum), Time_next, is, js, 1, phalf=lphalf) @@ -3056,17 +3064,67 @@ end subroutine physics_driver_restart ! subroutine physics_driver_netcdf(timestamp) character(len=*), intent(in), optional :: timestamp + type(FmsNetcdfFile_t) :: Phy_restart !< Fms2io fileobj + type(FmsNetcdfDomainFile_t) :: Til_restart !< Fms2io domain decomposed fileobj + logical :: tile_file_exist !< Flag indicating if the file was opened + character(len=128) :: filename !< String of filename + integer, allocatable, dimension(:) :: pes !< Array of pes in the current pelist + + r_convect = 0. + where(convect) + r_convect = 1.0 + end where + + if (present(timestamp)) then + filename = "RESTART/"//trim(timestamp)//".physics_driver.res.nc" + else + filename = "RESTART/physics_driver.res.nc" + endif + + !< Get the current pelist + allocate(pes(mpp_npes())) + call mpp_get_current_pelist(pes) - r_convect = 0. - where(convect) - r_convect = 1.0 - end where - call save_restart(Phy_restart, timestamp) - if(in_different_file) call save_restart(Til_restart, timestamp) + !< Open the scalar file with the current pelist, so that only the root pe opens and writes the file + if (open_file(Phy_restart, trim(filename),"overwrite", is_restart=.true., pelist=pes)) then !scalar file + call physics_driver_register_restart_scalars(Restart, Phy_restart) + call write_restart(Phy_restart) + call close_file(Phy_restart) + endif + deallocate(pes) + + if (mpp_get_ntile_count(physics_domain) == 1) then + tile_file_exist = open_file(Til_restart, trim(filename), "append", physics_domain, is_restart=.true.) + else + tile_file_exist = open_file(Til_restart, trim(filename), "overwrite", physics_domain, is_restart=.true.) + endif + + if (tile_file_exist) then !domain file + call physics_driver_register_restart_domain(Restart, Til_restart) + call write_restart(Til_restart) + call add_domain_dimension_data(Til_restart) + call close_file(Til_restart) + endif end subroutine physics_driver_netcdf ! NAME="physics_driver_netcdf" +!< Add_dimension_data: Adds dummy data for the domain decomposed axis +subroutine add_domain_dimension_data(fileobj) + type(FmsNetcdfDomainFile_t) :: fileobj !< Fms2io domain decomposed fileobj + integer, dimension(:), allocatable :: buffer !< Buffer with axis data + integer :: is, ie !< Starting and Ending indices for data + + call get_global_io_domain_indices(fileobj, "xaxis_1", is, ie, indices=buffer) + call write_data(fileobj, "xaxis_1", buffer) + deallocate(buffer) + + call get_global_io_domain_indices(fileobj, "yaxis_1", is, ie, indices=buffer) + call write_data(fileobj, "yaxis_1", buffer) + deallocate(buffer) + +end subroutine add_domain_dimension_data + !####################################################################### ! ! @@ -3188,139 +3246,176 @@ end subroutine zero_radturbten !##################################################################### -! +! ! -! physics_driver_register_restart will register restart field when do_netcdf file -! is true. +! physics_driver_register_restart_scalars will register restart field when do_netcdf file +! is true. ! -subroutine physics_driver_register_restart (Restart) +subroutine physics_driver_register_restart_scalars (Restart, Phy_restart) type(clouds_from_moist_block_type), intent(inout), target :: Restart - character(len=64) :: fname, fname2 - integer :: id_restart - integer :: nc - logical :: reproduce_ulm_restart = .true. - integer :: index_strat + type(FmsNetcdfFile_t), intent(inout) :: Phy_restart !< Fms2io fileobj + + character(len=8), dimension(1) :: dim_names !< Array of dimension names - if (do_moist_processes) then - if(doing_prog_clouds) then + if (do_moist_processes) then + if(doing_prog_clouds) then now_doing_strat = 1 else now_doing_strat = 0 endif - if(doing_edt) then + if(doing_edt) then now_doing_edt = 1 else now_doing_edt = 0 endif - if(doing_entrain) then + if(doing_entrain) then now_doing_entrain = 1 else now_doing_entrain = 0 endif endif - fname = 'physics_driver.res.nc' - call get_mosaic_tile_file(fname, fname2, .false. ) - allocate(Phy_restart) - if(trim(fname2) == trim(fname)) then - Til_restart => Phy_restart - in_different_file = .false. - else - in_different_file = .true. - allocate(Til_restart) + dim_names(1) = "Time" + call register_axis(Phy_restart, dim_names(1), unlimited) + + call register_restart_field(Phy_restart, 'vers', vers, dim_names) + call register_restart_field(Phy_restart, 'doing_strat', now_doing_strat, dim_names) + call register_restart_field(Phy_restart, 'doing_edt', now_doing_edt, dim_names) + call register_restart_field(Phy_restart, 'doing_entrain', now_doing_entrain, dim_names) + + if (.not. Phy_restart%is_readonly) then !If not reading the file, + call register_variable_attribute(Phy_restart, "vers", "long_name", "vers", str_len=len_trim("vers")) + call register_variable_attribute(Phy_restart, "doing_strat", "long_name", "doing_strat", str_len=len_trim("doing_strat")) + call register_variable_attribute(Phy_restart, "doing_edt", "long_name", "doing_edt", str_len=len_trim("doing_edt")) + call register_variable_attribute(Phy_restart, "doing_entrain", "long_name", "doing_entrain", str_len=len_trim("doing_entrain")) + + call register_variable_attribute(Phy_restart, "vers", "units", "none", str_len=4) + call register_variable_attribute(Phy_restart, "doing_strat", "units", "none", str_len=4) + call register_variable_attribute(Phy_restart, "doing_edt", "units", "none", str_len=4) + call register_variable_attribute(Phy_restart, "doing_entrain", "units", "none", str_len=4) endif - id_restart = register_restart_field(Phy_restart, fname, 'vers', vers, no_domain=.true.) - id_restart = register_restart_field(Phy_restart, fname, 'doing_strat', now_doing_strat, no_domain=.true.) - id_restart = register_restart_field(Phy_restart, fname, 'doing_edt', now_doing_edt, no_domain=.true.) - id_restart = register_restart_field(Phy_restart, fname, 'doing_entrain', now_doing_entrain, no_domain=.true.) - - id_restart = register_restart_field(Til_restart, fname, 'diff_cu_mo', diff_cu_mo) - id_restart = register_restart_field(Til_restart, fname, 'pbltop', pbltop) - id_restart = register_restart_field(Til_restart, fname, 'cush', cush, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'cbmf', cbmf, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'hmint', hmint, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'cgust', cgust, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'tke', tke, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'pblhto', pblhto, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'rkmo', rkmo, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'taudpo', taudpo, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'exist_shconv', exist_shconv, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'exist_dpconv', exist_dpconv, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'pblht_prev', pblht_prev, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'hlsrc_prev', hlsrc_prev, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'qtsrc_prev', qtsrc_prev, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'cape_prev', cape_prev, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'cin_prev', cin_prev, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'tke_prev', tke_prev, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'diff_t', diff_t) - id_restart = register_restart_field(Til_restart, fname, 'diff_m', diff_m) - id_restart = register_restart_field(Til_restart, fname, 'convect', r_convect) +end subroutine physics_driver_register_restart_scalars + +!##################################################################### +! +! +! physics_driver_register_restart_domain will register restart field when do_netcdf file +! is true. +! +subroutine physics_driver_register_restart_domain (Restart, Til_restart) + type(clouds_from_moist_block_type), intent(inout), target :: Restart + type(FmsNetcdfDomainFile_t), intent(inout) :: Til_restart !< Fms2io domain decomposed fileobj + + integer :: nc + logical :: reproduce_ulm_restart = .true. + integer :: index_strat + character(len=8), dimension(4) :: dim_names_4d, dim_names_4d2 !< Array of dimension names + character(len=8), dimension(3) :: dim_names_3d !< Array of dimension names + + dim_names_4d = (/"xaxis_1", "yaxis_1", "zaxis_1", "Time "/) + dim_names_4d2 = (/"xaxis_1", "yaxis_1", "zaxis_2", "Time "/) + dim_names_3d = (/"xaxis_1", "yaxis_1", "Time "/) + + call register_axis(Til_restart, "xaxis_1", "x") + call register_axis(Til_restart, "yaxis_1", "y") + call register_axis(Til_restart, "zaxis_1", size(diff_cu_mo, 3)) + call register_axis(Til_restart, "zaxis_2", size(exist_shconv, 3)) + if (.not. Til_restart%mode_is_append) call register_axis(Til_restart, "Time", unlimited) + + !< Register the domain decomposed dimensions as variables so that the combiner can work + !! correctly + call register_field(Til_restart, "xaxis_1", "double", (/"xaxis_1"/)) + call register_field(Til_restart, "yaxis_1", "double", (/"yaxis_1"/)) + + call register_restart_field(Til_restart, 'diff_cu_mo', diff_cu_mo, dim_names_4d) + call register_restart_field(Til_restart, 'pbltop', pbltop, dim_names_3d) + call register_restart_field(Til_restart, 'cush', cush, dim_names_3d, is_optional = .true.) + call register_restart_field(Til_restart, 'cbmf', cbmf, dim_names_3d, is_optional = .true.) + call register_restart_field(Til_restart, 'hmint', hmint, dim_names_3d, is_optional = .true.) + call register_restart_field(Til_restart, 'cgust', cgust, dim_names_3d, is_optional = .true.) + call register_restart_field(Til_restart, 'tke', tke, dim_names_3d, is_optional = .true.) + call register_restart_field(Til_restart, 'pblhto', pblhto, dim_names_3d, is_optional = .true.) + call register_restart_field(Til_restart, 'rkmo', rkmo, dim_names_3d, is_optional = .true.) + call register_restart_field(Til_restart, 'taudpo', taudpo, dim_names_3d, is_optional = .true.) + call register_restart_field(Til_restart, 'exist_shconv', exist_shconv, dim_names_4d2, is_optional = .true.) + call register_restart_field(Til_restart, 'exist_dpconv', exist_dpconv, dim_names_4d2, is_optional = .true.) + call register_restart_field(Til_restart, 'pblht_prev', pblht_prev, dim_names_4d2, is_optional = .true.) + call register_restart_field(Til_restart, 'hlsrc_prev', hlsrc_prev, dim_names_4d2, is_optional = .true.) + call register_restart_field(Til_restart, 'qtsrc_prev', qtsrc_prev, dim_names_4d2, is_optional = .true.) + call register_restart_field(Til_restart, 'cape_prev', cape_prev, dim_names_4d2, is_optional = .true.) + call register_restart_field(Til_restart, 'cin_prev', cin_prev, dim_names_4d2, is_optional = .true.) + call register_restart_field(Til_restart, 'tke_prev', tke_prev, dim_names_4d2, is_optional = .true.) + call register_restart_field(Til_restart, 'diff_t', diff_t, dim_names_4d) + call register_restart_field(Til_restart, 'diff_m', diff_m, dim_names_4d) + call register_restart_field(Til_restart, 'convect', r_convect, dim_names_3d) + if (do_clubb > 0) then - id_restart = register_restart_field(Til_restart, fname, 'diff_t_clubb', diff_t_clubb, mandatory = .false.) + call register_restart_field(Til_restart, 'diff_t_clubb', diff_t_clubb, dim_names_4d, is_optional = .true.) end if if (doing_prog_clouds) then - id_restart = register_restart_field(Til_restart, fname, 'radturbten', radturbten) + call register_restart_field(Til_restart, 'radturbten', radturbten, dim_names_4d) endif index_strat = 0 do nc = 1, size(Restart%Cloud_data,1) if (trim(Restart%Cloud_data(nc)%scheme_name).eq.'strat_cloud' .and. .not. reproduce_ulm_restart) then - id_restart = register_restart_field(Til_restart, fname, 'lsc_cloud_area', Restart%Cloud_data(nc)%cloud_area, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_liquid', Restart%Cloud_data(nc)%liquid_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_ice', Restart%Cloud_data(nc)%ice_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_droplet_number', Restart%Cloud_data(nc)%droplet_number, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_ice_number', Restart%Cloud_data(nc)%ice_number, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_snow', Restart%Cloud_data(nc)%snow, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_rain', Restart%Cloud_data(nc)%rain, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_snow_size', Restart%Cloud_data(nc)%snow_size, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_rain_size', Restart%Cloud_data(nc)%rain_size, mandatory = .false.) + call register_restart_field(Til_restart, 'lsc_cloud_area', Restart%Cloud_data(nc)%cloud_area, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_liquid', Restart%Cloud_data(nc)%liquid_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_ice', Restart%Cloud_data(nc)%ice_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_droplet_number', Restart%Cloud_data(nc)%droplet_number, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_ice_number', Restart%Cloud_data(nc)%ice_number, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_snow', Restart%Cloud_data(nc)%snow, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_rain', Restart%Cloud_data(nc)%rain, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_snow_size', Restart%Cloud_data(nc)%snow_size, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_rain_size', Restart%Cloud_data(nc)%rain_size, dim_names_4d, is_optional = .true.) endif if (trim(Restart%Cloud_data(nc)%scheme_name).eq.'strat_cloud' .and. reproduce_ulm_restart) index_strat = nc if (trim(Restart%Cloud_data(nc)%scheme_name).eq.'donner_cell') then - id_restart = register_restart_field(Til_restart, fname, 'cell_cloud_frac', Restart%Cloud_data(nc)%cloud_area, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'cell_liquid_amt', Restart%Cloud_data(nc)%liquid_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'cell_liquid_size', Restart%Cloud_data(nc)%liquid_size, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'cell_ice_amt', Restart%Cloud_data(nc)%ice_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'cell_ice_size', Restart%Cloud_data(nc)%ice_size, mandatory = .false.) + call register_restart_field(Til_restart, 'cell_cloud_frac', Restart%Cloud_data(nc)%cloud_area, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'cell_liquid_amt', Restart%Cloud_data(nc)%liquid_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'cell_liquid_size', Restart%Cloud_data(nc)%liquid_size, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'cell_ice_amt', Restart%Cloud_data(nc)%ice_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'cell_ice_size', Restart%Cloud_data(nc)%ice_size, dim_names_4d, is_optional = .true.) endif if (trim(Restart%Cloud_data(nc)%scheme_name).eq.'donner_meso') then - id_restart = register_restart_field(Til_restart, fname, 'meso_cloud_frac', Restart%Cloud_data(nc)%cloud_area, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'meso_liquid_amt', Restart%Cloud_data(nc)%liquid_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'meso_liquid_size', Restart%Cloud_data(nc)%liquid_size, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'meso_ice_amt', Restart%Cloud_data(nc)%ice_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'meso_ice_size', Restart%Cloud_data(nc)%ice_size, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'nsum', Restart%Cloud_data(nc)%nsum_out, mandatory = .false.) + call register_restart_field(Til_restart, 'meso_cloud_frac', Restart%Cloud_data(nc)%cloud_area, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'meso_liquid_amt', Restart%Cloud_data(nc)%liquid_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'meso_liquid_size', Restart%Cloud_data(nc)%liquid_size, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'meso_ice_amt', Restart%Cloud_data(nc)%ice_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'meso_ice_size', Restart%Cloud_data(nc)%ice_size, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'nsum', Restart%Cloud_data(nc)%nsum_out, dim_names_3d, is_optional = .true.) endif if (trim(Restart%Cloud_data(nc)%scheme_name).eq.'uw_conv') then - id_restart = register_restart_field(Til_restart, fname, 'shallow_cloud_area', Restart%Cloud_data(nc)%cloud_area, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'shallow_liquid', Restart%Cloud_data(nc)%liquid_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'shallow_ice', Restart%Cloud_data(nc)%ice_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'shallow_droplet_number', Restart%Cloud_data(nc)%droplet_number, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'shallow_ice_number', Restart%Cloud_data(nc)%ice_number, mandatory = .false.) + call register_restart_field(Til_restart, 'shallow_cloud_area', Restart%Cloud_data(nc)%cloud_area, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'shallow_liquid', Restart%Cloud_data(nc)%liquid_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'shallow_ice', Restart%Cloud_data(nc)%ice_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'shallow_droplet_number', Restart%Cloud_data(nc)%droplet_number, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'shallow_ice_number', Restart%Cloud_data(nc)%ice_number, dim_names_4d, is_optional = .true.) endif enddo ! save large-scale clouds last to reproduce ulm code if (index_strat > 0) then nc = index_strat - id_restart = register_restart_field(Til_restart, fname, 'lsc_cloud_area', Restart%Cloud_data(nc)%cloud_area, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_liquid', Restart%Cloud_data(nc)%liquid_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_ice', Restart%Cloud_data(nc)%ice_amt, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_droplet_number', Restart%Cloud_data(nc)%droplet_number, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_ice_number', Restart%Cloud_data(nc)%ice_number, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_snow', Restart%Cloud_data(nc)%snow, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_rain', Restart%Cloud_data(nc)%rain, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_snow_size', Restart%Cloud_data(nc)%snow_size, mandatory = .false.) - id_restart = register_restart_field(Til_restart, fname, 'lsc_rain_size', Restart%Cloud_data(nc)%rain_size, mandatory = .false.) + call register_restart_field(Til_restart, 'lsc_cloud_area', Restart%Cloud_data(nc)%cloud_area, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_liquid', Restart%Cloud_data(nc)%liquid_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_ice', Restart%Cloud_data(nc)%ice_amt, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_droplet_number', Restart%Cloud_data(nc)%droplet_number, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_ice_number', Restart%Cloud_data(nc)%ice_number, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_snow', Restart%Cloud_data(nc)%snow, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_rain', Restart%Cloud_data(nc)%rain, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_snow_size', Restart%Cloud_data(nc)%snow_size, dim_names_4d, is_optional = .true.) + call register_restart_field(Til_restart, 'lsc_rain_size', Restart%Cloud_data(nc)%rain_size, dim_names_4d, is_optional = .true.) endif -end subroutine physics_driver_register_restart +end subroutine physics_driver_register_restart_domain + ! !##################################################################### ! From 1b2b143ab5508d4a9597d8e57ab4883c9d528305 Mon Sep 17 00:00:00 2001 From: Huan Guo Date: Mon, 21 Jun 2021 22:35:28 -0400 Subject: [PATCH 4/9] fix qcsinksum_rate1ord --- atmos_param/microphysics/micro_mg2.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_param/microphysics/micro_mg2.F90 b/atmos_param/microphysics/micro_mg2.F90 index f0e65841..23abce50 100644 --- a/atmos_param/microphysics/micro_mg2.F90 +++ b/atmos_param/microphysics/micro_mg2.F90 @@ -3305,7 +3305,7 @@ subroutine micro_mg2_tend ( lon, lat, & meltsdttot = meltsdttot/real(iter) frzrdttot = frzrdttot /real(iter) - where (qc(i,j) .gt. 0.0) + where ( qc .gt. 0.0) qcsinksum_rate1ord = qcsinksum_rate1ord/qc/real(iter) end where From 371ff33de9f82f9e2e55ca50942fa960a1e5486e Mon Sep 17 00:00:00 2001 From: Huan Guo Date: Wed, 23 Jun 2021 15:44:30 -0400 Subject: [PATCH 5/9] add lon, lat for lscloud_driver for debug purpose --- atmos_param/moist_processes/moist_processes.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/atmos_param/moist_processes/moist_processes.F90 b/atmos_param/moist_processes/moist_processes.F90 index 425ae28e..ce34f410 100644 --- a/atmos_param/moist_processes/moist_processes.F90 +++ b/atmos_param/moist_processes/moist_processes.F90 @@ -682,7 +682,7 @@ subroutine moist_processes ( is, ie, js, je, npz, Time, land, ustar, & Moist_clouds_block, Input_mp, Tend_mp, C2ls_mp, & Output_mp, Removal_mp, Aerosol=Aerosol) call lscloud_driver & - (is, ie, js, je, Time, dt, Input_mp, & + (is, ie, js, je, Time, dt, lon, lat, Input_mp, & Physics_tendency_block%qdiag, Tend_mp, C2ls_mp, & Output_mp, Removal_mp, & Moist_clouds_block%cloud_data(istrat), & From b837f30f5fcf6500e6787df4a61521d9d1f8855d Mon Sep 17 00:00:00 2001 From: Huan Guo Date: Wed, 23 Jun 2021 22:29:18 -0400 Subject: [PATCH 6/9] clean up --- .../.nfs0000000004a4062a0000005e | Bin 159744 -> 0 bytes .../moist_processes/moist_processes.F90 | 46 +++++++++--------- .../.nfs0000000004f6a0ce00000060 | Bin 16384 -> 0 bytes .../.nfs0000000004f6a0d10000005f | Bin 204800 -> 0 bytes atmos_param/physics_driver/physics_driver.F90 | 5 +- 5 files changed, 26 insertions(+), 25 deletions(-) delete mode 100644 atmos_param/moist_processes/.nfs0000000004a4062a0000005e delete mode 100644 atmos_param/physics_driver/.nfs0000000004f6a0ce00000060 delete mode 100644 atmos_param/physics_driver/.nfs0000000004f6a0d10000005f diff --git a/atmos_param/moist_processes/.nfs0000000004a4062a0000005e b/atmos_param/moist_processes/.nfs0000000004a4062a0000005e deleted file mode 100644 index abffdcbcc35a66d925ef1f2ce9d108d04ce6caa6..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 159744 zcmeFa2Y@6;b^kvCAqgb15gB?UhZ|`pJB&3s8Vs$|}aY=V49YVk`J2SgGx(T}z z_5%C}mI*RJLV(H1B!dYCOcFr?0~Q!LfJh=|3oy0?CS(6UuR?cqPj^qx?g-;Q*LUBY zneGa&UcIWW_p0jE^xDg|?eNYTUz_8)S1xzjMgQ`I(c@l!?6Y2*%U#qd)W%km14lV+7v%z^g&%G^_6z?}>eE;OIVL_QyAes4FQ7e$^w$o#&{e7-R9{K4k; ze)IXm$n%Go-+A*nWeBizJk;FZYd&8SdHyhS{|V;vr;+CmH}`j&&%LI=Hhs_Bw;Ivw zBF~4+^DE5fFC))anEQ`3pL_4Dzu5FoG4~&BK3@=deyX{@$9(=M^8DDy^GS2Vrhgan z+}6trBF~RA&$pS+Z$_RUABjI|613@`V4k0AJ{Ka-SDO3xG@oydJin{Cf3f+zG4lLw z=Ke18c{f9_&HqGm{}S_gdF1&?=Dz)WOXT@!=J_Md=i4LC?{4m&XFh)&d43Ob-_n19 zVVI@QmfISqo)dX~FB9ML@21G}dzz&u#l&j66TtJfAY3pNu@ezq!BDd>(Hq)TaLcbN_Pld1>Ui5%=7fdH(Lm zb94LX$59R(<-k!69Ob}K4jkpcQ4SpCz)=ny<-jsHP(b1Ei2rCAsH3D@Xwv!~3e9)H z%fU;*EI0%F0!8R;pa#alk5Qa{2wn?b1Fi!z;2iKvl(Bb!r-2<{J6Hj3N11yEI0ViB zw=>p%2dIK`!9BsZ(J$T(4uhTG9^fPBG=BxEU<~{M9qOatnII1y27Z9v_A2lMFbsZ* zp80<8r(g=406v56`#i7@oD9B$^6^Gc1LNQq==PrgF9Ne*2z(v>yb1`P_6x6iTwbrM zHlJ^o>!otNcsSoaJYOF3xYI1x8jFRhxp7*qS0dhy-T6v=zSA}__*t*n=-z3$POIz% z3o7!RcBR_N*BYfUuTifa_BML$a&5k_I6LMQ8`Vy&o-b7j{AkYQi-l@&%ri;or5f#K zp;&IJL@Mn{Ih@dJxt%Z8D)aeyS;aBtso!(un*OZ_DU_RyRzp)~B2zv?i2G25UMx4; zkTWxrFEuOt2$9|DG`TMig>}8z)PmFb*=l1N-bxXB$C&QS%#f)QXDq}F=RrW(Mz2|( zW%)`tVt%GluEO#R)!FLQ6n#``yFA;3S`}9@MCcCgt4a*m7k;QB5w_B{L>C+N#d5J- zY1HHDZzHld(K#rAGBUJMVu?;3QBhxt{rG+Xm0CH!SZE$r4J@5xo_0|kQ>jiHF%7CK zmM;%IGpx3X)kdde8y-B$Eg?=uzD6<&^G5owNB|@Frj(I~TI9nw;g;8%{_>&XT%kTo z6*ubbrs<_pqFF8rqgwfyW}`+oAS>6VtBv9TzXO*7$Pzb%CEqO2N>vk-%yh4z`I@0; zu!-p2KFB16M4h(EKF_;FWvbsaS@LU^i}dC*)y^TmFebs|4@;!~VhiZBGV2GS-|l(| z*oST%&_?7nG~}7}g7SLdomT2p%dK28Ddx$(t$Vg?dCZnEZ~wj>Q``28d3(2P+O>1@ z-u&(@d-9v7E>{nB+GJEeOXl<_^>#p=dMp*b(c82;uadcN&(vjO-bLHhpS|*JYo=ag z=dS#|JyV;u?8(_Y6F=n*YF@eZLanSi8xbdSuU4oRX6p%}SdtzT9ld8@Jx6O_!T0jYfwzRi=Uz=gROwMsww6vq5YXO$31Y ziPnug)b*nR=MfiZ-8!{zYWtYCbJsr2z90!Hq8&lVU32LqbQdEzOJysOknp8Otx&0l zvex1CgNe<#V3<-Wv6Rc)0ilYEBON10e*Pw@qD`-@0wf_RV=%k>9%O(w&=wY`YqTVWdBj3sR#7k;}Xk&UR<& zb(NHadZ-4dQf;k5o0tB4qshoA()DfR9baP&A&8Bm3qInv|(xZ>G`I zI$Ed6Si!D)&rw|&6Ymua#a6v8buPiudTDGq(f@BlmwpfWwdnt2Mz8%Cy8cJOjo@0a z6&wdXiO&BCa5ZRyJh&L#2i%Iz|7GwzunAlM9te&DpGEI~IhX+>;343_;D_k{9{}$M zZvqFvIp9R_CF}ri0A=uKupev$XM?lAzd`elfzbZ9LjTe0Cd3uOXfqKT-hs(=V+Ri9a^^-pVARIZNtYuVM;(rA z91SA)nMnlsVfY~toM$!*U4=S3{<>NCHR*Fy*QEU^g^}7cc}r|3KVpY|iXfDZ*tnKp zBFRlYETc8XT+VL~jp0#Shh|k7RZ?)GnA;#(p)zQ_?uL{+y z>1Z!{l9bAXIN_u;8+20UyGbheB}tjI>I)Upikbzz5zn#ujd{bBVmW`X&>r?I4N#XQ zUbV6ij(6Y?(OQ)w<&pN-dYjml&dmvXv*O(JtDwC&xpw>8^8MI)*>!|91WPP3Zc62F?bf;6dR2;6KsxKMtM^wt(ND z+spj_SHPFRyTH@I4sZhaFgpI*z^lM3z#`ZQMECy+I{vlbsbB%jgO%WW==LuI2f@YQ zPr%pF?_UdE02aU&@DuD7-vQqS9|bKS>!P;;SsUOs zOk&xhsK~47veurtVbvb95TQ1|k`)67%k5HGzxV2`hTnoUsf~Q+pv;=lX(>`dbf`p6 z_eRd#Furz;o`V@()o!$z+17~?S!h*#U0m9wM!n7~N2y$%C;2|p){%p>y`14okPgMw zH!CyV2$R`{DoW{{=dJa|8_jW<xaWF#ePLeUZQNETV^S3J%>GgUk` zI7Cb8S;XV)GqZ_DSK1lGBRTD`cwiK_m6$<1Hgt=JTir?GVdM`ha?k{{d`=hV=PK1o zagU_lpZxj2r1DEMnAYo9*E9FR6fyf~nxH`ZZ6|OPG{w%TKqP`ot0k%(c;-%)7apl(*CjdC(ztwUG>2o7hgy zDHYqDL&mC!ukfT2&HLQ66&kS0K640Gtm01(S+v0-pDB_U;;4zHr8tneeww1oEWas| zZW14)ZW^o&v|J!)zzF@&VZ)%NzgDl#4UvKa%+5GGjWiTgA{d9ySyB8<`*AJtL`8^-~77woS{P~1mgjxRq<-p^*_2w25@$q zR~H4st4_jdiU9;+~(9=3cVYIROXCzW;faijzgQtKd$Z+XSO?QyCgOgA0=*#^gI_Z3~OMbg$ z&~&&x!^XaxS&_tQ&oN$-`ZKP1`x!`(E`oGSG~A#UpOJfLGr^sz+!@f@G&dy7Qg1Uu zcBQQr_jn^LO!8WdP7@E3qZvs{cS`D` z=UH<_KV&ry#ZuKcl$j`#LN`r~LlKf>C7D^?%a#R9Tjjd7!>IMgEYKQR9U8X?cgDQP zy#~fntR|H*hLf=?%f<{rHMrxfNUcQ1L-mFjrNdcqiz`kkA6=z*+&IMeC#RUpAE}h! zc2_&;l8Yz>l&p&cxtB%(&tpl@_oFoQ7<5TNx;Ze3VK66;BF_|Q>S3JN8wr)h!mMBh zbC@42(j4Tz(*_vcdYYQ33LybA*v52v;j$#=;mD_i=^>jsnOH$|#`_@-OB5Maj!wqk zKHa^o$Db_P%uBRD@ap!~q#{x;6K^3GE89)YD_ik8rdeEWmT@~Zg_b5Mh}gLHPnD`{ z@p9xzryFWhK|-yTu5e^VN9pbYjb&8_MCssii<)nh3#~#mTg{uW=~;=E=_lGpRus{x zyjUV*D$wMlo+Q+v2@+JJr|Qw%o;07fuH4#WipOYAbz3AGET=db)Pz&&Xsy~x%4pQC z&lxLck1Dm{q)vNSpk2fE&Wkqe+_k=U73y$3ZRSfbZm&CQ)kyN>ht5|_w5ehInOs#5 zOZgKLO{=Ao`=~!b%Znzfb$uP~z5U6Tk))(yyc8^~_b-9=Q2MUk5=*`gkUGDULcW`P zUCBM6BugV?-dZ;zHHZJSUuv>xqj z360^*iIkZhGWC0{?6P>~gd>X~QE?{%W75tbD9LHNaw2K_gNL3HLg=V?*ow?59^r|@ zB=NAJ`VtSBrqpC4C9Asr#zdlci2i>jO6#KNuIT^Ui~{>9^!*Qm4}lKY362MUhwgtB z7zHE74sboXe+!%eeuCcr*Wjt(Y;YF%2{wT5fNz6W0-5Wd0JmWWcnc_iQSdEn0IvX- zfZgDDa3eN=SAk2xDEJln|J%VKFa~7L|9!wc!6(rF-wWOY+Tcv^3-tfDfjW>m{JVe; zqW?EQ9jpXjN8kStXn~8tL&4|J_g@Y6fvsR8I2-&Yd=kB1_|*}fE$JGNZ96w4{d1{2 zBMb0!W70c!3oM86M%bP+U+u^qAHDf|u{=63TecbPN3`6~NHFQ$Q7fQZvX`cruhiI( zKT>IJR65&6bT(&6^MPxT`Mlh4&T&*Q&b z;hrq~ONWU36>4dJtZ$t^JdlnpoR|nxAgJNI$vUoM3n!4?x21(m?B2qWj`nbD#I&!) za0R9R>e<0{MYmoEO!K4TT&-LY*ltDr7L~ve8D+$Z^paA6S-MF#9hJvK$@YfnEX|*5yLyvQHCq4tEWtCjC7Xv z*#JAr0VSnJDC$jZS7$vGdWD;h)ie+_Kbfd*^q4ur(?nO$U4E!8A<7S_)`S%%lGSqJx9W|9 zc}5C7(->r(NT$EHI)QWH!AXK#Ce7`N{x80}_a4I^Xa4{F==ycA3Vatm|DV7!!2z%n zoB9&k0-1Re;!gr0vLm;>VT@4M*uUjo;IXMss@68I## z{t>VNh=2VXz+tcpoCrRKe*Y36I{!Vuoxm~RSMcVS;O$@<2(R{lgiAHdO5NMEW83aC zj1I<>W?3~+baJJlI|>=yLcP(f6{_r0DS6X}&Cpf_8}ka{dSao2m$PzdK>e3HPO$@) zun?&hY5(j{ey#Lw1MS{wrM5DNBb1R!zQvfg+Bi76QZ^A4YVDkj=y{o=>IB7Xu}WeG zBV8J=+FXz)akLEKP4N44H)N12-!f;+2Br>{ggcCE(hrd>zvIZxOmM&{ikY*8R?GK_ z)e@e_3Pmyu|0Y9+r8bWG%$#p5qevoi0s-Mt#X$`(jT|FuGA$lWYuOYj)ly5DBHC0S zdsYlv*>{sRQ?djCa+V7wZ{>eaS@G<0gn)fgWWUVnoot(+qk`%5meHzlA=Ow)lh*M9 zYJWfNS?3xnqrGY)E5U} zHA;23y;$PaXRmHRC$)^Wn@&sCwi}{Z|H#GM)3>sfDUkZ*wq_|}Kdm_%l{mE>HREm> z7vyv-V+YrJf%Dl145ZdYBFqnl*1>weV92dokzEHE8DoYcgvUyZ+x=KEJtWTtqko$z zF}EP2dJJ~xhhKc@v zIr?xJ{aEyWdp_BF(feNk=7IPC5Z{0AL)RC-|BnYA_)m2FcYqRj5I6~(2)>EF|1xkT zSOva;zW*ZdOi%^le9I1jJG} zx@LqKPn|%hg)$Yc2XjMR)RB8$XCBSCcWOE@*CM5k2vFW(*O$DJZJUwpgEnsoE$R%$ zj^<&tpvw5dFPVU&X4`#~#y)<#8ylGZ4JJafrqPRmI-OF63?zmxP_1`6+#aaCl1 zdJ)S-l!4eYoTt*y<2nHs+L?^oy#nQwh}bnJtPxOslu z{a~+L5}w;yiseXA77DkE1*XH?YPS9{G#gC{eI|yUT2OskdR~H#5Z}GSp{m(NUB6xct z3q~x*Mb<@ORxLqDjMTqhHhE?l8RkevZvL+^$0?%Aq@^~aaO+BF(G#1U!Ob$-Y$P+k zHoV@K+l-~R9^z;k#%c#9<&W;WVGJ6 z5W2&?ddzFl5FKq{OzP`5b=sTKz9<#(y~&LU5#_u|DVEz>I3vtXrCS&tj^*=vFd{87 zr^MQycaha>3^^28(U+ATfs5r_xej;s^bJfg5qb;{l`u&c&eVxj!_1@TTwYAYq~A)Y zw)9BO(`=)g-qu1jWHnZTH7b4ARv0TqGR`zH!V6a%@{+&CIWf}j5fjI@b0-_Ma@uT| zlvb6q$@kmbZ9Mb&2UQ7r^d;{`RS%h}!5>ySqfqmf7WSFPs>$l@raieYFV4V6R)k*} zer9B;>gF?PLxD=|cc_|-MA;0*a2S(7eHTk2x{JflAZ3T8wwpKm8~vU_*2UD9Jbn(p zi=|T%{r_}S*~T$i|G$_IxkUf}EAS?871#$(2LFKG|0(b~Py!DC|Afx}XW%MuF8FVB z{`Z0Rf?4n|@Q>*G9|x}ivi|=R@UQ6nuLQ3E;ve8q;1+cKmjPM-e-79P&ITueuc7b1 z0Ne#!kBJ3~&zk5A^w;fH#3Mco_H@ z`uwNCv%q7($w2l2JPU}9KMhub@4%~f1L0X+_?G>ONJ}PJ4Vo|-cn`@_Z&h*SLRTuG zW5Q?3(^`1lsYXdHZWZDF-FX%OXe$+K8T2wII|dIr93%0e(Ee*bCy6iZ%GfuMxX&Co zn$>urXv)O0%+=(R5!8{@c6<(G$}y>uB$W|=Rp~;-`lM9?aaxd9Y+onT%}q2s<&_7|#;SMhslpTUH@mLmfF%*}52|h>FMud>* zC{t3Vx@04;Z)fjnqR|GXY(2$lWwFw;WvNhpi*kyZiMlKW&6Lp6i@7b-H}ouTIJjT% zoCw>Jt_(eiTX#K;shWt`R;JWV!zrtZN^sLjx{tdH*8li4TCx~LS`nMgZW;7DE;};X zp+(NpJ73jXXx;^X+03T&1J?)*9qB0r(L*-W7;T%@6@F7C8KH5lt%qPtO`N-WwKunp z1+EioC)TcByKeQ`N93F=`}-QLq8=$_)6|w#pP5>_u1<;?urF-d2pO!CC0-=S%9S-( z>-R=~Y&4;}xEU){LDFgLbfPYYpBVLpOHOLBJ%hstkx4(e=^32Ie#hV!BR9md(?*jM z%oywNF6C@z&J=4jqqz z9HAIrLXA07%wX^v3~#vCOMOtIo9+F*_QS!0Mvw~^xSwBLy+vGP|6ND9yk)=pNhD$F zPQClhW50BM;rf2}N6Qv@^^5+Gnwz`g82&K-zsu;dpF`JwA$T-637iOig0BAoa2Pxa z+!cHsegCy!7CacpI)EJb06KpMjDr)w*U4Ag|0%c~{3CcZcnr84 ztOq|s=YJ1)H~0(i1aJx%0=L4Hmw-#aF!(q0{=WpT1y2I!gI~b2pMx(0@$vsyp!jHb z7$-%J7ApNocrL%Eq7l^&WUDhX=$VuQLUoH%m_%R12Si$b4LcM%jZ~jZT1nafFe>_f zBhsZ#P?7!AH4_MXn&-z%d}aS}sLYyi{$H0>ear43G+UpN;LGx93hR}FQA1s-Qr;aY z5*sUduAUgxVCxB9-Q;FT20bzCz1@Qu@u;J3{%^Y~Hec@0RG2j8F}@wbA2yZ@oN| z1dE}=?ZH*9nPQ6UBgbJaK1y_`&*}2|m?(ZfPZ=xF5YMysx>YE=FczPNqtCMjcchGIE-l|9=?z>XXr3MgPCV=&s*K-~S$X6*vG+ z1!4z~v;U5OY49NM&*=Ix|1W0&Tn#P&4+mdD=l?6v1|wh?d=s7jy1_$CZHq+ z9^Hc}SiQPn)Ef{PvJghb1N!h{VTjsYTwqST&wd~mK(oReF{P8I(v zEpOA*?k(z#wQ1Wx!JaB> z*Js$(8cWy;0XMkBy@5Y7&RTq17)aA-~IYd^@*?L> zC7No}y%g>l!;RFvSJOFY`~l@ zVYuAkUkQ_vLI-6|W_Q2_ok#3npM~ma5+7~nv0P4SrWjrtdO|FXrBU6q4AUV@8#6q( zgBn`1OxGwoC2i~SM#M3WoV`|)UXvC$dIvSQaFdJvf(LFZ^gGJtT%Xe5x58khm59Ff z<;l)E>ZVnx%~#7IkFxqjk|Ya$nzSlEA!m#&Rks`o@Ny9m_;Hx@Rkojgt&t&44 z%s6;eyPLxOtZnt;*pP8pdp7K)m{*>5d8neU+Ph`buAQ6r=67$|lixgb`Ji4J>OIv^ zhvF$`ytCB??vj}oZo57 zb0l7uzuN+`pQ;;~0Yb=e@6`U?QNtSfS)IuASOiigiGAQyVSPvfjZcu zq_JI+DC>)b`3A!RpY!Sk8@0Pd>q+V=>RSv)DwNvsAsReX&Y$psH!w>gM=h zho7FeW#{H?TfOkcBbom{9({c;5d9xDU0v6s>o>p|U<3FSy8iXxDPR(a-@h*s=anYz z1Nl4w>;?}7pCO@(fSdy;djH$NL2v<>0*?egN9X?*_$GKgsDriO*XaJ&1K9^~75G!| z2=D-KGrIrlz+tcpc;MmS^Vk5yC*Wo<4rKrTJHeBIoDui{@UQ6nZwDnH^Z);izJC*V zF_;18g1drmpzps2JR3Y3hz;Q9==PrmuL4al3(f(@fm_k@-wys1*mD8ed{4f#IJ+ZM zUm}||Z}L1}-LC{TfRzijP5NOM6T>cch3zDU?R14*NDRB+>CwoTuP^$Z3bl& zjhrsKA1$T4wP@Is@^*zyDQ{QUl=9Y=RA8Hfysz*r(kNCi50v68J1aZ2@Sxmh%)ul% zIM~IOq>zizke#HEooGnZ`UELV7J#HE)+402i7bkr+Q1U9$e4u*n98BCD-Vqw;G{j6 z!DXn4iO}gc0zG`b(X7n&mkq=2q*%$ckyT1AJnDVyslb(VZA@t{qQfOC)#~ zM{_#s7={v)XVDrk;eB$Bh>a$xevjnkX;&06QzS=`r_m_Nq>vP4J~kI+`ACkUav99~ z+ZqYu?Sj0ro0Y;eN}e_f9<0DGmS?nOGN#b3HCpp?uk5#PY)yrjBg-ej! z5Vhd>^&?AAD~#nU$}6ll(rDrc*7PIfP-a>0e52K>kfAsl@@n(OT--i9UmlPGA_X=z z#Q7qV`jGB;JM_whyg9O4O5xFvBf(X9jq}*{7zd4+gs77m1C z-!a1R)7RkyMp7^3k2q})Cm`5fOBIaXEle>ZDvc`Q#~Xeu_%VSl#}zkfPt7&R)9E6X zmS^TzCeOCapypJ&lGlz5s&xw$SMp0-Fy0l7A)d6jk=p!3=b&1RB|kN@RNd9vBb7Qz z{HU;ghYh78F{#4YI}MKB$p^7S4nmQFlLq}*lF>x9l@@E0Jg?3BQT%x$Kc}vY_AwrH zqiEBElSy}hd{6g&KDwd%nIJP=`D~-_i&mx_eySua2(AVKFs(H=Q$^yd@?j-C_;eF; zzl$vQlW14mt{a&tTzbr)Sn6A@kCem%9ZYIqb;qb`Vn)(aKmF>k{4KS0<;lJasy|;o zRGjlGy(_fz|29-EE`5D3Hl9ps`f@l;qdXAg-2Kd_AvTw|p2!AF%-nekg>!Zuq-RSO zr`eaH&CYxV?UW5MwxN%O#Mhb?BQa$IET)|W{UObR!>i`UOnV&jOj~viF$ktrB1yT` zL${7Ytgv8+bkMhBW>Q(|`Tr4g*mKcwMgKp~D6Rj9&VLh-`Tth}@dY>wHiCac_rDJ8 z0I~<*6X^R-1($&_AnX6HNAH)pe_8+k8+84fz|+89um_w7K8~(0^Z#dn+tBU*68t%M z92f!O`(M`lzXm)8$hvpP1$6vtz$M@Wa0~kV3&9hB2Y!rx|5_kx{VxLd03SoQ ze-bzVt^^l?lYrgxFFZI0tOI9&4PZU^5d8TO5Z%88R)ZfLL;Ap7?@!4i)sgbkR&(6E zS@5h`NJ)Z6LCDaQsxoT@&;IYGl3x1Mr$O;kS(BPZ41d$ZJ5Mv_FZT1XwBAgTw4?5d zYYwXE7pBf~X({-+JW07JD1$Et@XXG&^LkN4?6Q=VZB0WERSX`?cZH(b4YQUv3^SM$ z^SqqB;fk?4pU`fOqDRD*-4IR)CzT+*Qfs|zQo3~O^zc4~5SJr1Zr5i*{6!Q(mwcai zvG~MSD%QQ|(!Q?T^o@i(J4tzp(I`Gotc1(UQxspn6~z`;H#?IaF}l_#DE%(kJtmteAV%(`ll{f=neu`(O#4qa)@B5gU#Oh0gnm~;oGTH_hI z;EO|dq?Bqffrb6d0p{Cu#P>$(aiK}?q^=eo7$INn$nEo7@P%k9_%KV4Q+ zs$*W6?eEx8VlvZ##|C5+uwy{qlouGg)qJI6YZY6!srH!A%sQ9$X}hd7i=PvWN7PfA zv{`y&lJP}ZPBBDd_PC54-zse@?W1TEIdu?SJ1&ZSWTM0nt8^D*MK;tr#OkL|tG*x6&^5-%-5fu!%#2H2GgZE5;kzCfy3(Q~{|0O!Ds?j+j1 zl28Fu5`!6E__Jen&dYgAtD!|?H9fCeDWOlf^mhI*LtMScl$NBS>~X=UA(&ko(EHk% z<+jXLM;&v5B2X@{YeDZzs1^>Fn}b>uh(zyT9S^->3NKx_+%R~4fd7@Bdlj8I#h<_v}*|G1X|uh-d%JBh{6 zn&BY{l(>yrF)OpeGQ!n)X{LC)WesL93YM>>GFwn;4Eb#YO%HS_`gj8u=gO@Z;gJJu zg!gieDf2g$c253eSnbbnv$#VFAa`5sfic|32y%sfWYSuegg~;8DwKBBaK~nN1Pfe^M*j78QIOe(|c@axH20>2_))ieZ||DoG!Q%CnX%g#IA zTq`-*DlsD)vjtOGg4G*+;~3^>*97SF3`W7=y~e*3yS80zC_ymG1r-%*|B9i+wSrmp zqJ;8|5)FNvi@KE+}{pF|6gl#+4rOK%h`XU;G5|AF9tH-e`oLkbo?3^ z0uKYXpyR&)$a??N!MD)y-vBNL4+j5)ZhsBf1nvahi*ElUAbb38L$7}oxCDq_|M#KK zi!VP9JRE!;9sW8XYxviL+tA_P1D*zUfCqw`(cP~BTfmscA zbuy4wzCG|K(V3oBq~&z{?uzUcIb10wnHXZaZn@OurA7=jDxeh5q!mw6B*s#xa0$?- zRY%yfM8-rU%M_!l{E-`J)Tjx-o-B!$LB(1MW1!4ZQ)<-fmd&97OY8jc{b3B>YGff^cyvO%BznF8m>4SB-4A#0 z#86D9y$_qQ4CNQ{T~lm9ht?e^R-*i1^$J5F>50NZRCJ+pl3?eIGP+j+2_3y;#DK_M)gt>$Nd1k_)Qvl0!Mm9ha?*yz1k#Hssz{o z>D4dux~b{-0dzW||6hROyYm?Sp#Pt1l;97b_cy_5;2Y@tUk9%TmxC4H%jo@I0?z{% zgJZ!*(ftpCMKA?^j_&_a&;jD_|EK8w9|R3>3iu-W|FgmQ;BMd}=>N|G=Yr$G2hsnZ z0c4*4c<>?g|Es|yI049ce$NDQp5JlcdUXG%gR{Xg;BV3SWiI~_K-TYn1Y83)0rB1c zDey8NW#0j|gGT{%AwYM?6>JlcYLZoUE9;$F-gM>KPTXRYmFu0m5nTz`t^0UEMk`I? zTBK`1=-yd)iOCRG1lr3&sFTS5Qla}Rv*L@xzs^Bv;q(`_&^Z;N_n#n*P`OF3tD=Kp zpu??|LC$_<+p6xJy9p5xu~MdZi`6CvAxCO2K6f{`-%n~yCzm;U8!$pfKQySYgCszv z;Ik6ohaDsVwPHb>E6;`7P<$=;VV6ySD_N52O!J7Lz*J{40V?RS324&vBce4Uj z9&0UGQyQC$w66+^ffn%YbnJ68(u--ZL7p=bI5{cvxF<=~^kmFqos8)J_eSCUu;{($ z|NKx#PzF1|cJL^049J1M#U^kisDMX+}_bRp5B=UF-}W0xt!NK+X|Z3&gL$zhZaz0r)%cI`C(p47P%m;8<{H@Ezv+zH@3!M{vY#6=EFExnX!j~FE z@6SsOqBp;#2GK8RwO1@dxYQuH(}8*ELDce*)F1`51Fl=x{4H7um8qO+COqq|U%$Sz zr_A_x+B0VSGwlg8{+V|08UIW4Z`|w>j^S79IM7Ng%fuGJ;X_pYWwSAdIwhN8BX}T^*uJmGtn%GOzK2@PmJ-g zeXonQ8U{Se7+Dx%)|NQEjvnII<{NeRq#T~h9S%Nc5dcGUe6acB>lU|X)E4(jeSmt0 zb|4kw_s#b{)rfk1^K_gTw{Kl>0+q{;LvrF6%6F~S6~`Y(`cdR1YG+Ety;@fkGY#%X zKGx6-lm-Ea_CyoPzV? z{900O2Gnk?U@MX@UCQ^HyK$n9cT^l9D^Db+2|Yu#%8{HVEJ#wuUFk{6O1H%5+JhiF z)y0!wSK`XeAUcuyG*5$Zb>Pv>FPLM|NDFR>&KTUfIkf6zTGE>2Kwm`8a#0c*gq;LhOl=>D$* z3*dZkZ*VVgJNo}E;Jx6*U;%6eL*TdA0lom<3H}B=56l8tOK=`|Aov;ffPVsS0VPlb z;zRHvVC@FK#U}6@@GbC7@D1=$@H+5xkO!xNV}P6~Aif2z0*?W!!99Wa8vFNyi zfY=7Uj}72^;ML$&;A!Bg;3?ota0WOL+zosOJAj-y_)>5HTnUE2N#I2AS?cF%a5*>~ zNPT@5o50V(e}I1lKLBzTfxWaSGwQKlI5>vAy5S2Ct890y0|pp!d`viW;2Su6Kb(j- zx6PJHeFW#vgf_cWN7k$xn;6@$#tyBEa|KpPvO{^KTCPv7n>b6^le$K1ipz2?i%lumed>?uRG7k{a%%+NckZxC9mb~o zBC+#XR?T}7N}rL0Dm<`36OtMkGZoR3IWAD|?I)w9j+5MY_BCZ31~h8oCyc})bmUHV@J79gK9Vn#n~fIEv2={^ z&2S_WVgLh0|}AeB0k1EsR$F0=S3%SF8F%WFLTNjSFg zjKB$A%5OyYp_Hk47>}2xIO=;iNVQU{=w*?*F4RJ8g2&zuN0ll&C4`c@3bcC8HU-Mq6jI(C?j7pA}S0ds3S+2xjW){;)$mHmj zFi6$RS;Y|_1hNxS>7mSAQ+gmXlawAPw9Bh^PUUbe>np2U^vWp(HIx8Oh z-oZ`O?mIEt$8@g#-?+q`7CM}L>=Kj_*y@#lu7&?cX=AkPt#*pc3Hi>O4ez0JdNL=i z{}FolYr*q?_!1ZbKSB5Y2k;E=bRfP29tggV{{1fSPVhIN0v-ZxfsfY$;pg*&r+r?b zb`dG&1pk7N@3T2~s!oDiz_9RWt(2XZ)M0^7p?ptG{_=!Se!Ot8kARG3e zc1~Ji+HG*NYPlgPo-S|;H*~c!M>WYUncSOcu*&72c)Anz)f=rg+wgHaEvD|pLZzw? zU&G6@n83|*cdO!HYzf#Eoaz$V^c8AT(k_D~iFvhlP#@r{%*G;OZhhG_Vm^oWV-0C~ zm&xJ3c=Kz|QLogwS6e;7H@|jD)CyDZfrQDS_R%)wRO>LoiEkw~C{c|3ImgrzC35-l z7l_|5C+89{v0>0GUB;Ulzv|J7yErd@0udEttg#gP+blIF<<-Pj_Jii<;OE* zTYB)gOIQ4wmQyr}tfO-;t@d>wmj}HCz{;iWx3x%CY8;1Ns2AxP#CN?~GazlhSjNKy zg!v>oLNH8J*0%EEp(R#(5E=@biC)jkS!P*^Y3$g#=MQ^5$=$Dda;G6l)Xc<&181Vv zr`6J&`dO=R-X#6M^36XP`sL7ED;zRwrDF>$Zx3BRNQ>&qM&>3Oqm*2UlHa2-sTsV4 zhDp?PqKb)e)fUW)(ZV9(rC3gjbEJ(2?%Ox5{GkG;7T>S&OdL?PE^W+q=G{eCRhwLL z8_^WpW}jCvq)5vydp{jX8V@~=g>Z(R5H>7Z48<32KYgvvVtB8K>TT8CbV`TYV$GGq zh2DK`OGd!9*UhDu$vnLSnIu~fm&ByuJtn5NM|b5ZJd#7g`r=Wu;PR-~OQ|3B3~y~V zj^G>LyeZ^0r2BXT#cMS>jMC-Bqc4gS>O*XEpo05cm>${ujYDU>7(Zd%<1D{97elDy(|!Hi{V$AdOk{7r(oYgK6IJA5_26Q~Eora*S4D6;7e8mchS6sMiKa5a zGs9XlB$-Enq6Nw>Ev;p?SaF6Mc7NDv^3fwl2nhNTdXrGarS&MP(4o+7;S;Ml7(04i z%4mamf7b?-E(Kyx&@Og3MP4h`n5Z3-2lj&lvlNCaR9M7eF)!9^EFD2v*TnHtY5zE0SF3pzOQ^@h8Pnj*lV+LZ!i6<;T8zlFUcYqeXpqdk%k z9!O-*J}Df$-=g-@P$O?zvDEr@^n7E+5G{QvOH~S$CZvaIZwC>)t+MP*{Gc^vyiLlK zzOAUN=NS7A%qkO-+e2^LOtPu(RNR}m!&c1b6*7)dX$DuTP;5He@Jm+uEdMbqDsavKsO7v5$+x1IHjhi%M66-hBqT5}+A&c%E@q#s^>-mzDDs}~xag$VB z*51hp+ixYCIh{o@mAev`BHw}C%8+Rzr@tJ9NEK2sxxW#-Vh7qDRxiszHd85kWzb0a zA(@0IZEu1lL%I4ScNraF&{+rFq4a?58q4)Ksi>S+r%yq>+b1X@WBv>WlZvK;RCA3| z(=x%x6{MniN4KO=g`>Oiki;F@H|joJ-g36u6??>t;f&`(r7$uXu#vF6>p2MSG9Xdu zkoo_2qOAT-bXN5L?M89^7xaC*|Nk<+KLFf@zW*Aq0OrA|;G5|CF9MGTviAQHup4+l z>;UfrRd4{D3GM|xjo$w>@Kmr7{2HDAW*}<-UICs6)`0J#?|&1#6g(PS1daipM&}nB zz+P})a363hI={^QPlF-gf!omcKLVOy0;~hSLf^j`$oT<}1m^=;tN#`BeK|uw&H~&4 z?g!-jfLDUYf-As-z*o`t{~9cSmEb`@c=t*06!1~d0dpX9iG<393E-gqCf|c^cJcSl zi#F`swVt|Lo6`>?2SwQ!v7eH-a#WY^E14xmizR`ZeRN;+giwkWzVo8>o-90KQEsD! z>u|LMLF?hsnE~A{h$dxamFc`Rf7396d3dKgh$&tMtBWq3Onlc3Gso+k$hLD=e&3#{ zO&sqwjwyTGlZRgTN%+8fNg<$M^NzjVdEVMlDJ-O`Ia)K9O;K8vCNut#lks$U;grNp z<54EQ50gqZ#)XOQ zmw39k5W~Nf~>@rw+DMzlr2*6-H zAZvI*M!|_ATWWNn-+7XVNk;i{b5|U@%ddv_lyULGQ}3cqtx~GA566)1ltil=R@p$+ znCql2=!xnY1Sf+SWy8tCeqBn{4BOJCRfWxfPgni0rQ)va&tef-kD4)|GPSgvlWFg- zX+?MBa9O2wWUwhK>(XSfDV}m|gLanIg{*9+?1(gLMZb9SA8J=p6FQ@4LsK2?DqOYR= zPZ_24XXyKX1Kt7T9KZ{}NkI1gKM@=O;s@~F;A`mm*8$P{cY%LL$A2Rj19BeVJ;2-0 z^ACgnL9hRB@H=o5cs4(r?M#TNUT2!q!qvQNPr=NtQ zR@T0dOaU1VPM4m{H@jAo$7{Q^P)^R1zR1a@y7~(6Xy`*NQP|FLY;h`P* zXk&!0Ee^HkSg_20sr6=gp;Km`W@&KDY8)Ogvl{HK!6}SqJ?aSe8E&U@umK~M!a%4` zW}p$M@TfsvDE*Hb9MMeqnqnrgYJ@+3r059Cnr4x|{l*so;z(%QM-t2$M*=0;4;&0r zR1Pw734}6n<~f#C){9c##^w|jxsUo`m!&0@W2c#7z_6C`8Aa%RtkgD>dj8|UPH-%^6Zj%}{=2~@umOAvegB`qN5PHYMc@kX7$CNQ zUt;Ja{}f7u*?q4Ew-S!R25j zI2Fj*fj1eO!A3ss3%-Gk;OpRn;7`H%;Aikm>;^9dF9E{C1(1FP;^^qvBlS^vwUySd z*}rec)V4jL&NhgVd2Zc};tkgt)w18l1BndS8Gn(({nl&qUS@Gss zF_xH=8iqN(^@ucV`;tc9s@~G8Bqrg%)e<|9fPB9LvMFnJp7saMMe$U#BE?9X&P8kY z7(5qk%76G=Tr%^t&z8Zn&NPxgV9s?8vWFwF)uoGEM_JbsBQL4RVi`-|R=C^B^yb!G zLf2ZLa7PwX{?uYerNr-TG~L-tEu%uCRf+FL{MIW2&0r{qlsh7T@x30vn}AD!=D~wJ7hs zu4`a+9x;8W;YGYv$7NR+5ptt1i;gHi@k)7Y+H$k29?eh))zj7oGGR1ui4g8yV=FJa z&Myf%DR#-LdOkp_TTmO#!*-)`Ps`iUI&$ksTA{M!1Y5nM?}h>OV>wg%p6a!{Su|I1 zx+L{gs4>4a=F#!_{R{g}{k`Xt5dv`_&cx=V{Nbgjf8}=_QaAVv?qRmlH~GTdpynMC z#P%7GpmGwi(s|0aF})SunpyP&`z!KrBK&kBlB1N_lu%M`c_TY^ZQimyKecbiuDz6l z|J+uuAKy{;ad6_2Ad& z{T~KT0gnNv0r3HNXYgrk0at?y!3yvbYytlUWFNru!A>AP0Kbks;4R?I;2A*d1SbLU z1NaJ10drtGxHmW!ybPOwtP{8l$T@)G5Ae?5PT;?=3H%Ja4ZIaR7sxt-XM+pC6cC%i zr@>9&{XqN$J|8>+d=2}+HQ>qMNnj_Cbp|Jc&tW5Y8OVbPunveH|F2*xxD|XETnnxN zj{_%z`++aRXYn5({C*_Z4MxGcu^Wj00DFlAtx(l_z1{Ei_DJMsMH(De319DZnNJSVh`Z7fv2kS$OmY?jBb7o^ z z32#(it>*95mQ`G)vwE^=Q}RaINFs^W=0|f3y5)Tq_7y*>Q!sv0#g=5_hNIe;j5v+E z3>(wGlNK@JtWci-VW@A>>GQTzjxP-d+`K(0W#}l1RWveJiW~E??3GO!;7n$27GZrZbL_r7hrcAh8v%5sT6#6tZrBCaZrsVye&)SC*=@deSNW-5ow z>Wtp$abQ77E!B{5g*aF=$&Lpl(~Cn2^Rg-gwMEhC7uy@L+;DkBTlA&^F7mc(O4@is zlSw6+E2B$52cjtW#wk}-W@Ds0)tv3nm9^#Y4Xv`t(Il2ARaPn5xnai1oj}@q2s?~E zWiZ!3TdXkG@z)<%KGi84WMyYAm-Q)4ST4zpl`c8;gFhklPiz~RClvf7wB9GJ$6k(& z+p0T~v>dqdeb(d!$#7;o=o%6fQeti|Ezip_>=djuHu9H|`BF zGpbJ**9(|Ln`eSFrp&rD>&62v+d%rW5381qsMmUSZ;G?e<+FzctlO0DCEEm3ZDW~i z`PnUG2%+7{gNJ{VhJ59DI9&|0@-SKWymaaN zzi7rE1mFJe81dakwUnkx{45<_h6c+3E^JzJN%PVLjTcC2Vm!Pe@m z-cEXkfW@}K3_;FDV2mnWx{P7gvDb=CUYRRu2Uo2tuU@a#b+t=&^)2hUm=RVJ!pi?2 z>TK?kWBB9j|Nl6;{?oul@GJEDUxIIeSAsk^1<2n2zW|R04**|6xBp8}1!sXr0NL|D z0zB|=@CEez=K}Hn|48r<@EvsgHv!oTa0R#zxHtF|`u$&m*8HC-et z1~;l~Nh&voTOL}gT7VA4qJ~VD+wIos8q46z&2Ac!2$%g=A<9*8`!5JUD-D3b*v5M(7A-X zRT#ZYB`{R_gZ6QtaIir3o#}G3omH4Q>nWO_94D8YpE7dT!pRoepu*3|nkkOjqM33lCDW?7 z1f(wIY(^?qyqMAlHR@S2;Pl_lr<93r< zBud!&_6P=VhDb5ES=aDP-N3S8J=kff1q$JKXT-;oNJ?~LqNp=x#i++Lx1RbLK6NKw zPE85xzeq^;)NLh#cGsY)89yMCLp013e%p#<}mAsn>l2P$ug|u{&}m~0&TN)KYi{ifpMQCeotUQV)(=daKL8*FMrIo_zz=6 zg`CupH{QV2XhIHEb)U&gwQSGNgo{y=EY_+vhuX&6mI)O{S%`)(_EBNid}q4KwuJ7) zr7?7;EjCkp$2AXkJz_CsJjXnfg>Zh2+Dy!TIc6#o`6c`LQXcm6h%vG58geoytrR&5 zxZbFj8R$~t^ov~sECC3%BvbMaEqY|3Q8kL+nJjo^|nwzG99(ZDM1TA=lrd_shKhx!_*lr|A1K@Bcy|bN(lRPoeYw6)1y;gFgZP zf{uSJcp6v)VgtAx9bbI^-wZwjUJsrHYG5xo1Kbz<9G(Ab;0Ewoa1|(mi@-y{?dbjg z0Nx0m0SkU;Pc=`UjVel;0y@II22Eb90*zT0JTYQ)yklXPm!pxR|^wzRSHKn{?QfsuPg52KvbXPb$x`?M@b-#6{s z1ba3iKZczQV1Cig5BLjUyrG$O^L>-hIq0Ni=0l|4&Q_Fw47^p)8R!LDYJ>)Xa!0L1 zP<}|qJoQ0->a(IgaRL6cE^+Rn6Lq;bFlQWL@Gw)m?p~*GUCif z-T>+gM@Oi@_^)29*y=I#%r{%CnjqLbvZp?Dt)F>@~kSPc)Hn1F5K17W28LhjC)6DCyhr^Da3Od$Gxypj<9%ExVZih4G zE1v1tOx{4c7`udZvhKi)X!49*L{l-FRhgRR9<%;-@JFX_$9&4hA=1Sa;)=fI%`?_& zBc;_!ts-g>{kLZA4Ca40!k*YpsVu#loZ^k|WzmjQdU2`A(92&~gUlyg32~=uV#rin zn65Qyv!A$h}U>$xBojO4dZRwtB6) zMraD#TvRg1zxsqt>JuxQq>JeA*IF;=1H&wu95*J8aEOo$@DjG6)JvN5NXNvB#85ovMKj|2*fnS^UMJLPdVt#|>64H_$APUcSGv{dqJ-5G1g z%M)&f@Xr^61n$}S2Fo?4RK!-2g*`IqsWQ7KK23OF%-iv4I>MI_-P(!ciGNpaaEv-KuM#Ng_~0XeLi`# zwQlN^u1N>Y%uuljKW*;5LlMmEjZT&6sIpIn!*K8XC{2+jY*=3gz4^5Ld!mJm5 z^JNKL9XoQR*1#HE#XG~O&O=RN>1OY<#=O|lDbz-^I5NYXNE)T8b1{U{lLc4I>{VjF zBZ=tgzoZ~SWcZ3nKen^dhW^KSDuvh(w56EjMTB`N=*dcNQg>>c#T+wD*)G>OLR_4p zmc8~&vs^xc%Qq{To{VF7VN^+r)`Vvp)gJX^g6T75rX@V7Nnl>_yvlKUD6LlOfHnnb z!?kiD^VCPs`P!*g(f_9y*L>g@{-FQw=R>adp!2^NoCod?zKXuz0cQYN>;HD}1aLC= z96J6%Aank|Lyvz0cog_AboQ5n3&Ho$&&8kr%fZXQpMopF9~p*MbXytnnWLzd@J(GWZhsB6uE<_5C}+{lUrL+vxS*0xtnC28-Yl@DT7|@FVp6 zAA;9{GI$911^WH1;FI9p;5DEOwt;hioDFz3xG%U5xHq^L_$0c&tQmM35T60RL;wFR zcsHnm)!-NKSor*Y;q`JaC6(wUTbbsMeHAjT+7?CpJSZ>(1GK zBdK*o*P*t}h^>{87JA z=If$#*B55pagn?>+l7vMixHuyG;Zc{tJ;~K4hN&7)IK(qe$)y-RO<<34W~?Es@Y|w zcnwa_ydG`9GzC7Q7A!qh=$TiXJuJyk5i-;&l@?O%8R~&hg;^7BohT?~ zw$zva7-g{hUWk>VPc#xxlPq;hNugBiA%$}lKmbAfQT zv$$wt*M#Eszjs%BI(tpF(R8qi#-@Y0W3D3ez>$3A zeq*}({&X=uyxh0pV|lvTtKeCDu~O>5QnNtC%$+3~ud+$=idLsO(_vjzrE#cID&v=C zg$xhcbBC)~r>ZmNUZGZN)GK%_MrpPttQC*TX|AOIU11cbP*k#!)MX8Vn_|S8n3(X2 za3%|lTJvtsRY-DJZ9`g>WkXm-W- zN}r_TEMze$GgDt1c)C{v8@NWQ<@)5A8`Q+cX}Rz^8*aP3>ds9&w(ZW#e#5;gxSC?O z4ms(3GL~pF6Tu>fd&>oJt){;2+Mqusc$>6^WUAb3 zw0H&Yz<^1DS;=F8qm8+*fe3oLjJ;%svX?9^rM*@_29nxtEfh;jYk-w6bDC;;Gp+Wo z2n*F&N_JM@Kz7C03f$82SN)kT@=e;c+@`*GhEVVqnOK3lWB%fF6hVk4*Hc6T3e8K1 zF}r`5h z{g|{P5l`n8sk60Cc5OP=iLd=_eDK;-=Z{tCPR zTn8#(FW3X_3QhoD$CmIlAbte5gS!CnCHPX%0egY04-j91UjWwt@h5l!5I=%12QBa@ za0(FH!RLUi54Z|k0UiT9ApQV;0p1R-29E@?KHwH?11|?J1N*^c;Njp{@MZM>7lEt6 zv%q=ac5DD|1|{$?a0~js_zt`tyab3%K=u+$f%}2)!~a`>)Wb)lF0x%(PRvGWV~7s9 z0Ag*F;}ywQUsskIq7vzGAF^yF2Xt~d{ow`L?n-8oWPxT7U)?y}n=oMw1&*;i6BS9x z`ll+Wz2gz(E$j^?LJ}j}_<>V+fSm1DZU|0@>CKn{^x7$Jn)6yq;uxQyFpJNMVkq|t z)8^}pS>kJkW#ihw$GRi7IP>nGsmz))lg4G?ZNoTI@>n9QbW=O3D^wYumk#S?zHBbl zq?9V0BOz8l*{{IjkanjfYt5C9eSdv&I3ehlz{O6pDeLf6LV8V+x^GsZl8BoLDYB(jWmLqh~=veK|ADAq|N+%>aQyEQVb(i&H}m{vG2JzeD6D7H#2 zV``OM|JmAY&rp`R#-s#yBbL6E*4U&)FKW?>i4YB9v%rWYX>{jc9(XyE1&5p^gi{ZK zaLuG}>Ol~$UP(w#J#fM$rB{~+LAXLvIQ1Y1C)vi9S3L;ADdR&NU(^FXoH7{3rKcVY zNF-FRC~Z@m-80i79Xws%Vx{2WP9tmuRu(JYo`FzOT+^ZYck!LBd;+jYU*>|u=Y?{k zuWypFwvCvSy(SAw=~xHVq2_W@1+w2T!L$iGgZE})sGLfKR3b0nNbJZ{KbA7hM#5@y ztxZ>3YP*6c^XQfIz{(bNPN6bB>H4&5fpra*vFsP>v$BIASfK0IC$3QDc-Q;C z&8Y}}bxu>Ct{}7;cnu3oUPc(G_oxL=iAGUED`T*{sRty|t5;hw(62zX@Hx6oXVhz! zW%H@~#_HL7rUvjcb!`4j0~x7sG#C8>=Pl;R3r?23s&_h+P+@XjmSZ!-6HH>J10-E? z=JK0{B83}~mxH~%5Br$?E^}P=JHx^m|GP~6*dN%E{I9`&H8r(nvX*%r8{|MqQDgoD z<1~g69ApA}=4qIC&_SvSj4Z328r{l_UhY0G{Z39C48>kon0knr!gN2KPTe=Tvc&6lo}mY59_u=6g@d*GYg2FYcwlIWX`DS%{DpjJfK-bUE79pmQGv8 zmTWcLkf-*+GC$S4gEtb})G=TQQFThRI60$v4P2`&XEfsdo>9|l)~72pJLJopIu{IkIY;3V*6^mftbpAVh@M!`4G z+g}7kkKYFF4?ct5{$kJuEzkt3zz@*fUkzr!YVb4k_78$*fE{2vxEJ^dI{W*2F zHE;rcLA3={l1jda%|7Cb8e0`qqHrq8QNjFEj=@|mkNTtCA4b#pVOqWHS zEO6?Znv$G8+@(yitkj%MoKxM2yw)1%osPa41kpKiKHOBb#eqF~1uA1HaZ6TYyS}U= zqm$Ap$y|my7cp{9oSZ)dwM~!tZ(^b*v9t<;_2J44&7e}hDMgsgbeniY`~TWI^C-!x z`i|GcB)BU^qln9!U^CTB^)S-|2s0TLafHz@APk^_R(h$Psh+N?-fDV!JSu9`h*5Ji zi6llPDnd9RV2+4E(Sybu&55#@sN^IjZc(G4f_ls*`TTx&dG~Eq)!h%xA6@Y6s;Ro` z@7{Os{jFCHZO#Xke@5r!``!4RnTnc3V33>dN?T+`Di!mHrIdplb5Od)KZyR7q*2hgvrc9L>CoX4JnK8o7p0aodUklC zsKS5xYR9TZ4UlUd8x+Npjl+ppv3iZ4dQ&fUG&Ruz{$U_)&caZ3YP! zC{sJuz4vLVN$9Dd8I7`ifQ+5-IAg56?~~CaOlBOYMq>v+#&T9}dm6Ap3f*;Ct!2}d z_1Nv_vmH7962M_*c_iN3ofx~crno20FZxKqo#~BiS<{n#d(#PFyy}FToJY%Ve6-EX z*d!SV&9!Ojlr6G^mP9O=4BhI2qr_Zy49YAvE!C_^i&W2LiQ1$xE4L4Nw3b)qt_b3& zojul;SSEJ=oq?SbE)M$!Cn(ZTyomZa5MgudjfEj`LM5)l((957wOk{Y&nCMIhIxT{ zC^A<<@};i^Q9K*3>-;AFJ<)=--JAifQbL^p0^Nx*>JteYm8N<=aARE;Razpg^$p;n zUJfQ(as*+bJt%9|>6}COw1B7`rP8ty`1{8ciK6pt@^Yo}>b6u@VkJU?a6(%n(`~bB z_gohi%-OLsj)2vxvqVVd7p2aGnWmy#GsngSx*s3hMU;ljR3fEm$(|;h5|@QtXpK!W zUk;5mXVk@6d{>mE(70+;WCH<2#8WcTISD9X)|az{^YEe@`ifH)>sf{Whc&NUw}C(K|G&+fygml6 zKM&?W75pnazUckM_y2L=4tV^}gV%wb;C>2u54Z&E1CIjtz~BEqm;wzTvHpGvZ+|1W z61)+d3C;kggQtRHz}@iscY;@eSAt2f3p^S;3W#rj==E;`F9qAcR&W&fRq!j|m%&Hj z{ciN`k?tYP+JQh-HY<|}Pus3Y;&k^CZg~+^wgl7@2P19)fQOE3 zkkX1&%m3~rvMmW_AriFI*J38mx@GQZ9!GwAkOa-Psr@{?1j#JZb@!twG^ZG&vGmD; z6s{fm-nZu_HI#7K_}E;;BUXB-Dgo@+S4G&!2+v}|KyzOSLeq3D?l<0T&NX(5t!~T~ zs$$jg4kB9l4s~zT;+B)RX>(|G!*GVd4>5w;M8;~`X$tY~S#r*_7h6S_d3i1M2btTmM{M3el4eXhGz4XGI!!Os zrfpq9W8LUP!XfK9GPh}_A@VPKrd;A5oh4UWv&}P$ti9PIf3qNeIs5fUrQ*7p`>qR0 zEt-;Lq!t+;e?0u1MWo|3bMr>gMa&CKji>O3iG2w0d_OQXLwJ!H^X89_1%)_Cdve*S zsk+9kQo$j#PbtBwQ;V_-mPpjy5wV~oeX_VgL560}*kuw!hSKJ{=u0$=O`tfz>a(yl#*Ib$VO2ZHjJ8|qXhA2Oc1g8F+EY{>-Eph? zH=1E_Qes6|Xt0?IQH17EbtUvEXJguho!3#>OPWDI4H(NIOdhr-Kb*v z+vBfWx~;KAxK0MnlJ0TOTWzFoB2*BUP#!Lk8`Ye%sarNZ15~qqWg^HZt(!t&bCXeO zA=IXE6bZ;LayIoW98uT8gso-y6D^PM@iyx$T$JeJx;ycgeSFH%J1>7`#Bzum?~ny+ zerC`TKEiI;9+EL)rl}e;-hc{*DNbljajOf%Kc6AWBYXT^+Q85amRVKQFxPu(#{QT_ zeo@UEeTp{r|Ic9^fAEKxKNbqC$|NFtefvb=bydH?}|1W`C;O7@W4SW@z{aWDe^LrwnKL;I!mhTdJuK8t_ zm{_|m+(XeaVr6Q$7mKYf5&T3ABbQ8@^VUuy|5|FIh}EB57=8P@7c{aF$fVOW&Mr|H ztE6$RTC>aP4^{sjjE;P)>(Gk4thKgMkrriM@ucR!K0Df7l1DemM7W0}l{a}(-=h}N z60vF@=U_O8T6DIA{ge;qn~0x$EI9m!A`v;jW)J@9gS%;q($~dgj;d~XO>iOZ%QS;i z-U4Y=9eN6yY{ffi5DetStkdhUXmjL zk@PT(a}A5Q!djlR6!+yM+RT^o=4qT(f=Z2k8?}{aN|txoSzRP-(>A+9rqa2k%$7-s`^=V_N@sY^ux7u} zrc#;>QROQUFG_UVHHSaGSb?SZ%J^Fw+1G~YG)=9=LY!LUEY@iDA`7%|7r=yCNoBJm>Usj_O#Z_m2^o@wQ(7d`bRb}@oQ;XGBiF(0?`c;io zT+Q+BamuTP?|e-Ov+&@6m+DUNOI!&onpt~-(u(I)Qs%spoaT^fdt!ym;VIeBq(Igg z5`g(7;>wD&SB0tW$Djl5D|siq>N#qvEm5g=XTXn<;vUhB%HU+y0<&w;Aop0i z%zTx44X6^cIuXe%AH}~5CX4ALZopO+A+scEohYs&z5%PNO%*XFD|H;<^xzb{#_`E0 zcqIm5LcuHg|0;ayRU7yN|9>%W^7;sT{#(Hdzy|OWc>BA-+rjg}gYfiU0q+HuffK;@ z;OoVw|0CcQ&;rMUe}LD@iSzeVa16K$UjIsP1dM|Jg3tdtxDJRP|A|0s{vQDz4vqri!+#t26Y$4C==%;Z z_$y|$(hLEy)bZ;@SX`2<|G495m6X}L%0+)`hL}hZctXOj*Y}%iqE(HGguWt&7fg>1b158pY|BoYbCDjHlSYQFWm_VNIbe>|G+Q{Fty|P;iV+|tL0N03 z+uM{rDfu>I%v>mm8#Z((tVTLGf#vQD!NPBJq=W z1>!0G^` z*&b4@jLmwr+dYe5zFi5$he7~LFB2$6W5$c`p1K(jsvJi{@c=B59Cjcg_sX(!p%6cK zJYmICd8=s)9ARV-0$J&>5yOZag)4l#${^-8b;X#-zkZR{m9-kUIl#=C#Cj8haZ6N{ zXF4@a!>WT^dpyq}m$WixvSQI@8;1}A9LoHV6e_thGn5m+Dif88W@%+}YOP=DSIr)Vr+g;Q{OW$4gy@0xT^bOl+ zrGtUOEw@dX{(50l+S)J9Zs)7xwCyP_>~@3O#w*F*X8yIwUbkT^HjHdOaT)L`g!Ac} zX|_D?w5=kn_v0ZOn{hP2#y@pmO{t>#5sm+ME(feTH}D7k|1#d>bvHc!T|jIA&H*9= z_!@lwSHU~MKJZxZJ^23bf@{EQf$0063VsCN{{XlNh~EEY;MalN|92&LBRCs82OJIL z-oNX>wcrEb3h*j$3OE^@1daxe2cJeZ@HgO1;7YI;oCh8TZbdfmXW&wBERcHuzX)yt zhruOaJNOCw|3846!7{i6JR67|z(0Yj!7IRSa6I@na)7IW#QA#xcn~>&*aAq5zw3a+ z{l5Y{8=L}82KONcxEDywKe79N0eC*x295zw0YdjXg!U!9$~oSRxO1|yoov`5rE8+? zn6}SL_&r}owS!h%o-2Xoyn$k15!-am3b`U^Bdap^hW3zLU!Xnm$Xf0?l8y1im}SLj&)}csx%hG z;GQG0yej$^qXUE_vbxgfRyC*3q{bf2mUhd~SPE~SgLevzh5 zgitywVIx*tv^a343)d5jo8oIITgyoo-jg6c09iR5%hIh+?WOiSTYKM8!$d<)k7dz5 zZ*coipoAt4@U&jp4&%|cT9FC#KFeK zqA?4{0kM{W4{gr7quhd+Sd1^1$%`fRIoTkxl2}gyAkW; z0D1t~{#GM1%E{xlHDer-GD=|qbQkBjbWFym>MYDAtL^dnUKHL03?Klb`#S#CF8Xu##o5c*JnMI(hl{gCe&+m^uj!qVj&??agpi&L(%J` z1mvOVa!wt;i2gRGs*xJ}5eWxd0v^+2^*o30(iGnrSV zPZ`0gl~cxWv{~{yE-6)3=0JEtVbWAi`Df7hsre)7g&DM5DlVutT~={H+WbLENfjZU zpmAFUX-Y^&=}k~VFB(?SDQVc`B-fHh#|vU{#LyHs5KV}AO%*}OG-FM$`3T+o$$1&m zfHlNMf;X2B^Z5) z4=}(~P7^aIp;tQwpFf%DBjGm^)5lJrK^~X5^FhaDK2FTcZ=Z~ppGust=u_D7R0+L0 zp3m;eEXquyRL^G?*7)G~o&{`;dyZ=%x}A$>4&X1kIm0}dNSS447gb@QuPd? zr?4#v`oG%U2M()eDTWpWQ*sU4Pf%&z-ZRJ(3lYM$r;5>r=eBzdkL+3}ZqV!Of<4%A zA<^e-A;sPPf3xO?gC-paHjm=g7YXV^43MUKnu~hMA(8O}=k#ZYIB1$QXcG?a(hW~A}0$sTFRvSTkNYO4%mpq0h?8>B$9Lz(nNkk_B}tg z--l8Z{iun{rTTx^<;tst--Z8wk!5=CgWtawd>p(S{3iGry#CGL5I7ZlA6{Sl{r?`^ z25tg3f=O^JI0}3W{$K6@m;yV&k3&90IYyiYx;7j0- zfW!nm6I6i20qBCuz%#%XkRQAO>;`fNzHD9~ z=kGw@o55><(E18sUS=Bk5J$}1tO=X-p5=5U;@XPKA`eNg^ue>_^T^&hKpsiv^B~je zl||QcCtkE_d9@g*lTo5KNjv3T3YB*o&BR+ z*<9f_iS*`yNPJ}4z|Bx8};qn9~*; zx|8Mj&=Y8)(7s(Ke>qlh$1%~dbPN3v3(fUP(!Yxh?&gxm@EaihBC?5Eyy=Gss3qG)%b za_0NdVKZ)NZ5nly9S0-Q2zd`5R934=L5I#4_tVYb>P7S{L zl;D7qoMcN&4_2y8)8bRTkjH10y@<1}s26FO)u6qwyqh^7d7IEJjkztDg>KCehKMA^ z-nS;FYN4RB_B7X5u)}(a^TA9A(f^;ya{H&kkHY_7$eXx3orqm0`7q4e?O2IfG-8k7vPKV{WpVY5P>hk>t7450d;T^xDWpRcJMB6 z2z0@I@FK7sJOHnMJ?Mbrz&-HzZw6<9&ERR^F8KP}f!O-*0umSCdhj;zT5vJg4dm{> z2jK1h1Bk8vB|vQb{~P}P6X4^Z3r4|r;PF2N-VKE3KN?6}{|fj5y!|YAEch8T{64r3 zdwZLTZ+`lb0Gvu#&g-$V8mQB{Itjz+?bnz)W;ij}u5S2jvBWJWgT7cgbB zM~AZ}B>-Y%Nn|3wWZW)sGcm@?V>588lgp6=NE4AQ6vi~J#6~(&RosWn8W0lEK4;J} zc+!}6C*&mZCFVUtVS0o%Qh8i9p(~;=ciJJZ)uI9X*&HPW{5=aD3HE#>re?IY&Q>eA z07+x|yap~SY*O68yl+RcPj+03$o|BBb;vw93$llIm*jzWcTn+96%b~Q0NM2`tljMz zX8nY$Li?VtO8jfa0zt>6=dd`@UQCN{T=N81h?6}Gq}?0b_L=aU@4(?LwU@@` z{cSnftD1GAkeg*BFzmc_c&Wj03i-7vy{FxK!f1>K^@O1f^X@vs#RDDO;_QOMb}kL2 z!INkYO-bxxe%ss!i1?a1LV*n!vdGf zOUuYUv*47Oa(}eH%gq!OO$?ho)yz@fUBCZE<2C`ij-y4Vz0*=B8Y6fHsxZS~ai3dv zo{Kj~*g}icnA~Y9>5OaS0@t@xlhfB$yQa6bVLM8iZuVJ{ht(`58mr1)RYZK6g{HW` z$QZQCsnMVEs8XChQ@syosR%r53u;6jZ%lNV=rYJt9q|ukZg3b<(Z$;TxMkzuVV>`t zRR={o!oV}jcvWoR!0@;>J2uY^gecCNM>I$VaZc=1LIf_Zry*UqOkqYYO}Ed6nN=pX z2J_s_MiYy}RmLM5yw2IZclU*7{Z@3|`Fk$fckzY0qv!59>zuvkU$k$}*%wi7SsfMr z|77^_Hv{4SVej?zBR)I;?g4KDd%;oQ8}Rra1_!{?z@6~;!s~azCZOfmGS=VLDX>m~ zbqcIgV4VW%6j-OgItA7#uug$>3KUWxV1LZVYSyY~$XHp5l%?7f1JmIl3<$W;x<1xg zL?Vg&%-c`$&w&aMP4n=HRrIQ+0I}ut7Mduaj3P#bDq$0=)GoFga+`Ll;{K(XfjO*foEwJ`$mz0PA#}IqZ^B{;kC4s8g{$$hz!v9}| z9{WS+xkLZ|kHYJ}0bB^43BG6f{#WyU1$Y%W8ARZj;Op@IH-HW}4g4qagnPgz!R_D> zxD-4Zd<|XyN5ETv=>A^@o(MjJj{miw1&#whK*xU@kQjfLf=%FFbo}oF^I#V^3P^lE zxeMUs;9T$w@FVp5e+S+H4uX?`#Qpylbo?I#9{>{jUv&P*fP3lx?ciphv?yGp)_+*1 zz&Ztfp%gG{Td41J=CDKaXqZmd8{j3%uCXN6dwYiFBDW^m*v&(S3ez6Sq~)rGf^xf= zv~z`N=Zx-qN9=0m8@^bWiL04yhhz1)&(@>Atrhe)leR~HGiiJDx3#JcyBg%gnne-+j7OQ?rRQ8J^&iHAGQqgIntRq7*BLAktE+S1T(-_dF 0) then used = send_data (id_wetsoa_cmip, total_wetdep(:,:,nSOA) , Time, is,js) endif - + if (id_wetoa_cmip > 0) then used = send_data (id_wetoa_cmip, & total_wetdep(:,:,nomphilic) + total_wetdep(:,:,nomphobic) + & @@ -1226,7 +1226,8 @@ subroutine combined_MP_diagnostics & used = send_data ( id_n_red_wdep, total_wetdep_nred*wtmn/1000., Time, is, js) endif - endif ! (wetdep_diagnostics_desired) + + endif ! (wetdep_diagnostics_desired) !--------------------------------------------------------------------- ! total precipitation (all sources): @@ -1438,8 +1439,7 @@ subroutine combined_MP_diagnostics & do k=1,kx tca2(:,:) = tca2(:,:)*(1.0 - total_cloud_area(:,:,k)) end do - tca2 = (1. - tca2) ! Cloud Area Fraction - tca2 = 100.*tca2 ! cmip6 = Cloud Cover Percentage + tca2 = (1. - tca2) ! cmip6 = Cloud Area Fraction used = send_data (id_clt, tca2, Time, is, js) endif @@ -1473,7 +1473,6 @@ subroutine combined_MP_diagnostics & !--------------------------------------------------------------------- ! define the total and convective ice and ice water path. !--------------------------------------------------------------------- - !--> h1g, 2020-01-07, "ice_amt" in RK microphysics includes both ice and snow. ! "ice_amt" in MG, MG1.5, and MG2 only include ice. !in order to compare orange with orange, I added large-scale snow in "ice_amt". @@ -1491,7 +1490,6 @@ subroutine combined_MP_diagnostics & Time, is, js, 1) !<-- h1g, 2020-01-07 - if (query_cmip_diag_id(ID_cli)) then used = send_cmip_data_3d (ID_cli, & ! (lsc_ice + tot_conv_ice)/(1.0 + total_conv_cloud), & @@ -1700,7 +1698,7 @@ subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & intent(in) :: Physics_tendency_block type(phys_mp_exch_type), intent(in) :: Phys_mp_exch real, intent(in) :: dt -real, dimension(:,:), intent(in) :: area, lon, lat +real, dimension(:,:), intent(in) :: area, lon, lat real, dimension(:,:), intent(in) :: shflx, lhflx real, dimension(:,:), intent(in) :: land, ustar, bstar, qstar type(MP_input_type), intent(inout) :: Input_mp @@ -1774,14 +1772,14 @@ subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & Input_mp%radturbten => Phys_mp_exch%radturbten Input_mp%diff_t => Phys_mp_exch%diff_t allocate (Input_mp%tracer(ix,jx,kx, size(Physics_input_block%q,4) )) - allocate (Input_mp%tracer_orig(ix,jx,kx, size(Physics_input_block%q,4) )) - allocate (Input_mp%area (ix,jx )) ; Input_mp%area = area - allocate (Input_mp%lon (ix,jx )) ; Input_mp%lon = lon - allocate (Input_mp%lat (ix,jx )) ; Input_mp%lat = lat - allocate (Input_mp%land (ix,jx )) ; Input_mp%land = land - Input_mp%cush => Phys_mp_exch%cush - Input_mp%cbmf => Phys_mp_exch%cbmf - Input_mp%pblht => Phys_mp_exch%pbltop + allocate (Input_mp%tracer_orig(ix,jx,kx, size(Physics_input_block%q,4) )) + allocate (Input_mp%area (ix,jx )) ; Input_mp%area = area + allocate (Input_mp%lon (ix,jx )) ; Input_mp%lon = lon + allocate (Input_mp%lat (ix,jx )) ; Input_mp%lat = lat + allocate (Input_mp%land (ix,jx )) ; Input_mp%land = land + Input_mp%cush => Phys_mp_exch%cush + Input_mp%cbmf => Phys_mp_exch%cbmf + Input_mp%pblht => Phys_mp_exch%pbltop allocate (Input_mp%ustar (ix,jx )) ; Input_mp%ustar = ustar allocate (Input_mp%bstar (ix,jx )) ; Input_mp%bstar = bstar allocate (Input_mp%qstar (ix,jx )) ; Input_mp%qstar = qstar @@ -1944,17 +1942,16 @@ subroutine MP_alloc (Physics_input_block, Physics_tendency_block, & Output_mp%tdt => Physics_tendency_block%t_dt Output_mp%udt => Physics_tendency_block%u_dt Output_mp%vdt => Physics_tendency_block%v_dt - Output_mp%rdt => Physics_tendency_block%q_dt + Output_mp%rdt => Physics_tendency_block%q_dt allocate (Output_mp%rdt_init (ix,jx,kx,nt)) ; Output_mp%rdt_init = 0. allocate (Output_mp%rdt_tentative (ix,jx,kx,nt)) ; & Output_mp%rdt_tentative = 0. - Output_mp%convect => Phys_mp_exch%convect + Output_mp%convect => Phys_mp_exch%convect Output_mp%convect = .false. - allocate ( Output_mp%lprec (ix,jx)) ; Output_mp%lprec = 0. - allocate ( Output_mp%fprec (ix,jx)) ; Output_mp%fprec = 0. + allocate ( Output_mp%lprec (ix,jx)) ; Output_mp%lprec = 0. + allocate ( Output_mp%fprec (ix,jx)) ; Output_mp%fprec = 0. allocate ( Output_mp%precip (ix,jx)) ; Output_mp%precip = 0. - allocate ( Output_mp%gust_cv(ix,jx)) ; Output_mp%gust_cv = 0. - + allocate ( Output_mp%gust_cv(ix,jx)) ; Output_mp%gust_cv = 0. Output_mp%diff_t_clubb => Phys_mp_exch%diff_t_clubb Output_mp%diff_t_clubb =0. Output_mp%diff_cu_mo => Phys_mp_exch%diff_cu_mo @@ -2162,6 +2159,7 @@ subroutine MP_dealloc (Input_mp, Tend_mp, C2ls_mp, Output_mp, Removal_mp, & deallocate (Mp2uwconv%lhflx ) deallocate (Mp2uwconv%tdt_dif) deallocate (Mp2uwconv%qdt_dif) + !-------------------------------------------------------------------- end subroutine MP_dealloc @@ -2386,7 +2384,7 @@ subroutine diag_field_init ( axes, Time ) id_clivi = register_cmip_diag_field_2d ( mod_name, 'clivi', Time, & 'Ice Water Path', 'kg m-2', & - standard_name='atmosphere_mass_content_of_cloud_ice', & + standard_name='atmosphere_mass_content_of_cloud_ice', & interp_method='conserve_order1' ) endif @@ -2635,8 +2633,8 @@ subroutine diag_field_init ( axes, Time ) conv_wetdep(n) = 1. conv_wetdep_kg_m2_s(n) = 1. ! no conversion needed - else - write(outunit,'(a)') 'unsupported tracer: '//trim(tracer_name)//', units='//trim(tracer_units) + else + write(outunit,'(a)') 'unsupported tracer: '//trim(tracer_name)//' , units='//trim(tracer_units) conv_wetdep(n) = 0. conv_wetdep_kg_m2_s(n) = 0. end if diff --git a/atmos_param/physics_driver/.nfs0000000004f6a0ce00000060 b/atmos_param/physics_driver/.nfs0000000004f6a0ce00000060 deleted file mode 100644 index c2a8ea925ce3676ad3729f715f7b5dfb8500d675..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 16384 zcmeHNTZ|i586FDZ+LWrO2p)iw1d?64@#IE<;9Shw-dNdPFJ32A#ASLsb8H_nx6WlZ zTNQXf2n7&ARY^gJzEmm?DB=y3N=U8f8%QNkTIek;v?)!2LTO7|py4|+|E$-utE^Rl zc*u!_7ruo zr^f}~nHacOE=~JlW>AkDU+0nIg@)f>3bU^~;Et{mq!}7kAQwcCdo9&JK0-Yg_o846 z1uj(uHfp{fYH{xr=-<;$BN_^J-2Xp*$#9v3{KeS=E{=X34CjO=z z|7YSk@xRRRe*u%>MMgmN;+s_dRE~d| zc$4_2a{M{sec}(jb=dw>#AoqyXO4f8`0J_sg&h9};vWEPg7_@{ zUdi!~6JMqJ>u(>nf0lTI_^;*o$B57LeUNSKl#g{}JLl#D68nKb))o=^XzM z@n4|w^~;Ct|Bme4gcM*S0j(>po9`T>e@xLMd81eV!`1^_f zJn`?lBK?xhAHOC(8y{cI@ibj%S5x`tay%s$AB6&i0)+yF0)+yF0)+yF0++Y~+|snY z(BPEXXkMvl+4=w6J2mYd;4a`aa4T>Ur~rF_m$AP*1KbCE6PN`q2hL(&dj_}%2!JiX z6WD9t45&T%tJt^y2(W;60~>&sa8@`6+zs3goC0nEjsvqm1vm&C0Imf-0&E1%;S6&( z@IBxLpb1O@9|fMp`RP3HIPeSL=fIbN3h)}vZubIT2im~Zz*(FZzYiP(-U~d2^Xcut zG2lJGuW%kd2{eE!fcvrG{uVF^yokGi+khHy4mv6=znyK|Usrsw^`AiWWEhFSSm1%= z9a|VYiUQe*BQe32)5Hm63bpmkv1NN*DQs(kEe0|YhQ%X3!FnPxdbZc$wjn*k@*FN* zL%NnUML5B>j$+>Pg==)B4d(*EEh7+N#DgfSXZh8%y--lbkqj^UO(sw_@qam;LxKqw zyS8-DBD8F)7Keg$op6_GjpHF{<>R^b(q6{uPB<$f)9TjYv;jw#6RJu3v*eMSbbQ|k zJTEeQv|qiL{o`TmOt27L=JwJw*B2x8)NHd|n_y;Nn8yv*u?-OfUXYql=0|cUDPuSy zMBVjDyE3gb7^!3$7x-&VC_UG3W2Ylf`A9_}Iif~F%P_KR4^`vSi}5~M`9wI|L$ig8 zPMe%=P98R9n$;uIHKW>U9IdrhbnfboRh^u6?!b_QoxxiNW6DjHP$8m-G}yyoYpIo# z+Eq<0s4?P3DppJ{cB3T5lz~<8HE=_^evCrs!gOG$?8=N82Z3-^u-F*Ankul)lm3?~ z3b=_0A^qo+(nwpUn4;GxI%6$jXEc+RX&oAP*d7c)|G2zN;FM7VJ$k1F|;im z>768GOwWx1&tBOdsfA%WTJnXabXn(7{X}|WA`~Yk*lg2iw0sK0Ka`l%XsG=d%Hu(5h?FwMe~Au*?P<+di)J(>6iau+IZw zF_?&L5$;7=S#QkNoBLC`TtCu2(yHxeRl#kxD5E|@V1y!A;1T9C=5<-*MWBQ$g5J^r z)mMY3tW)u%sX^wVnzCG7!PPHmCY_>8}+qZc$ zN|f~#>6CN2S*g}qtUg_tN;4(q%6ghkndVxx$>z*lE>~Hnbjqc&G^Sx}P$P_$^(>vT zwQBWRt2R3ckyboqeUPrCER(3}t6s$lGGA*e18%ZrvaT06Ji=0+tny6FZz?BcBoBuF z>RCeOl51{;l~qR3ISW{_U!PHBQ90SDOw}8;>FRv)o_p1+wfV_bW3Jt3&MIC#fv`Dt z3=F$0CuCy?lm%g`FqyD<&=cE3liNbYk0snNiJu9^U5ojFFr_b}Bx$@v*4ll+VxI+A z@T7~zU?7Bj5wZyBSWY7eYs`|}Zmd?;#E|JZSRs(d@vsoYfznVtk#LgngOns+=%d1} zG+94(q$Q&zhC#rPMJa{`NH?j)@)q5!{>&@KbFkFJPGTpWB`~L`Rw%zziA5fuNjwbI z;8?>^)In~wxFt!37GJW3?Dd(&9Y5LO^a8%1JX_@GNh{!3{ns$&b;*|LVGRs@Xo~^4 z>`USpL<|>&@DqoWmxwXfQeI*+1rK_j3nfF(hW)IWDjVhmVPjUqWQq9$rGyV<$a*(c z`j%K5U4jgYUM5sX4#8N`FM}Qmu?2%2HD$p1)Z|QwHB`vo5KFi|WJ9%qTMOJZvo37+ zWvB#5Y{JCwSWxpf>+_Ixgm9T9LfLcCj~u~6JtH08mZps0T{#!JWxa{5(9uTiItt{D zDupFg4ImSpktrI+K^HrQRG5&Y@&gaM`Y;JhjNoK5k!}+Fz6cOwiFgs#dEuH8*;K5A zvG3bU>Ga3EPK5IT1Q^aU@WPHypqv#$=d^3n#&bKBdJQSKx$G0UyDiKl%jSCJh^D3v z_0(tPhnyyxh-33O7RW3t<^pd)LSEKav1*G21PDR`0|&Zm7A)l{$5TFG1X!fG>>#{6|aN&JGu_N5=!u${~4saK4t zTkWx(du{ychg%tEOudhfGhJufl8cSSz{5pEC~p*{ZR+m4T^nCzV;fq6n>BSCwntsF z;L8KX2}VTl<(BjjMYcmyAN! T|6gl&{|{TcJ8A84i(301PI1V! diff --git a/atmos_param/physics_driver/.nfs0000000004f6a0d10000005f b/atmos_param/physics_driver/.nfs0000000004f6a0d10000005f deleted file mode 100644 index 05adc832fdf43efc2ff33b700c0ea61e5c63e252..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 204800 zcmeF42Y_5xb@#`?G*be>6ax-#W#rwpw`k>pEwnbWw6cZOyjmFy!Ncs#?CwajGovXh z$zVc&P)+XyFoaI1p_(LwUIGM6hXA335;_4)fDpdlIrrZ8?tAm5?0N)zL?iuo%Dea6 zUQW5^&TqJU$FAVKi47TEx65RHx%K)7fAU2)ocPt}WHOhua+QgTTUB|~?X{RI=BAWD zw@{hP!yLiM=5lQ^*IcePvbCk74fiou&n-{N52bt~Td0>-iuJ_TiS6h2kxutq9DjPe z2L2D$K&!bhe%@^|XKgei^|WJM&kJ$?eCY{_wBa99sN7m-}l+~=O>=u zIr02QiRX8*&yU*oi)@E*^iQ$ByZZTu#Phq_=U3YITiFid;@{2wzQ?|o63_3Rc>eap z^Hc5f9rpd^w!=C4e{O$w{cmsL`917&SAWk=JP+)1SN}gqJRh>pUHk2|9onV8&OU#T zeSc!&`DyldH~znycz#d&e8s+BY6pa)zux}t#^1XW&ri3{-8^)P9WXBbuzfya-*+UQ zyWbb=^FxW}qxSdR_Wg5-=V#d8m+bp`J0M;9XWHKn+V>|Wp4;gnbFO{<--+k;=i_h3 zYv6bd9It`nHE_HJj@Q8P8aQ49f8;fgD`Ya8DC4taBMFn{_>XVF(7hYH1H2YI8$1qd z0cQi*KVA<$4xR*dgIj}tXWx1~csHnn)442ft!p{(4XVcLFyBH^2*g3%m=w z1Uw5o0~`dq!4_~Ia3MGsoC9tHz6B5SF7P+t5ZD8@f_s7Q!9RT$d=-2Yd;~laYytlZ zZ}vX$1TY8g2>u;@@CD!sa0>Ve{O3!+72q!5lkmHb13SQN!Kc|!KLu)DlDy_B0T7qhu$vtF8SHH%|G_*?M^ff||KxP7o?<+$ZC%as1 zkoNX1b6a*w9rP8`^b1UL8l`F_TWKxN7fHOYs8l(JdrY59|$OF^a z8*yreig~ngo1q|Mq|%hWlCQQZP3>bspsjyJ*(g&1$6mNKI^ zBN2MMj4f5Op35^K7|SWCqfC!z@;D`GzwMC{RZ?yCJ13;YZ%*>(n$t z+GEqlD4QAS^V((d)k?EoE&J_ZD8wH(kJgGAsh1uvX(wCXOoYWFW5Mn{*}2&*TW4l7 zJ)+8EFM1`%Fzj;#X(!VmXA{?m(pPO>mUETdB7Gq0b*7Ms$EJqtL@4uRwmqU9D>|Kq zk4;3z+|17GmbqPf_VrU(ZBv(kp}=xb&o!&{kuyehq{M1&&5A zGCnHxml>jB8%w!*u@FF_RW3F*@!RIf9lN*hxxhT$ynX-N{@Ixef^EfIIXGNuE(LUq zMzOw1-rNGnweg=ju@LKz29xfoqM)yo0$!^@7!{+38dsUPnzFt zpuMv*TlehRn+Uae(*ABkNst{oAr_?wvCWh2cN=VWX8X+S%)|g7zRRP zsn`gb{LXUPEI}f-uWf7J^n?>QG+I;ut)pB*2rKYv4bj&QloFb)=d`XPMxjIG4H5xKF zQZh;!He0i~LdjOcZ0=~eSXx{P3c2N)?r;|CxfRLT;T$blsOMPyQ;1a;EUkQ%HLy{m zZW)kaUNmD=V&ibJSknwiF6m>Hg5;9T6ggO|R;bBFwG4e%ObN!EP%Ja6F;Gy8NM5iLA$HNEvd4 zm0Tt7ns9EZ)Q}2LnvjT(1)0BtrCcMJFBU67q1Y%bR%pi@oyWFJX}MM|i;u zH&5p&gSEteXk5NvJIq z>+~_Lye8{>v63$lO!`WrRjZYcn&~g7&Ntx?sDOBwC>Q0{5#kkE)U#`5ehhE_Bk)S_WFY#bA{YTbhsXaR_#*f`cq*6&4+eJyqANQId>j7%E#Oh$ zK41jg9sCj*zz4yzz%1AVCcv%07vS?>2?}5*5IMl9;Ct}+?*J>{N-zs911Eu7f?I&^ zP^NE#Z-M^+QpWd#zCYv7Ne2H0uZZD86SC!mPBD`W##2o_ou zW#X&^wNP5lp3NpGGc-PkmzPp$!KNAnCFHHaw0S!-mYbX9R;SR_qzGox)ZhA9brsPK+w3sVA%+7jLl63{_D;u4b` zZ4e27gOTC(9XF|jF-i-;h$KCt%7C-U)^t#5jtbXPu|%oY-(P9ZI)FD+b%W2mGdxQbk?tTaL3M}N#|~X5 zZP09laT>*@u*w?(hGO*~l23+S{cs6E1ww=z5-1c7Qc)s@Fd7+?E@FsQxfyB$MH(tE z`-bl0Kw<1)VT{N@P&|SVNu*t+vEYC*^#|LtCG(P!&_DVO!B91i*oT-ZPR-TpxucTX zc|>EPqbkCcYjBx9qR6S?B&6`)mF7sPG8$%FOie?ZS`w z*-DEd;n5{gp#e3@{FuojiOx}@^%17^=`#>fdnNNo5K}5LgIcsKx+gE#SkwX|o5u9t zXh3+W$-&f!^8fE-^}7JwwebJWepdMZXMkPcmf+Ly`L6&uaCh)2`1!|!%fT(d_3-h} z06W3Wz(2sdUkBa}o(rx5S#Tw|Gx!8N{Kvt|Km%L`P6O+}H{so12@Zk@a05L1&%s+j z3!Ee0ky*S0Tn8QvX23Qey8M&D*U;gA75oEO0WGi>>;b#ME^u>jQ}8A9`(Fgl08a-y z!8&j<_yoHCcY`;8GI#*k3B(5A^XUFR3|*1#_4;-29`JbZSKvw@ z^*s$v0zW^2{DO~y_kp*8UN0F^qS>am6x?U`F25Po{K({yv>(%cOAUBr?C4l+VXU?^ zIhr97LVqi|&mqBE7YwBm>K@ZZB7DBBZR_1Od1!giMt1YwZDK%RnphFay zFS2hzE{tZT5j?Oi!sbfjLGgSMV}4y=(vShwD*@);)zQy2yV9>07mDa^5vtbe4dkox zUKQmN_Bjn$Q z_%|!!>@haYx$;7wZL9*%<=yljUmQz`6A{;vhEH+xzWo=??%6-LWA{v| z=1PqkqzO(N#EYHB`T@K$={t`g*t`FtojbM$QJMBh&;g{lUgj)nzvGMcRn0&qBYid) zaRwBli5RSKVGF9QO)#`M*dp#?LG!*Fx{umaQ$c zByaLbhM9i4YB3lxALOCd$4Gv;guMy+t8A%Yb4kXC)~w(!M?*I&ORa`{KD}$AUVREF zV-_M+YRZxEo_G0}h>CuU5zi~)B)dfBQ6l~dQ%$y|dG8+2Jxz;Wz&z)4*YdIL5&J7? z@jP22*-=ZUh!tJ4uB2C0cLmIF)>3gU-kNI7MP5^t#UjV*%T;XJyR9!9IaXP+j_1wpeReRP48u z7-yT&D>yh{I=JS>;{WRbU|&m6EL-$8FF)}W(Ll* zy}^Yr<{fH$B)n#$S*0Nxm@Tkwms`t~Mm$56X00tR`oj>+p;*{dsuMy-%3P@`9g~?h zI_YG{OpK0;+#z)0=OLq6hd(P}`BN-h7_aYwHb=R1NDLh5+7k=8as%rC5=CX~@~bU{ zhP+xU!=T%$5v_eDky?kZLqV8+keY$kVH&%#;zu6}+>dsJ3-T=)2a&ZvT1jB2>nxdZ zLiWeFtwE0*6$>IOh`ojae(X#n7PjM;At$~KjUHsvR?3x;I~J0aLvbtG3Dokz5)tM9VdpbXI)OhP|Nk*~{`Y~u1&;zpz;c!|$w1vG4LlI;45&H#^l~cZxa%W-V6Z6wIocOjl|RTm)VKv z*fqmA(;g=LWwBnQIL>g=ixdc>69#MlkSo@!*f@GIdPERTBo`>+0W;_*x-cq>+2u^8`j_DY9@TEAw(<@lXUF7f2I` z7PcwT_U;n`O-q2sDiwArwMEQ|gZb(amLMy97FJHA&w+}cg(5;x7uyM~R}oz#t2Vlu zX@yY?MwDGtfs$f3AY)eu4|KMadQi-k$ z+QV?GRsjrXOxgDA_~wtDc9WiDG{4)9xv>*|2!~sbjet@OJJeVZcFM7+V@rdbo@un^ z-Eoz)`b<#>xvt|>LnwuqxHeBl+6H6AJ~KPJ$C$b6r(oAUjyI*HvD|8yT{nAG-73}_ z&2_=Pxh-@1_f4_lPy9-5T%dg zx7YF}LD20H+UkeG+I3{(BRwSnJ;&%ySg63BZ7~P)TwWvEY*`)EcxFvbwRPQ}-m9nB z|I2Id3H*Wo-=*KstHa|z0-O)d13!VMe*j_yK(VhrkEG z!$BFG4!#X;aO^*hPZoDMNlMJ_v*Z!>KbRz=4~I~H{`2ahHV7iLL#wnTz;jkJxgmpt(bUJz-+(^~j!R}zhJ7oCo9wj9FxBK{i8jz<>DaP#GFhgDE0C)JTCsr{mr_`7q5 zt{z9EY9@kxa!fR`XH3@=39TGimo(uM>m?5GX(X!|3YAqJ@lmyH^t4VUdZEaHTobvI zu+T{9B9Y-pBxxYSgQ`H+NKz(!sl$ztPy&Lxi0Q;eiJx3&5?gIqArQ=s2Gi5(!ooTp z;fK+1&amX9AE+yi5l29KW15eTV8otQMKzmS6s;?)_aOR=seer}JP>P!g0_^TByKQ7 z0!yw{ScndHBUZQOMpLFUEgM0 zFPwzQmzobTpP^ce-I30nDFbGlR==s?#zxXKyS zKz5U+cDQzrCBcXYoLwzwAhROG{F>O=z&u7E(ea`4V>Fm1#n?o~GeSqq(pBBU^x|>e zOR^H?%2IDfjnzV^`YRfP$Ux@J(gIfZOR&7MXtIQf`xDhr1@rO%n&w9nNc=;{fRe(( zRu8HqwhDC>N>kF0$})}WZ&2xJ&5@duQi%0Htg4Dfig`R}V3BVU9#DrH&kU#p`?L0mI-|@cD8U;L%_oI8DC8=f4m%!7%t0 zeEu)Ne}mV9=YxG<2>b}1|E1tL;Mrgokn{ZF!|xH`0YG&6?}yjF8k_@u0H6Od@E71t z;1iVP@j%M71^kloeE>WM>;X3g{{~P0G>`*#1>c9C7hCE7(2AUNa+e zNtnZ&Y_rueF+8GWnIk3_78lGttZ}A2eI}jQ{xY~((bRa&s)wx2z_gQfg^g!T!7nf` z3RJ>_-z02ieR64PadOwi8?*PvC0e1ial^(98#W>$Z!~w|*~|HOOSVSk5K6si-#weL zo{Tf&!;MPyu$Tr8yY_9%7=+}+ujl72m5>PjVuac=wAcq3#6B%dGs5h&Q|Y%D9}V&}kGS=?bYaEaD#aEWKT zVu87n9r`kdYD?JsIyslyZV#|1w)W!N2WnJ!Wjip0CsrSg5koBJg9+g5mb-{4l*x&t z6n*&s@RCjlDr|yw&oK~27iL+Pr2s!+Vz#K9?tqwRp`EccYB-rGoi_T%tIlUP6BA9jdXDK;$a;i8V;+cBc8jJ+* z_J`!#0IPS4v3={3+ji@?-q{>r20b-gN+u)WpK8F`dO&Aw%D}Uz3a6ATx>grfvAwOe zF1vKn0cO)Gp;EF)CR{F^QmU;c-B5A?qdqynEUHz8oC^_CVtmfFk9wDUf+hDWHmuD| zlt=TapPaflou?;J4kt3obacA%|FF=ReZtSe|L?R+?MLDF9}TVoV)vf`KZDeEzH-ie82NU2s@cmx`uK*7QbKoA}^YH&41s?&A1mf%OuHcjK{^IxlQZNF< z$KNmE`+oq$&;JX7`1l_MHwPa=2JmpO6Wr9w1H=!&CEyO=gUA712%2CD`~*3`tH7gy z*Z_!6|8F1%cmdcCP6b~_4)97)1a}9w1Ahuc_x~^;{{4SLJ$($k9y}d1fYjYAurJdX zp;gWL-C0g?h|0};$RwX1%3~eLkJEvEYJZN+zdYov?b+_Ed8qGgPgOg*ARb9oIz7#< z26bup!=Uyn8I?sPI=3osB4NB(?~64#yR)!n4C5J?U6-2UJ9baDYIX699$ANaa!a!j zL##P3>Hvv2u#(s+Y}@Td7SGq?q|2Oyjq@Z@-?NU)PXR31Z=3E;A22OMhFO!X z4l*yN60N=NVCdUrSCXs*KRqsMY>!RFrNu4<6V>`evYOhXcSzhtPh?(lL&C%w7VrD-^ z4o(}L(A-4MLrk6 z-N4V__kRjL0iFRi1Mvs=D)35B0eNs=umRi?{5kjxa)392C2%efzkja;N5Ek)0d4{Q z8Ck$nzs7X<&tH`XgpQ~ zPDY7cjx^4|76P~2o83&(tkJHp8BNmca3iS^y)hWklYG8xDpYcsIH`Z(9P{PY{Cud@ z(k&odeA66o^Tgx9NO(L3BQs2MoYPF>O-{~&`K*Q#in6G8w54WpuzCltq1sA8iw$gV zHlFF$6iNAOe@!92gmB7&$&c>VtfLqCY8t5@Dj|#8wr%!!xTujeqp?P=Ibn`^Ym+nF za%5T$S9ff6$MJP&^Y+>}wr%bg>UY=XDbnoT4d#y>b7bAc(Ykar`)(n(5-pbJ%h^NC zqwB@VBYqU7FdOO7N-ixKK~}RhAPdq^Dd-JOmzpivV4F#&Iy*k&D>YWXav4|~vjm4E z2d(lg=3O3cnAqT=`&?9_f17DHAwZ4Kz?O<;sM8<654iTTM=-ooo})oOw5+Q_M<%5k zxL#nzBx$)1Mv{|&Ki&HiLUe94>|Ks7rx{>caE9Y%{X`_ku48gOdidTjF= zSUc@O@nzuzPb(LyVci!vXeuX4n#GU})AQ#emHE;2_g6(@FZS4b83@Z4v2)X8O= z%ZAWe(K}imW_OTty5v4AvF*`ensV}IsfvF!PetTiE;sOT8t!~hhsaLKlLgXZZNJ$D z^J9r?C%n@gEhYRhqU2=@7CuagS;4ur`mh!6c6!UCxnxpfc6gXV#vD_U%<8Aq5V~78 zLFA+B6Hz&qb4SD-?K0MLxYyz=ng6|wBznkrX#aa#=t5ov6@k9Ug#Q&z$o%eQ#Ss%l z89DL3w&$BdI}<4_p8e8BlyFXUqv7nAws4q;)yp}l0sF~@FqusGJM3b(6J$m1nPpby zGK+e!G3ZCr&~A_=3)S$LTXbcCv#Cr}iW5^-`R4tETU8f0s>j_~j1({%6J4}^QvLtw zFsWAxuL}Qvv1M4_2EYGEum_w9{s;d4*WgXyD3}7b1D}S!e;GIk#MhtP2Oxa^f57Yi z4LAU9556w^J$N3tKM;QZbMW{t09o+o;2ZGv;`e_UOo5-n*S{S+6r2ylhu@n(4UB{D z!o$A;6u=M&z}Mj4Ujho?p5Qbf=lxFt?}MK|3MRo_z$fA3p9kiFob&%L`1p5#tHFK1 z9l>|0mk)xMg1-V%PY(k9yZI+Fw-GOxv^NUi5+OSAYz8xBS?Ef z;XFGM9Ab*$WF;^EEURN2Je%+ly>ixs?in;u*h00koX>GCkAnAYol zwZP)WUG5z?q}!ai!E69BQea#YsR~e6O(!YK=!0l~Vg+Qv+p=!@!yy>Gw_*S6GaZ|b z0rbXQ9r}iSbbUq6X3Oi|f%mLq^jtwC6C62p(dE(^?hBLX(KDa>^b!w~4o72@xO*0< z05h5`zwph2MYcpm^-Amte>PseM@ij(rnw(lE;)w;eim52JCWdm;_z8F61iHKjbtwJ z-m@+w4mBI~yiF@f!hhC<#1ccW6AAxW7ZSDk@)ADgwL+7*@Sk-dQRE&N#H=-Gy(9_$ znUDz5Tf_uwEOjPfo^>ICRezyY)$U?55%nwcY##Jt)_$g}CG zb0#{KK09mA=|CtD_7k0A$?1Z5kENZZ$_1);tIE^OytAK^wM%Nn3izo zNWA(@E7viQ8&i`RQ=4(oak|p2^Z5!_bMVsooBUK?5j|2WmolIN^jb_E8_+~JH5k;u78z&etk{MY@k@px&{)}W%UWra? z#Pv>nE7?p`pN-*%5EI8p|Fy+BZ{|#4)VhgO+|cl;gy{@yY>58cp3z}r9#><706Hy{i6Eci$88t}K^Az&V?10SJonn3DE z&INo0xxm-JXMp(le+<|R-bFqBGk6tv0eA{n^~>})w%iPF1M`qKebz@u3+Bmk3 zfa}H{uyKP+A1aoT%)aX8#D3?A$F};Ws2XY{VyGuBo||Bg7p{=Vrmr&lIkV2lKCy+BkA(^`I_#>`h!yRQ16?&9q z6ia+#i)t@wG8gp@s<0W!O45+cESczSIqof2GvF#XybHo>QeE=Ivyr>epvrtkyMJynp2h?MsEJB`-Pk(G<2up2 z8F%F-DYhsLm-@6Zf<_3#?!6LV<*k}FNylw8B3!d05diMsg9NS{JZz`l%Du9r9k zg#=IpiF%DR!$v+EN0N}pXlS`*WDm`&&pcwL!%GC`UEd_mg%3gpr&-ks_qj*_ah6Ed za_`#+092gN7S6@$z9Q<9SiM75XjgxIp<$Pq9?w!)WLmhD={97ksy6 z&!s~b@eBt{NxS~_tt{+tSie;cGi0UmMk@I*ZMRbuQv}&u62u&$(va$we#D#`HBTEO zQ={vRQ2-y}G}qgh;@mAV5~2;MLOjVaQCT^ztB`^dFnhXb+mNCk&$9-gACI(G6}HQ+ zP8f-PnGlADvl5}T6)GRrf2OHVqgQUG;G zzKqly^A9Tu*Ur>7RHK$onz(Y`nTzXgx9gd%y$)|M#g-N~?c5Nrdv+Cu8?}eq?7INmamfi+dd2YMB(wAKh|JNI#gXLD8^a^n+{_?NMWjO+Uw-EHFtrAA z7kRM|3`qbtJ2WxU!9tpC{RO&In^npTlAW+adD600tw zRgL|;H@b{i)WueV+Ed%>Yg)U}vwBetBK-e_FsXMqfj{v76P96pmF4wC=l@c$3)}!t ze=WEK`~+V9d0;E}K79N$!3E&k@b7YW-}&I{@al4JUm4`Vy}*y*+5Z;Y8+;l*eHq*g zTnlghRLiG}U4F~*=C3#rT|D>#e7Er7e+BLgUJJjy6?}nwS3wR)8U761$d|SZe`L>t zF%_LVeGT>3yU~f_p$T(b(hNeO@ZdZYMowzA}%^h`i$LUx&faiWw~-`niUx2B#}LHLt}4R@7f-}@?o7dOg&klM}UHg@gJ;)p&|~MkxdWOjcm*WsuS7tK;6iq z00~W|BC3fFmL8}Z*_f$RL^s|O(gXD-Yt5&+lT8NdM%FX8iijqMLwcZYWIYqC&ScXA zbt9{-;cUAi!tuII57dpUXSWp*ZL5UHxXTOFjjU(V<;6&Ju=GIP$a>aZoyn#L>PFVH z1nW#TJwkanLwNp2fxCh?!1Heh=Ye4$cl+HG zdt5!;=-t6`QZd$a?;CcLR2P? zFjBQ62;*9LRF6d`jM5zlI)so)d`n`o<;xBuF~1aVYfN{rUiP$BU@#r@7Du$76Lh^< z(v_`Cze1Kkq%6U(V|-&99HBKNazHE43mUazzO+!vOAWOS2Tq{uM72()+Za%#cw8|} z*`ZeaK*?(HD<$Y4ZST++jvwuquE$Gbx7l{?Gb5GfUVV21kEQKgVn0x?l*JWbf6_MF z5q$o!tuw5lV_ABJVNmC4?g*7sPRHJ5q9JSMG=y@-4epW_*OWp?b%-Jdk@n@kd-*JZ z`K|AY7eTOk*Ne9Z~9-f`+xmEMq*}fD-q_Ib9QvhZ|7ho(!>T;_-0Z6CXkoyS!}8s+fB< zuG3jY3w_^m8_8I}jtjCi?jVqDklA7B5xBZBYl!In(fTCFXhnz^i>e#KG{gSTzKu*1 z2$dUoJ^r~Cxw*HVkOzN{)F~xz6>wE4#pCsp zlDGD(Dy4Y5eo~50r=PiM+Y8xc9zNiqE+t?x1FrzupP{R z40tPYg#tJk+yQ(AxxzcZ0U&kV^#26Encie+`zFi{N$^_9qt}7hKww4Je?AEJnpy9B8Jm%?nswd zn;G|jdg-?7b{&I?F>`+*R}k-KTeVdLE>!voYy;VXw)0R_0H%hOLatuWYMI7yQl%ib zA7rZwStk<6F140Rg;Miqw$S1_Ds{Aj!EAoHR1^Oxi_Vs&n*&%dK?0^3Y`6K5xGWEY`1v%`IS~uE*G7cd5=?sg9GLWdtrc5jL%& zGGkS_rBn~*A~GE-^3uRoWsos>)0)Jo)avSy2+3LuPg4b3ckS4V#W5G0bK@EQkdRH8 zM#n_VWy~6BjygwS|zY>kC)v8p4J!%M}|BAN@mei5r~)g>ZJLrPGpHL9h8yLqpT zQb>{y!&|t0tl2W&zf5o2j&G;&oyC=6xgkAnIqGji)X`OHUb~9ErV+e4%J|8*eQqn| zVzFAQQf=brG;50N3f2}m`NQzVUgY2st*=Cp0x6ORTl*e6S1tBknB?psU7WM|jRyT2 zA~{alPY;VDv_48Sj2WLs6fl;TBQu&rdP?SnOm;FV01?J`cCt+pMD5`6g5Nf{2yrH1%f&#LkHbnKf~QgyIr zCo<<;3|sAbb=e*I5cQ91E1}*ja8#5Pl%M7F?a0)ov+&L4yw_@e+y6KMvIyJwetSm? zKy3E+=!A>BWMRMsG^Wd}Ivik#ENVLx+iV3xW@*O9jYv$YzRg) zfIaTjk%D;QPzuh>DoLT~C=9aBOrBL+V-mMVd`O&|%S!bkj>_$IAK|GV+3(x42x>@1 zDfOI_J@o^dFyQLuOsRMowdrK#D`!p`BWiut_Uk4&V`i&4I(#VVRy=fAuN-3kPw&gT zTKH7>{|8uR^&{~4?*Y#S2fz++Tku)<`{#l@7zbnE1n^$?`{x1i0eBDab$I*NfECaJ z_XW2F--N$^H8=pq!7t$L-woaco(b*;roavG_t$}kg6-gT;7`GSz~8?J90eDE40ta* z{u9Cdz~x{Ekb3~n0N=P-Ci6~k7|eppz%9Vd!8hRdzYfG_;B!F{+z*Jaz<+}GZ-6Vn zeZl$Q`|$tQg8ks$U=-X9d>!8ZtKfR@8t^yZXfnk`!5c})q>PNQS=xtU#icW#-Jyh$u`Ue@w$eU_FpOBBl^B!%2Ivv2F{j=gg`_Sn+8 z8CH*)Ti11V;wV?EHO>Xj78_g_ox{zOofSAPz&Y*~QkJ8EoH8o}xrQSX%`6=A$VaJ(thSUcO`Iex@(D zV*TH&9ltI%N8`ngfkZpR$DRy>(+2WlY7w;!?b>P7i>HP`Z9n8X)+quw3A9k%1BanCPBl9B}8?;b#SS=q6Kut zma2~1S(#|z-x&YdksA$z+YfWIJ9e>btF%`Q$G0i6aQVh=>Hp2h)28)>PW71}p z{EcijxTOHe!SP13(_!?A~uOHJb^#(|9dSj`gY6rpTfKN0Qh_GMoJe;CxaRAYk2%Off5j(f9C=55%4W=9e6u<8xVcJ==ztz7H}W14h(_M z!}mW0Tmo(d-UH7sJ_N1?ayP)a;3x3slWu>XE2iTE<~JH{2e@-4#M{VGSGARvnufxP0rJ zQrvdV7lr8*4`r4C?vQOGGpm84UQva*tjK$WFe*Q4w<66042>!m(d!#UN%#AwtZ~bPCOkdaemYK(Hn5 z)j8Ij6H2W$@&GwrZAHs_CIvWMBp^xg40m^}LSU3JeJ7O1tWic}$RuPDEk=RVZ{K2} z0S$;u#x;De_q5J8+C{P%D^Z$UQ&{1Fh+L2&ca^rNoQELI&?KHYNza^TbM-|L?z_v^ z2QrnL_T_*IbL}F>H|*5hz~5ZXOgPLccFwVKKXo{%ISLLVN-=RMlibU}6?07{`oXlf zYi_enr1%;))nxjD21?xZXr2$Go{;vKs>&@OJyqGKm32nq&n~i8Tdk~Q2%|~}c6BZn z?}2&zWC_J+VqpE0*uP6U7 zy+Y=@?Cwly)j0l#5Vu(!Obbb^WMmTNPC-_GZ!KT}C^g0o(1|+>7Nf2{qG3k|Gr|yy z%En6SuSeS9BsRFoo}&Qz>e+Y0w2c~Na30WXKg~z`GSyiYRX&BGksbiGeazopNrrR> zXYSXT@Vi=?L;R=!%n;V`p!MGv-v49dXHZHCOV|26R;`KA9%X1m^iYFKb4Xg$j5fWL zN8J4t>g>hrn(n-R=me@;u=p0YV?L=kGa@Z@GZPe0*3`N8Lsc~5A#8vpS!=z=;@KXa z*p&qg`8nAY$dzH4%z6&H^B4%9Q+K3{{Qd5W5A=qH269E|7$@F41?do-+u-CBM|-n6Tss^9?XLr zI0f7V+!=fv{{Lm**7H+Bl!K7g9m|=!AIcv z9|6t>KZd^-UxQbIJA#kG+rJn*4J-lS`Nx3p{5Qbo{{YBYfNR0CfcPD_50J9}cL86e zK0gQE2A&3_ejf`uzL3TT2uppGQNZ!pcI5a^gn%4&Ol;A z)-r@wEd4$RiGMy;-3pP}`!6mb!lF+lUwsgwnyFuDFDQ`{sKk3|zm;unmd1uGD^}WL z!Bu)UxV)S1CU1S@2t$@JnU65CWa4TsRNsWc5#=nf^#^0M6xEc;k#bilODCQ&u!}3P zOFqE+0p8PJN~O1Dkh`lvb{Gw|=i?;|bxQdXZqUW$Fu71G$Cg;|`K+bhk7tIUL`@0o z9Z6w}iDU7|5w#{pUz6*`#8bUa3Am}QVzwhTLWjADSni1A8_8nPm0PaKMpRf;QQ=~< zQOQ$s`EEA-)}wM-eNhCpMPjC3w@|8!(Kt!1b7o~uOV81nG08}8bD=d?*&k(ft=fKQ zpjJbJvp?$2sUwDxQY6#A_Mp`crSPdcmX&HYG5BY0}O!^!M`IH_$;^%JPG_Y zSOVvOF>qV(pU4Kj3f=?6M}XK590Heui@-g>e$GmHQ*)S z;ou^0KDZMQe*^CaF9rvJ_%RgU11Ew1Mb_{o@ILT%@GNi?EQ3qIMsPYf5quL_#20|v zQTQBi4OjvffV08vz_*c4d>On0TnnBFn&1G~08Rn70k;CbMqcqt@D^|gjD!EAtzQOm zK-&H8AoV44RkxSN;&ces#iYi@Q0_)>4Otx2&YRNl}Kou*trfzdNUs^1(7?r$iDQ-1r-T}99BVog`h(Cmt19$Th%19 z5fuXQv@4yR)ym>wxzuC`wyHG#@Hq>4KWi#!@j?Z!a%$tD~z+z^j1O zq;e!Z6*Fk@WnWrh14c&|k#AJRc4VSy=A>XFI6P6GK>Qm$H$|(V=C?(&1Jp|9`cKnT zTWWG%GvSOSJ*8H+loBoEJh}wVqf0#NMg-W6-h~%l7>{D4huxwivJh2UFtSiDae1|N zMJ*oNN?-14gp}QAPi$_;x_h-x_=S!IviBD*%T^CDfy8|iUckxa86f@Y@> zr(k~T7CTYXD*dd`cjI(Ip=dW!vdxf|kuf1V1y&U#Ys~nVH3T`U1yQw&szTx^gc8{F z6vCA%oUrlU6KN>i^c`;9wM#@xSG|x<)(mH#rq#E*gM{Lw!Bax02}wNT^<_x!y@C^# z{>ti(YPJoY0FJE}$wNX?4{fHA^twww#F|}+CFiC-a<|fzU^FiJ$y}=|t*-6j>z2}* zg(_TKtMnjvXccYJgH(ql(sstgY7uexkr7k82Zk!HwB8bLj~*H8x-1wsL(;11Xr`>b zkm5Np%870@9}zK%QZaZk8{l+$;s>Z(#WR$Q|DSHzGCGuQ+49MxXDk@0E-Z*mpRvpt zJ2ciBTN$e-Rv)9aNn}{~|E(~8`%d5w{QtCN1m*s}A{YX~=gXP@{owZCWAN+Z+wTf+ ze{g&7QTX%6f-T@rz;*EAZwH6KY2a({+s^~{2cpXtJ^rJ?82C2)^R-|b2{uO@r$zUrO0%EWKIewsrrNgA6Fd-q6^p^aK$ZD6 z?zyAEN}No}B%4NRIhYI@F;eG@2CX=$9>bXowNp8J)M^bwQqd^%hO)->3v!mklL43# zPk%N;wk_VqQLD8K z8Hub&oW+RICgO}BtO%qavAEV8q@SoN{7`!jrO?CjgD@j1ik2GD$xdPk4UKL7_?>x7 zFJE?5*9c^mY%*JN&1MQAkBEFs2@%R_Oi&uTlSv3^EsvpW$07uS5G;0GQz4r1(}}Lz zwYECpLgt6EpGDd0^s>T*;OxO1!cmi5oH82zN+%yvp-7^QJN?Z10HanRpbA5jb&3|I@;I&Y4WQMZGgoipexikvx7Z_#ZE zt++MO=|O;p`UA|=doS9_d|pGC$vAJUrI>L$qSJ$+`9nv}Tniy5#E%&Iu6`j>3Tb}| z`EZFZ+x@XFy*TAWS;%FJtornLfA*yEZJpU3P4oJ*7kVujiHq?~Mxu2llB9>jsqJuF zxG=N{@iP)hk5eQovNN@$SrTgoo7tEKeeGY&LUi2n2D>L?sI>N~^kQZ*$>vRdkF8rB zJWl&@;>%Rj38OH*C#aByU8vfr^rjJ-iAD)0KJ}&%E_Ur1u(W#9NME~rg1u>kOGLQ( zB#lpd({RfK8Fwp%TY>s6OMI0`RHuIJoezKdj;{@lo?Rni7N~0f5Br{Z%L)8}|Ib_g z_s#JAE8q<9XW)O}`@aXi2;L9g23`i91D*h`233#)vtTRO0@j1mz@5M?!G}rg3E&cN zGw?BF1y2Q6g1dnqTDiendH);mT<}Ej1h4=K;C|q~;1VF`2mTj`4}lkh7Xk4hC}#yk zzyE4b0PDezkuCfPd;z=yJQX|z>;Pwjjo|yp8{P_PU=zrIe?r#q0x%Cw0dgd1oMR zL|5JDv}M|yBJs8uYyX%r%zV)Pl3gy>W#x={g*?xdaTMzXM5<8YJm`WGJVbJT@lO#N zii|gwtK5KyY{B$7Ip5(?;iHjnguO`<7B3eM#8{r~Nx>5+#UnCBamG3~ALWq7ozNlY#? zK-n{y+kDd2-`^kiBi~vuG@4CY(~GBuzIt$QRE3=~v6& zi|A}D2ql<)nOrOt=e0$O4K^1veGA3;5)56B zx#BvE<14bdnmU9r+CIe7L%meYM@odY(E0<8hzi9c!IU^=au+Z;%b(HMw1{5mP&T&a zggLfW6y7N+zg|!*HRBPz$uG1}W0^9_wUlh5Vp@q)Nb188sq@YY?9E7N_to&k?wjG1 z-8aKRyKj2((tT0RIQk;}Tjm+}OJr6g*^P^ib>e_8az`dzoKVc@eh8%^x-oA1)d}@2 zJsO7wJ|xR<^a}eHhCh88>6pkk&PRUM} zPD}Lvu*#W-oxmUX|I00(`5AcrSA)L(X_0I*|s@Z ztNR@G79pJ&mE~GZE|Jb3%+41Vv9cQp>FTec%u_ciQb6%&$~L@Nt#J}}ljw?7>-%|KkvGU>VGuW`sH! z(=c%fkLEI0C}bP?Ww|}7ad0?ZyE&g7R$o0g@ArtI@VoWo&^Vl3!PP!RBp0)1pP~Bf#^FrofQYk#*|WL^6l(G! z;Km*SF`zI3r&0r&!x<2on%EG_llIKTdhuvfW@^jUHp_Tf z@WtP7Uvx{1J)FA>{ZKxPiAY#+r3I5viSV-nnOQ*x-7Z8Lq{qp0G8J?R0G7p-AgX_NrVGW5sa{w>4+U zk7$o_+{r*mXZr+$T%y5hhM^@r#|GqtVV8g+ z&#?g+_FV#s)W!z1=E)tDf-wz{Q49HGeNCi!YN=ZL;to{J(=e!-Gj|LsPgVa9OPeVR zUkd-f&+?{kg4Y-Q|4wizI1&6ae7@-Vw*k@b|2g;yJpOCJi@}S)lfgW=3-~7d{^!8I zfDeOf!TrIVz{lbHGxJ$U)ggU^DefJIOQo53b<8}K3O@>);gr%hBx~M!uqD@J)0s#c zBIdHTOTz>^5Xsom6fT`)L`W&dnWrx0uckkW9N87o1#MKzxGt7i+9;P7@H0}yaCtE( z9%_kRv4R>&(v>-JzWnXSqbY6^=O2MMtl-PYll=$+G{pu!@S-yK3R1LY8k^p5W#7j+dib_ z!u;lQVvalWcGJBHIE$*JIaQ~fOy{h0+GW+*O+{7!qNMAmV9A|TA9WFvNW+jup8R@O zgW1lhaE#nKDRwAo3scwrlj6a--3^4af_1m2yT&+)s0%uAU7{0aOhv~xM7nC*J*-nz ziX1P|BdroMGU>O(WOEY+wUYMrMg$T}AjO^t^`F7ybg+9*c5Zgd)|pwm=P?;_$&%`# z@FwctfNMI?6pifKvu$Q)cFWwZJ^RLnXN)G5Obm|>im7KD>y*VkCV4qkpR2HMG9DJp zG2KCJlcEVjW(e*WG=-15Omn{_-o4@1#!*X9Uj(5iK1PDXwS4w^x3S>NjT0Nrh~1hCJ~#G_}P6G7r2qeLe&?RF^*<37gpb+-W2=Ued#o%J9UW* z7rytPrxPI)&k7FDVlA7PxK# zAhx)LQ-bz!*~#hnYttv01<4!NvJiVOmyyI!3D+louw+cU-|OT!{{QvlsJUOuGkyJW3LIg>--%z{I^R$L_7K<6Nnxd6a7DIf9A*uasK~P@cY+*gWx=HGWZ4j{#(Hc zI2YUkd=5VUjo@041@{0yfxmwjcpea+09S*{z%78>2ly-SMo&dgdEgrGm*8PQhZ(iCE(dW>h&;4zD!fdwnG#zu=*pipeJn3<69yLfb7ZGj>ZpyH+h zd6SC<`Xkc{##Vx{W-u1%XS~nGCZ|tQW}x`nPDXNAs?`u#zL7*CZIMxf`jw$8nl7)J zUvta4%9f0XK`et3dpNh#jL5_e1f@2Q{n6A3JWy+Xe%k+%C}DqHDC}`jt@?@g+2XP- zjc&V$xL-BLiuSDiQ9IrZ{T7ISKIYv}7F@Y-QF@m*lbKx9*JRo=F2*KSppY?y5_>?$ zubAP3qBG?1ZTQ~@(-N&kW5H_qmMCsp9sb_dvA(&Nlyz({42;_x)woBjluuD$IQ@3W zuC&dkF`h*f5Ye?7fr@yMHu}2L8}ZrSLxoo^xPwWFxz=qu?SUmMLqzzLZ*dci4at=$ zm}*A*P)jJeOLc^d+{*QS|E#DC1=T>=hcckdD$t&%4Oo-Ob9ou9m2RT5ZK-ayyHlJ_ zWHfZQKO<8U*uLoTojyWqxHC)+^+=VS34+ndXz}Y@gbo=#(_}DOP&!sia^a_jJ5@_t z&|_FFZ5_n*5A0GWqhfVz2UD%4c1*8x^-9%5@im#Ya!oVGO9yRxV5`+5py^1jY;K$k z)s-$+{K%tj22u9*5mh^g4mY}Qz?ww))=-A5u0Z6@_{KKJB#(g!2lm!7f8@FG4X03I zz84kMSIr9l4?CN=3B0Qa0*+cn^^5TP{|Y_^UJPCYo&+8W4gk3iUU>*1ZG6RtzyaYTDoC)p@ZUx?p%;4$ZuRsHA z1V2Dl@JcWbP6eMwJ|Ol3yTL7i`15}Y5P$yn2O=jp1DpbG2fl@j;630v@H~(Q4*>TD zHvzvwX7EMu79h3+j|Z26i$DNQ1iwa(@CEQ@@OR*Gpb8ei3|J5D4#dXb-@qq!i0eA+eg9m`!U<~{z(DpWMJ(TeJo;*0>>~Jy?(D(g*jJlG9To8c@V^$)|s0z-NrZVy@w=CqVy(`km#n}8{3HBaI-)7>$zuR1L3(FJrMR*I zXmeW_7Sa$=0awCo9WO$#=(uXd#;nT)s!E{u?WuBtIah8}F|4l?${YmL3)AeW0sL@S zd#j?e>uk?Vo&zK0Vw0%K2w7FIHSQE~cH#_+gX_Sv!4Xgf_XXk$KzRP&z`OqxTn~ije>o7Ie;!;4 zE(DWc9Q+tw{!L&7oDcp7KK`GDxWdbdR-=vq4V|j`_jK>mvG}Igykh%iTR{| zJFqmz?A%0DOq#h?l*0;+2&&ETNu*xIsIa-BA zRw1xq^B}JJT!6X3iDV3%|Bf##zIT?(DnPRAf!iJCf!eDS8i|g zhGcrC93Qb^JS}9;$eo9(9(U@@#-|Bz7?)x4NNyNgnP8wqxyFz@CW|? zO3SqR{{Qa`um3rCc)0`ca&R*EH+Xol`7eV}%g=uu9{v+R?Eb~)-!VL$>t6;$Uf|9Qhvq zXEni{7RA<9n56yCjZ|Bfy9I8`W-=xDJ}6_&3~NjBiUv$YV=^33cT_9l8fjpu4v0|3 z^Lrwvw6!!+J^1U$9T__ye-82|`dv)b=A*CNNjP?JtP=g;_a!A%Ga{~-cn~*a-LDZK zrt@PQk#^3@l&t(QWX!pyJ}(mpaF&f%%q8PKQ7I{h?AuHj&ns;7Xfe(;;%G^nc0~E0 z+h^JShS~5hVh;^33=vL`HA-BEkVd8!rz-M?YC%0ViMyp(ui}vnwHzGF*Gu#2&l9>fP?RN^va-vyZ1G5b zDgNt5ky%7P?b>U9(4UUgg#;8QV~V6){I0#(dU3hBlC!r#iWp(m{;*tgv%kAvKx7Qj z1p<~+mMGfu1MT{O_I;CtOr`RP5M~URpZ$m^SA((OAQuB<%tJ3uI8}NPT!;2Ti-&zT zS-UF~0(Xak9EYl7&>Fh+rx(Hk*dE;{6>?{86i_PK2@$9CbG1O24^ue#OJ%rzYkt&* z@H_z!@$gV%t+19>nCz77xnI`CxhB(N1^z>nbJ zUkV-yMDKqK@IUbEVx#|E@D3p7|2F~g{dW)W=Rj=o9}g}B{|)c{I&d|Z10&$>KzMq& z!|&Cg1nvj!06qcVehqj6xDebx{rx?VdQ@KuwjMja>GWm?5aOeWfa|h~^~0qG=2LPh z8{hCx7X^^x^qlOmXUOn&&UtzQRSCpqq=lK2h`e=gBEJ`x&E` z@Ra6MkhvEDuD}Vx(~m4W0cVc`%L9V5>9v#v+~$QL#3?A5eULanM8`RGxh zK~%M^;e<6&?09O+-q}D^+R#Zkk=+SO&5Qdh(+I&P_N2ndadnN2C#`6?7#EhWd~{)5 zKwPm~|F-2U{kfSn9j=jWEaY_uMc*Fi2`RdpX`r?-<~sgS8GyO-@ukD=AF@DW?M;(*u=G$LlWl$%XN4XcF z&|;KV!@(;XO_>6k$7D!~z1i>DU zwtD>v-h$V;0S!!+-7C&+1#?~bc~vj)XXbN(~2>0H;fr_ zWjUYAHY(M_{ifU=yPhjm)(|_NUt_ZQ{2Eg%Hx}!)@*1*QZmcn@m2G)uNL;CQWU?sa{sPVcNjvHMoJRy#+18}-IBW(BBzH}2# zz!W92pUjxSA$wrfE~KC4JH<91bl#m7=_ZF`@Gs%6w3T5>gio0Pvv1H35k;89&MUEUcNtvT>e&mj2)+$mZz4?@kG@x;4dCi*Lc^L0$ z(LOtyILMZq4&m`+7PL38gu-%uWOpX)Duzgv#sc@rAfcHrHV>n+8{CfEO>2F58Mi7I zY!H}4laVZc);w%co$YT;+~}M=uavMk_&@I ztO>wbqjIG+H%ew@x0UkP&qIR4jZ-}+WHwBkGjryK4QE*LO7Gw}DV*u2a4@#b!Wq`V z>5XIYTxEo~c|{r5oFd+nBr@)?EZ7sf_smVee5YPjH?W4z3`v@y%%WOB9!cuvVhy<@ z&t1+~tsr|_Vx_W6sEP?I#bQD41F}TQPN^H%-cBd3&NtcJMGv^+j-_4Vi6}%g^=Ps6 z4v@h~FrwZo8=|27f&=ArqY;>N%ci~F7ku zxSj~Xb*XmuY<-nU8EbRrYifylIN#R{brFF?rEvcDHHMe}K~2V{quWW=yGc(4u(=ve zrI}Hg42qS!CuP&zMEwM@pA}f#*f-Zhr4bq9iF5`m^fYC6SKpd%r3$kAg4kl%?S`C> zmR)qXEHOM+xMs%&2}das%murpN7r4`mB{$}HR8&sw#MB4+d1QopXKIwcCo(P7#nz< zCZ_a+pu`Ob|9y?U+}t-J3w+iWTCVn{j3}YP5^(=*dD&i&l>GwS73)mv|^?^16KZ_FmbUS?HM zhjXX011pMc!Jd0lb{4&V+Z=`#9Tr3Fz}KbA+E|9RhS;3%j0-VqjW}VfP?{$bdWXkU zKM`j8b+>g%3`?1jWO5?fUTBsoB%?ZGaw2v18xy}(zINKuZS;gFhcL_K7aM1}beWdi zpNSnz@;{<*Vb2==Aph@mg6q4H_g@U=!6xu6Wc@b-#qxU$_z`mcEual1!MBj}-vAcC zdhk!k_Fn?m1I74%H25rX{VkvYM!^@5=Whm0umhY2zKuM8Gk6L(6MO^N{k`Bl;2LlS zkbVC>5PdCp0k{CH0kwef~SH#;4Cl#HUORFe<`>KYy|&`9RDux zM(}cQ3`~F@!JBV@&w|f@7Xk5WH?Xg@YC#r6jVLGj#OkUZN->1DX6a-rIw7mN*Qufp z8`e6QbY#s-f%R^n4c|~Uv1a?480ph@MJ0Q_Wc?&Tu!7i8!BO?(swn?ecAD_thyV6p z0eQ0jB4~UJjFcA|>k_KnPBox+SQE4}PJ3xAJx3c2r@db+Z=WhPpHnpqZ*typH|R@t zZ)|#0-;Gt$KuNcX(*}*@d&*HV3}f7i0~^x0h{l{nS%knd|fHdj^*OJsp$hj2=E zR!KjT2Po@i>sYfrYP^3pnQu0GPhj&APxj%Ocg=06^+tV*7lw`#wV>22)d(ZitXyN% z6F%US-#`VAibTA!xCM|ahA?kvvt;yi3aO=-nnbd&dJwc8Lz?FkmL=P=j3yI4DkSvK zrYF~DlJd-@wRCyeTBIaMj$tqdX`rFu(O%MQBUAf#b8R=jrnRFcsL?nM0Lg9BHXrM! zz#41(**X#=bxSURmvAMLaSQOy%N`Zp*A;?ctVcKn`@J_zq_wRoKYKMR;(sZ; zS@dAHogI3*2+D~9kh)4lMaA9(V{y2KARo(lQ?F!}8dW+@E3Z~Nx{w}eteA&OmZ zPiP9XC`<)2OtKwZGu)(VStL)e92Ly)h%bm4dZ|r(i>}wTkeZe3PuAwMz*U*{tIPya zuuo;On5oqL^ZdTDEJ}+387s=-Si9AniRoBT77G~HSD6JCvxIvq<3;&u#YdT4)Oupr znfhX&7O^Q>3z;n37XxKM4E))}hG}njnS2Tp_cR1HkJfBbLx1vVpu~oSammT2ffC!B zS!1%zJ+1mQP~sW0weX4KPXnc0sBtpJBvq>?p9V_o^b1N(V*jaNv&)P&v=;t6pc=+~ z%750{Gg)wS$qi43pF_f=?vVVCcwe|svMlodg-)XV1YbT6>;a1Ne=qPBOn%8@a4P2~gmEOh5Jk`s$Y$&^|f)NwkITrlqjUvs5 z(O1cCYbE`fyc?}+SL_4foz%%(+JychJ~zt>q2V zoP6GO;P63vkj4?`HgU7aIyNiW%P=mR(>sPNT-dB4@T$gi;(aE{jlWu}VvgcaN37_> z+2$oOAiBNqG9?ZDK~!aWF4Kil4xIz`qcBbH&ZNS+U-`u^YqoI3FVUB~i;lm^(6IVR za?shii~HU)bwI|ie4gwo`7WC&b4p(2T$vSj<95xy$+YuoXUlB4611%6y>rEm$3k#p zD0ir}Hzm69)Tt@an`DysWyksW>jv>XA{T4W;>Wa>px>mO<;XHWCpw38kw)^hbE%OJSErOl_~rIfw6{Zux00Lvv1N=wr%P zmuIAp(HcJ_PRTc*UWILL`38jUr)L)l2j-ZI*gX3L__&)Q;jLX4TCX8r#kN~eA9 z8vY>vU*-hbk0bBP|9>ZtfJ!QYykg`eE$LPe(+jwC3pgO z5cmwT{tLkzI2Zg9_$u=LJAwTEp8) zunl}0J-{144QvKKMGx?A;LpLcKno}azNr4XVDG30o(v|4&V&14%~@;;631ffs^2I;4JVf;K%S)vHcX+Pdt7O$bGHVu+*gw zl{v&1TF(YF^5KT1!vCOZ7Pm|Rxn807py`yCE_Lf zxyg;2;^1tWy?Sk(+3N(tU9#a)>Y*$E1+&grL%NZIj#>4V>Wcso3o?>+PE^_p)}U{g z!}ei#TjgZW6s#{QJ$-()V5fTfH(67(a z5~r{d$rH)3^wjN7*^H7y=zSlv*Tu=))AzCDfO*bi`E0YjJuYUTEMc zV>HrM`)vb%4sn~A>HsLa(>DVKa;vLihXJf%_BWdQDiO9^#?r7O4-E2cRnS`pd zco;LS#_v;fC8No`u>Zh^@n;LgxmGvJx_>fQ6Sq{({N4EdXL8f!VPL~=+sf$0US(=+DFElJy^ zRkskm!>#&R1A4kXNe1y;=zNIDAo(h-FDs<;=>8PwO9Siivef1IwwVpa{(lw%=@-`U z2l;=-38%Lp^D73xAAlEur-E5<5S$0j1-cjDPILet0Ivim!KGjl`~tWgeZYIcE5X%3 z{sH6Q=fPLd2fP#fPoNlq=Ya=otR4Q9bKcoeuDy}{Rj?g@Ajco=vnkS^f^;5p!Nz{e5z zIJ$#B1M)RE0Xkp;NT=`)bO&v)8EgVyMrUvfSOmMkgTOzaFZd|<2>27An1VZiVha8( z`hq_K&j8XN+!v@_KCiY}(aUxvPBl&!b;{0ZT!RjV2Z3H$6NbK<*Lt*L*Tn~RT~yq6 z;DSpp-d()l(B8{-9||H6Bu8q|G)5z&(g1LWxJ{AUqYFy4MW(Cm(Ge)9)QuDEh}8aZ zsk8QpJQ6K^-Q*36xP1q+bosKf?wbMsdNOTTR2k2mUWAz+Lte$?6vWj0iS3@79agJ7 z3l}%WM){=fO{a(nI|=`MuJl(8fEqF`Fd{;{rE@z5NLb+*alF5G62f&6iU z2;aSXDh>`^LkkMi(?KS;IHo3@uj#*@2;B0F11=VDt#di^sHT=WrTP3 zFcz^ZjbY3L&K@QD8)e%l{H=}Vx=*twN+MDxjvIuK9twT-jx>9p9nO^PX2V5$m$xqF z0HSMgQb|$9+qJ%T*_qJa%yn@pe;b~rNd+SF2P)j1d|h|yxeU6}hpybC7=HDfiEnN) zRlxBqsjkHC>)+zMO^wtdXxWFsMkj(Sx~kd@dr^u8temo2aumJY?98!HW(p^$BMr4Mr)-aI4!|Hm+KdH??%PR^A4|6EW8 z{}1>k^1S5yXMsat3j92f@Ba&d;{QDq=nlYl0Nwj{0oVoBfqz3@e=m3um%;K2U@Mpm? z>n!@b78ma5=wh`zto_awzkIL=1}FdRC)aI7Fke*Wg3nQO$WpU@mv*AYNolk`vvIxb zX!TBQy4)N^DA+EU0Fhuj5`ndPrM9D!8`qny^Jsl~WABWDVx>}SH!HQ#fwO7N;JgA! zoXo}3r+jQY8tI(CajbrPBxB`^qP5Q1uC0JhtwntP<|;F4kj@DXOv(%A1QME==7{Oe z-3Gd$+B0xjT&lM^wIVxw5@p$>`+s(%_J*VV*yM8xnAEpz6k#r>)D<+2avG#mY{4DE zj+xMQtLqX$PN{-1lCHK-p!BSlo5on)-7kjH>s$%)d>FAVXI_6qbM)?dHW>mCZlkut zMWfRkA&8Wb4GxKC0ZQ+HBLfds>4i=FXh1w%5DNmM+yz z(yriDcKsx?r3*H_s;Kw^5wBGioMaXhyq49!R^u2KTLP(3%tMjw5Wzk`fnsJ@!*O#q zi{2o6749WUHWF->NFM8z*7I3Aq%FZWt(na}E_fuJYv%b@-{;wsrJm<==J`r0e^%|x z^V$5v=T&_U6RY|O!S(6t(SSv2A@drR9ps47rDqKx6yX=yE@itTfPZ4ENb*(c-LPo9 zP|_0c}Gj?g&<&F5;~H|4hW& z_aOtz{{JK=>b?V+|2pt8Ae;aFfX)Ei3}olO0*nFO|Mz+DCh)(&8^HqD0ltsi|99Xf za1vYy&IQ}S8t@Th|CfT70Nn?$4LlHh5G$a6LEx_JhqpaRt7F{^4yvu?1cOo&%(p z_*EeO{~xu%N?vQjZqxg{as85|8~F;aOsh~`*%BINk;ABvKXobUOuVNt z&cZ7Cl(n2Guk>gO2nacAI-#+!=tg<2pP>x%Z_N~gO^Bko(S^TU3S*7oLv$<%NRc-| z_KK8Y&sOQNWhR}({Y}fIJ1!Dzos-^S9uGWoUnnDAMMlMCQ zbhN<0uPWw@Gv#ETG&S<%`)9h2wr5l2aH^N^Bq!=9@=H@L^}Pj2PZ(ju5zNxhZB*3F zYSwK{_37W*>0HvR8l2-fLZv6xanV0vIP64J7PsJ-XoeZSJNksnWb$zAr*_w*qUF|# zYrfY4L`}A_iUey^`8w)9qyqbP4Lb!V@}=joVV&Zy7R?ibjCTHKg6FqLjxw`mC8zR<7%+}$o2m$zXo zaH(eYJ6gv(Yfv6eIrtgL{{IbR&a03?CI4UHm zPzWAm#&W;qe``~i0bxXQ>kS|`g~s$%W6`>+OY9kolk14I7L;I~pT{^dUu{g6s>Mo! zXwEvZRJ?0Ssjvay!qCw?I{g_m_skAYHb?{OS8s_gw_dNR*6&YTOg({)s(o0o)_)Z zQ=WYDGfJJ=S=}>Vt8tNzu4}W?A8xx{#i|wz4ct-_z0CRfiWxh7tt)7y@9kLYCOMeG zbMc1G^exOYt#VP!7(G&{7M-Fewbu2na<3G&gS)(X=9`&`o8@_gCj1LrI>%<>R~Yq` zV&tUg)2^?r_7w3&BXL==Gg|9dsvk6dgGy%-p!p$iRK2VINOE$PPzJ^+24QQRu3j`1 zV~ED2o3=xJ*YZ^F7{>>@JT3+%C*oI8s?{A1TBLZQy@Y0rx+!(0(ZRnyO)rs7u{1;bxUEgVJ;bzR!cnsnL^bDiF3x2WFjCM5M(cI>Q71Lc#(5MqP zQx7y71S{hLXAx|7uBP``)vfQEhIhWjT$V+f<)~{5H}P>Efq7Vu*7atixfv5GFD%;- zXlZ&f-QIU(`un;=yAL1PdFaSQx-rISy7BtVx>Uc-OSW!e!iPp%+zFy zeNQ+ap5Cd$5m0c+N9Qq^zuQ@tQqi4 z?YdJp1t~g%KASLc+14b_SOGuE6tH7*>g;&Y(1f6D4qL@M`FJ*wjL2FQ+Ek@w2R%vl zR7-Bj7x^h=;C{9gaMQR@${PDt-&>e#N z!9JjK1Ggjl{{wh4cnx?VsDR7CUN8!DkHG!G&jaZQbjDyGxEMSNdGB{&^?pLY8m_$YW9XoD7b3MhhK1CIsg z1GVvaV3@Cr9Cr=3yz5}JCIcpX%{s{^wn(~&itiEuCo{sM(UD9RBV)@syRM-d*$A9g zN0+gj`@tKCo|*DSk%u2Oj90-9-elJAeR4C0gh5Vha*Z_`2G&a#o1Qh$1o;VBj#Hy@ zXZ^`8NqjL8o~Vo>PFXK6!!UXG@|LO9(0nnB?qIG{pOG(0B*`)9V(AWN4r7ED>@L;! z(wUu_u7@it{xh+%Wz=|+CN;okbS(STRQFfg5Cho;C+SqzLJzL6YO%PmV;W6AKjf~y z=hFSVj_f_KKewYNB_{!K((KmA8>HJe%gioFsM<&O?)iiD_+{jk>g>L%ZYP(n$nbi4 zcUQMo8TDiP&UNwR>wZ(K$h1%1gZ=SQ{&@wf41enT;IiK#M> zm>_D*le#MMc&S;DZhkm!B2-L8ggYDiS$~(afw8H&cSSL05@sT?#9mYb?t6w}opfzJCrl2i$>7|8*dF|Bu17;Mw3Pkj(!S zuor9vBj6XoY2aSq>&X0n4HPrr4}tsxUJMjJ;2Q8)a6b4pvi}WW7q|nt{_Efmfcye( zMW){k-h<5kSKun37y`2K9|jkJ$AgD}2ZO&xK7RrD4e)62Fz|EWFOkPjfQJFa7x*!9 z_xphE4BQUn*Z+^;Rp3cr1c;x1zXsg||9+c)?*Ly1*MsZ8^Fa2cJzdQlYBz_f;t#qf zgabmO6M@Y==p5^gV7R3tt(%bY%B1rDqWNzvKeb79#_Uv5=&<-pq46b7WOVhdB{DvvPsV5H<~iTe zMKQX6Io>(J(x|`C$zU&ET{H)0A;r)2sYi7BqA}ayz-Xshi;X3m9WWMOQsrh`pV4&H z$Dk7&{$MX<#L$)6cg$JKR#DDa?)C{AbWNp)78{i#XJt+dw^jK=)^yUxVAEx)btd-2 zRC^?}&a>)wX+zk_SVoyGK}Pf3D}Q6E@IOlGb|+bMFFBUMx^@g!>1_?SDmb--CHkU# zD}m43x2N+u7}~nlwW=*uac2Wpr^(2kF{ys9T|_J2tW0z1(&)j&e8+&DZJ@r#CmPS* zN?jwEb0_VV-qaiQGXK)gi?VB;p()O-naj?8wtcFyHp6iEnX|<ODcS$lt8DxG%1ZYQnkv?P z*^*6W;|%z)PyGy zQ&W04j-W@STWh% zg&QKbZb!+ED41KUDn4r;THcPx7jV~aiCoFU+Y^~qEZDY;{|286Yu69qRgh9A=XH>< z>x6pc&P{*l`LG@xLW%2*|Nj95(an-ak^eEzn%BpW@m~S101pN4M7IBPPy`2oZ2gMu z{~k~WzY5-k+~>+{{~)yOuhlU6PbKJ_$OrX6HX?7E%NsfaBuKd zWbU_s8-U{I%jf=H;AUj+o4~8U?}0LqEPfPx7CHMO@E6oWb=jo)4EJSQrr%l@h!l9G zR9iE}BzluuN1Wu+J1$;Zjf2tTIFH@^6}qg!pme#YGQ5S<@w4R$he z`slHfPmg)$hHSYIJ0gb^*jq7|S+Sa9tEm>Jz2luMQ`S;j_cVc)F=2M07_jW@{1JMW zq5qhsaH==Y2j_!7w(m;vA5TR|K30G&DhM4AvVAC(N@f4Jm zgk&&fB_B^gSz%ZPN((=pveInehPX5z$6@IG!-k76JVZt8Vn-yUY-7LDYwa6+WGOO* zD+2F96Q*L=Mc5!1t`Hv)W7vf-`NY*wY>%+@hr=lo*Ta|Lf_x0S7AAy8 z58{h(u|kGk1aU}`B1}+{VHZI^BIJoH#C}LO`3hD>6J3QY%`zE>T5(D;vpTXvN)Iio z&`Yhdp`C5E(ZTBlMK9(=Zyug7O2(zLNsj!Y15UE>U)yZfDxfBJn#{DTCm{~g)**Ln z&Uox~pB|+h?6Fy#SzEDR4zar30W~QxIpI1@K!qlCtw$#s&7)E*C0fy-w(IdjDa-5E z9z=AJFXGLTQP2gCqwtpb6n>;sb7@}WBudPc##u8RKL>BNu4d_(hb)#hq-fa417_h{ zkZPPDP;ebsC=trW#s=+{mW|+ng1W1tp8WY_HPG!z;5uL$oNfgJM#S# z!EMO)d%$_%T=4J6_zU3k$oPkV&fA{{-i&PjN8oi}8pt<(JJ31$2ZLuI$G1V%$@EkF zDHQ%eIx;q+ffPu)cxdSuhC@zJl)p`Afg9jm!<&K?rLf z#=Tl@xui3J?E25;kk0Ft2m(yX~eFb+bwUVbPJz##e1IyENcN$!t zrn{4h$Mc(maS&W+~&d12^B%h88W&`!&OR|=+$Ee@t1Cd^N057y!uTagHQK3 zV>Qgs)t151)PoeMJM~aVic;ai`l}bS)V`b}@t~t4zjD(n!pZ!QMqy(LuM(@$) z!9&?bAI?Y!N%IkaL`=&$dgf0PIhK_ zaWj9fUKT%>?PDr_Nb{WNiSHR&f}Z%fQ%sNQ?MX3J?J)}VTrMf6fIoxKBmOLx9?AcT z|9^*+0LcGylB;=T<^Qe7{Tsk~a3`|=w}9gKy%6jN0o)6G1-*vO5WEZg3HW0$ z4RmLrKTmKyI*&tO8~6t8qc+kRf|b37bU@0TkSa9^6vcUSL|a1M5eBW^HcBiXM{}V( za}>MvJQ3u|HbSam7uoPZmAVe#nWO5sSaUOCI@-!?<3xRE$GHk-Eav>_$lvg|{%~0* z!MXK^t336mQks`4E&tUa6=_Jpqi7AWejW#Ha11m-_}UQqsB>$f=gMfcL>~Bo5(Elw zO#*xsxr>k>+4errvFIB2`I_Qfr&=9b@*e3pAdZcWOw@Bs>Gc_6;}q87V;-{pQak_BU+%-W2 zGYs&qI+;vpzkZoqqq{2lrKc10OCR%;12~Q!M!Sxpnn-EQ^6^TeLl4&R8%Drlx`NFb zSs%P&_l|XWe2y=oTrQ2)~wQpMGT7xwao!VK(`M z5#Vudj=(9AjVL{KY^*bOe2jRzsae;~?)?a!XTFQ38&{j-@D^8bD(T;7WPzXP^_FXIQGd;jWS1l)-Z;LpI@z)^4sH~>xupGF7p zGN8Er+rUqd`E}3V?*r)o9t!>rS^xRqLa+wB3)%h^;4<*5;LFJHH-qC~7x)k4^dEtL z1YZExftP{(;2dx^_zrUVhrkEHZ-PsJWcTkPn|~2}2&5hni$bvU*wYI8I{Hee@S5*d+8)ng^ZvO>6K*b zaMVEsZS15>C*pNmfuGDr-OoTkVVNG2VCndz)MragtiSR;GZAQ`ITH*Uzcd9fZ{VJ0 zGcbeIy0#^bZ0x+trI`gXj#XXbPW^?Xk62QvCcqd{Ms}H$DADz~(wb1Ag5n*~r;kULFTupsM3yyKx!K5bU zwKizOg87CPh_C!mKaH4OBiP5IRz3>c5_LH^w7WBI;VXQtznoVRC&eEUWv+i zK02B$3|(QEG^^kWlGl`U)26AUZU~)W+CX>GH(9e5rb=R#53Wv3rMDkadM$m$f`2S1 zDCCJ^nRj!Qp%^PKJ!4tXj|Z998Y+2~PhsLNQWzQGEAC2p70y*TDfO{1i@aU|30;Xz zZ!`TY?vSY_gH3@-IyVR3Z{iG&rwPg7L^l~%MyB@!T_>GM&~B=1_;LH@%7`Ch*4f=g{79H%NJSsr znbKcM2YN~^)_?R|umjqAXMB$d|bxcVnG z+({?}4%uMkbWn=1&)!U1kC%JqoAiz|C<3ZcSa!Y{vQ(FQZx^$a>(n)+V>2q@m8xoA{FJg$Jg92Qzj&zS+=|4gI*8wGZ~r zN4fNFm9*W_`2TN1V7+qXSPZ{XFum*2nvum`LKYrqfg%X8rC;4R?I;3yaYUqOGMGYbC$$WP!1 z7zK*+|1t1U@N7^6N5O7zKkzy92%iM+0q+La0Qm%51nvz^1K&lb@Ck4eXo9Wa;Xr-> zcc4>v8~82oSnz1@aPZ6ETcs#y97R?`=xm;-w9pn{w_~JoGoF|vS+w4%O_!SmQzoNV zw<7r{dx&->L-&uBZEX?ds}ZquF;2zYX?ayQJ?0)NM~``5YPA|O74#*#q=QGLuln)Hcv>t=miHuQwyD+AoHN$UN%fgIdd#fT zbD73#bru(^6`C^c2uX)DJ;DdM=9HyXdeIfRtIXyfPPIMOjT4PNtHv-QbO(X4Q{;@A z2~F%DGx}nG;{~UyL%rT#2)@%pbmrWzNTh} zy89~FiH;3Icy+JsLvrIpvp^dv+5W(#6(zq^S+^fONTP_asGb#3TF(DjM@pT`rF~@;@Ho&vMepae0J4 z%Sj`B%m{x{X=MLL6fJyY4S$gTk2;}J_Wzr}3&C%I?cn>!_@4nE1d0dv+n@t31!saW z@N?iZ$o#i~o58cd(|}?GR>3wf1^xwj|8-yn>;VO!vjew**8<7^CGZsR2p}E6PmuRN z4PFVVpbRbn2f+Qn=aKV23tkEoYfxthromS5Q{?==0Ivntfj0Pc@DQML0=nz(4d6N8 zGO!+e2^n8L1-F8CfevVc7SR0xhk*PH?h9^5*8d0a5^xDP1FQ$9gO9`D=Ys}#5;y>K zkHCGv*O2w!4{in51I04bIe;_41HfrO_xpVZyaU_#Ezu+Pl{tv0oSMBdFZHHi;{*#9+I`GfvqqF-J+aZI;PuDBGB98oK`4$N@L!r%Dw$^p?FxA9*VEk*v&Yx)a3< zi>+B{k7m|c9y0nA{?*I8|F5Z%)WkH9($QY;W7Lk?RScwhG-$aW{l(Y5h+8nWQ?7FkBTL;-|DCBK9y^inyrtM}PGtDaK>>OUBd-vLE_UV&L znNpWLpmPdkI?4Ztn1#bm{@>?h$-hM2mk!`M@G@`&{0jIA^8FjZpMqzDXMr8yJn)~$ z^|yi(;9T&1Wcoh?4IumeSCQdg16~b^U>*1da{FsR32Xu1Mpl0dI0hEM4zL}3A36Qq z;CI1AU>leM-$G7*HK>AZ;QPqpe-2K9bHINhf6F%i9Pm5f0C+I?6tefr!S4gfb`RPi~3OJlL?*PI#$ z8;+l9 zwR3fO(4mj~l1kh{F*!4E>MZrCHfH`NPDaoe={C;%>V`x9P)~hp>Y5DTc59Fp&LkSc zHV?;KE-9v~dxk%HstpZxK!!itDhJ<~HDaxvmfILtGh!4Xk509W6Nky9|DRI1*=RMY zMRyf4u}|C=1NPqWonzoGlg=V_C9iAB0SQU=rkbnMO*v2xf|5)g zE9r;iV)}!*TA2LOgbY}hbPgFZR+Pu`cxjq5)fUSh%i=?|(V0!<;;9IGXTo#S`^}_i zJE%UF>hopR($su_L6qL@Cr0I&*Sp;WZ;Ol{_PcP~KMQLiGa?vq6W6qukZ7?qa}>vj zWQ7@o<;ObZ=E>qrjm?4rc@--IZIZ(0moxHPOj)iljW&e~w%guPyVht0WWf?PWvx_)Q_UPfGcL(IXA0puWs$A&`9@G5X4xC9&od%@$ty}@bVd&vFY0^bC$17)xtd>Q#)cLp?oZ2u$R zb_)6$csEdtfR}=o0G$Jv0OQ~X=mg#Z+F%!WIQXQ~5xj4EN{3&<|coEQ9fQN%GqeJ*Kcrj4Cz=PmE;OpoT zJ`b)174T$mFYxE+5}pg50c7uA1HOkY;Z5La;278p{uy1uhrzqS0+<9Fz$efpybaXB zW5D-lhkpiYk2iqu#V9%N0z8?Vm;Is1bRjw0&g^4xB;(de4OaW;njbV9r8J(e<3 zT;c|`wDO~iY1PI&2g0i`EW@|)xf1v4j%Qg%;gz|$P7D1Dbt}(tVzt6Xn1kW|P;=C( zHRQaFpEW0knd`c#@;Makqst)59!hI=@(2sak^e8Eo;|C64YRNq6V=$w);cwO#j70` zz%jQncz4&!CA=O^EL1qgF7|gZmMRps%?!-}Cd4K zomwST%;z-E6i-$N2$-4ddh&S5;xnAhD^^>-Wt7-+rU>qDj8tjjane+s>1lJO!?b`V ziB^MQz#>j_c8xQaMHe;R=F>HAZS5Xr^za$=BaJLKZ69aE8EuN0@uLO$jQzD;Zsl<# zp6$B`S)w6Kmp3Gxw}0op-52jYe8jC_UNUm3ih50c>P$4wMa)=xs|>Wrei8q$Iu|mQ zRJK1_oysP{V8IYbUqp>zV?4|%aA52vif=qBmDp2Wd%Wb+8MB2rqvY#?%~Ki2kE&fY z(J(Mgs6hLJ{HC`Dk7rp@ZqLjT6_)U?>C~C$oKmk(PVqj_JzBJ}%}`BsWi=1W6U~0n z-KM=X5z>@|6eKlVI<3^cq+P_Qpa~*=ZAf@yq%qf3tWu_jg0J9H&!YgO+e+DrXiiLB zmci5)T~+T=jm8(sW6jaiMJczHueq!%rA5tTrUx@$(e1l=GM-gNR_EobJMsr3!HU?7TML+NjBPq`;|Ehd`|E_*ZN; z(E8tw%rJ^V;nHlxoB~UWlnEW8<6!Ua)2W~?D$Ssd*Ir9x8*)clzDK&&FoX<^{cd_Gn3Z@25v7g}dl;=!C_Dc(lWI*f5gPE>S@VGd09B&*2OnD}pv>?%nZx+vz@jX_;xW%g zhj;A@7WANP%o-E)jOvM4Jz02EWe(el(iUX@M~p9AxrRT;{}(%fQ?~!NfELjC|MlQ& z$n`q=e?7PYJPh0){0XxC)4?HdA&_tXUjfa6|N>p+$91yihFPL65T>i z89Cl@awOGMr^XGK5<0~`hT32MkTxK^2IHrzzvd%pE_P!^%`gWROwt6}D9 zBpdZ~)bNDLGq;ZK-f~u-ZE;MblaGf)B%6l8iJZ!((X>9iiTB@zF)2=U@tRA!qM7DN zb~9DWZ>D@J$(K6qh7tbk5=b{ebg63fP@2XJU8Hqxmf5p2t++4rV(}D`^~!i05WCXO z;Q35eOA5Uu&uj7~$G7gz>Bd@G`n)RR<#D=CogIJFVDnQgnX3x=q%c2G z`9PDP{VqotG5A`0f*I4@S-AX}?54(1Ob}RHx&}53Ep6-R#--V-*qo4!jT7%S7u^|! z-3QCoq!pR+tu;D!RI#j}*%NtiCn zvg|oGX9tQ&%r2cAO)$vgjVjS;G_vibbiwoxuGjmEru>+p@l@x#snZ(AGo6-`&0BLO zJ5!medT8Ie*a`R4R7Ir^T$3qnK5}aU-%-Xis>k8-^hqNG8OH@9oTlQuw9FpRR7Np_ zwsX}G3{UJ0GYbt&dJHzBt7oxS-(#Z0cuGD`)zf3B7q1>YRvJ529XnRpXv6sFYDo=3 zV$C#pUehyt)jeV+_MQ_Sz0rU+uT@$t6UZhuAlPwj+aAT3Y|R>Z*cf&D55s*nvR$NW zpog{t;)5ulbRsCdBR0qDaw;0K?dvH~Y`c?PD zODkJ!&CNLXvbbqIA@Qj1vJmx9Y9Y~faiwbAPESqo^RIksT2 zE!|23mX*QQF3UilboIep0jXFa_96ktw7g?2w1$RO7amnHVl z8C`Vc+llgwm8d?4OU$;r6ERaiOJXGdKODLB57zJp`TvPdhE@E(XMtuFMeQ*tsK43FA4SWS1!27^W;3Sv@2f%i)9{d1(z=y$`z;)p1;K|^8FbW<7 zeu#eHliwxYIJRN)-9f8gZTmW>Bfb<4G zMn~{Pa4k3&OoFZ8cJu`w0PhFS1k<1d9tm`||Eu68@C5Ksa2xu9Tfm=zMX(ttp5Nbs z+rYIzI)wXyAEGPxK6n$j3Ty@&!PnsV>wtLwTJgWfD-&2O(B#-9usqwArpc%X@X%oz zHy`~br>u3u>paigF0~O0PplTVc?6e{rV|^LREuponFKFc`;%ph{k$($MieGq%4-(` zFK4?D#~HBPXv?8x%I*%ei>Nyrr?E`d=f|TX(#pzj#qa2}+w?U#!_}ljR99obkN3=S zfHmgLG3qAswGa7DG#0A~$=0S(&(N3Hp;a7bHougS{)Ip#x_s#O&l*vJYixO+um2l%}?8n~?oEyE~PH?5szT zv-h0}-WO5~&-swj)pBL3)rYIUa!g^aS;l1(ukWR^3AB8~Q=Gv}iU^S?SVPll4i)Ar z%(+gq=ekyD8jyTw4m4s!W0f*)kW8#NwIA0Q*>jy_3q_5h6V}aE{avUt96-fV-^AU3SWmPzhfao${}8cEPv&#~@* zO(xDiNDUzWnWEgG(wn$vWhkArY((^4wUeNI;!%pk=I2A z;XBj47lr5K*0WJs6#Q<4M_fMGTD~TPXA(*Jv*Xpe zqlP3N+Lrg_RNj}9{>y*>Sd(^9<(WJV`dy$KWqPWMkA6_{qw%<;$wNy02;*nt3#l#< zat=~5o0+7P6vaJ8T92o-8d@*DUJqzA={M_0C#r&u2vyc+4%Uley)snCV>c<}=~*CNqPgbAE03I-BT;N> zmgrVqbB)Vpd;m5Pq%XqhYutE2oBb=>)ohzcOJ{Zw-4d2W3MD&NQKXXz$naJBV1z7l zCzZ838~gtwnb>C5@CW(-A}52s1DXGo;1%Er;IZI*AU%NY0Ps41m+<}~@OU8EU+4cj z;4qNP{{ZlDx`^&&Vpg4Z-Lw3IrTnZilZbNSW0FeD( zcLHt&-$rIv%)Xn!E5P%>uY>O)ufG!<2UFl*kk#J`=E1Kxx&1lF>U+WCz`em~;FHMd z*MZByBf&o*pMMFw0sJwT0Xu;F^JVvcA(#c?+cfC+vK`j^%`~Jmb~8l!HoeHaF9Z+U z3z+;fW@O{W<&v0>#_7v_u^}~L+#!AUo9QO*z1CH~EzI#PTEe}ZUZz%>@Golem@Q=PR-HcAYgvP1BY$eQ~iSyLyRqV z=02W$Nka7HxKmR3BB~fBpsg!QYn3P~PH$8=%S_EALfBqSQD)B-ht9G0$)E?w;Tsj! zT}o_!Tg+9*%)f)?F~-qz42#-78LdW<6Wa2IE+qUM@Esm+Iuy>GkL{yn^DbIjt6a1E zjE=Qicxu_KW=e}TFSyb7nwEeqL6uNtEa*_Us9LBd*~UYYjU`$UVzf8vc^nS1DqpPw z2CW74NE0=fPqT~qCD!NvE~I-|5<14?1*{P}pe$HY6&~<)<~X?Tl14Vmk+4sEPTv zHl(=}C5<}1&D)I$^Nkx{=6yWu?8BLnl2J@)ZQv+-TKAPvbGjVNw!rT-vipjZ(|T^f z&fR6k=y1oE(w4=#G1o19E$sE0p|^u`TC;Pq6kY7ajE7QF>rAC?i7}nQut%LEm%u*S zPQxWfLT*}ZwG#e>{EQWxY|!YOR>7&AuFc2kHGTD@<3#-yyUSKfCuNj3PPJ&CjJsx* z^|=IfZwGT96Wy5}AyuVz0%-T}&M;caq-wdDq!gdi9BIpDY1qffB9!z}MH){+bADUp z;Eif(uU$3nFRH%Y#!s_nFx+({wfz~Cv0Pf5qhw9T0ojgQwfS_peWEPOH;QKGisBjW z{&h|>#_xk!`y^)YlSX524xYJldT5exj-XfBlI_TjGg7nk*8dv?UXAlR^>&BZAWoIM zxvMEpuB{t@^59y;T;ko>q1R=4lbSw%Izg3hWsK}-G0h}#%5-$YWz&Ij3(jnn$udhp zhgkIK;hCEewqwl~_RvjQ+nzRr*wltBGu4|GWR|i@b-nRUOR59Ub=hQ;gUuyomS*8_ zEOr(h(~K(C_g_Dk7z-7?o=Bz@oCb|w#zKRea$SD*k{y@ImZTvy*N_jbY8h-y>{UH@ zFd`9_xw=OlJI+d!%5pd>SbX_TxG%BiHvEYrT3tJz7JJmui3o)w`bN}^XN*N>jzwpU zMfjMV9ZfKYEJFtA{U{PyYB1K#Q7TzCQU=kpof)dynsMGMC?prH3r0LsjhmP-G>bEp z7|$aXpmYf=PqDYC8rju1dW1?^YXypGdAcH?1xm@!9=}wT9{C^90F8DQ|bN(LzzXc8f`Tc($ z+5U4tasH>lWndln9C`f>cm=o&DDS_ajC)@9aNr&e+{1x;IB*XK?%}{a9Jq%A_i*4I z4h)wAR_kETB6|(QLE;t=o^ZX9U>nu-M(B{s8Np;mvp?34RY->_c4e<2l#CVl$e~Mj zj~6Tjm@#`0soPQZA1EF`YK@0&WjK49*+v<;r@TR8=_Og-qDzMy{Wa)-*)Hp5asT+3%O5e!!kxH z`~=yJa%90O8aWXY`}UQlaq_@0VBL?v2XQQ?h+~e6_>&J|CMe#|T@fg?V^3~Dkz5^HRzPPya$i4%I Qxhqizd~~R6WMkp~13%G9(EtDd diff --git a/atmos_param/physics_driver/physics_driver.F90 b/atmos_param/physics_driver/physics_driver.F90 index 8d84cf00..baa6f948 100644 --- a/atmos_param/physics_driver/physics_driver.F90 +++ b/atmos_param/physics_driver/physics_driver.F90 @@ -799,6 +799,7 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & Physics%control%nqr = get_tracer_index (MODEL_ATMOS, 'rainwat') Physics%control%nqs = get_tracer_index (MODEL_ATMOS, 'snowwat') Physics%control%nqg = get_tracer_index (MODEL_ATMOS, 'graupel') + Physics%control%nqnr = get_tracer_index (MODEL_ATMOS, 'rain_num') Physics%control%nqns = get_tracer_index (MODEL_ATMOS, 'snow_num') @@ -838,13 +839,14 @@ subroutine physics_driver_init (Time, lonb, latb, lon, lat, axes, & if (Physics%control%nqg /= NO_TRACER) then Physics%control%cloud_tracer(Physics%control%nqg ) = .TRUE. endif + if (Physics%control%nqnr /= NO_TRACER) then Physics%control%cloud_tracer(Physics%control%nqnr ) = .TRUE. endif if (Physics%control%nqns /= NO_TRACER) then Physics%control%cloud_tracer(Physics%control%nqns ) = .TRUE. endif - + !---------------------------------------------------------------------- ! define logical variable indicating whether prognostic clouds (using ! tracer fields) are active. @@ -3252,6 +3254,7 @@ end subroutine zero_radturbten subroutine physics_driver_register_restart_scalars (Restart, Phy_restart) type(clouds_from_moist_block_type), intent(inout), target :: Restart type(FmsNetcdfFile_t), intent(inout) :: Phy_restart !< Fms2io fileobj + character(len=8), dimension(1) :: dim_names !< Array of dimension names if (do_moist_processes) then From 993f16087ff223b2a7d750ab1a2f4890c74c8de9 Mon Sep 17 00:00:00 2001 From: Raymond Menzel Date: Fri, 25 Jun 2021 14:19:24 -0400 Subject: [PATCH 7/9] update makefile.am --- Makefile.am | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/Makefile.am b/Makefile.am index b51234f8..a885a358 100644 --- a/Makefile.am +++ b/Makefile.am @@ -134,6 +134,8 @@ libatmos_phys_la_SOURCES = ${top_srcdir}/atmos_shared/atmos_nudge/atmos_nudge.F9 ${top_srcdir}/atmos_param/microphysics/morrison_gettelman_microp.F90 \ ${top_srcdir}/atmos_param/microphysics/gamma_mg.F90 \ ${top_srcdir}/atmos_param/microphysics/micro_mg.F90 \ + ${top_srcdir}/atmos_param/microphysics/micro_mg2.F90 \ + ${top_srcdir}/atmos_param/microphysics/micro_mg2_utils.F90 \ ${top_srcdir}/atmos_param/microphysics/rotstayn_klein_mp.F90 \ ${top_srcdir}/atmos_param/microphysics/ls_cloud_microphysics.F90 \ ${top_srcdir}/atmos_param/microphysics/simple_pdf.F90 \ @@ -783,6 +785,13 @@ ${top_builddir}/atmos_param/microphysics/micro_mg.lo: ${top_srcdir}/atmos_param/ ${top_srcdir}/atmos_param/lscloud_driver/lscloud_types.lo \ ${top_srcdir}/atmos_param/microphysics/simple_pdf.lo \ ${top_srcdir}/atmos_param/physics_radiation_exch/physics_radiation_exch.lo +${top_builddir}/atmos_param/microphysics/micro_mg2.lo: ${top_srcdir}/atmos_param/microphysics/micro_mg2.F90 \ + ${top_srcdir}/atmos_param/microphysics/micro_mg2_utils.lo \ + ${top_srcdir}/atmos_param/microphysics/gamma_mg.lo \ + ${top_srcdir}/atmos_param/lscloud_driver/lscloud_types.lo \ + ${top_srcdir}/atmos_param/physics_radiation_exch/physics_radiation_exch.lo +${top_builddir}/atmos_param/microphysics/micro_mg2_utils.lo: ${top_srcdir}/atmos_param/microphysics/micro_mg2_utils.F90 \ + ${top_srcdir}/atmos_param/microphysics/gamma_mg.lo ${top_builddir}/atmos_param/microphysics/rotstayn_klein_mp.lo: ${top_srcdir}/atmos_param/microphysics/rotstayn_klein_mp.F90 \ ${top_srcdir}/atmos_param/cloud_generator/cloud_generator.lo \ ${top_srcdir}/atmos_shared/tracer_driver/aer_ccn_act/aer_in_act.lo \ @@ -801,7 +810,8 @@ ${top_builddir}/atmos_param/microphysics/ls_cloud_microphysics.lo: ${top_srcdir} ${top_srcdir}/atmos_param/microphysics/rotstayn_klein_mp.lo \ ${top_srcdir}/atmos_param/microphysics/morrison_gettelman_microp.lo \ ${top_srcdir}/atmos_param/microphysics/cldwat2m_micro.lo \ - ${top_srcdir}/atmos_param/microphysics/micro_mg.lo + ${top_srcdir}/atmos_param/microphysics/micro_mg.lo \ + ${top_srcdir}/atmos_param/microphysics/micro_mg2.lo ${top_builddir}/atmos_param/microphysics/simple_pdf.lo: ${top_srcdir}/atmos_param/microphysics/simple_pdf.F90 \ ${top_srcdir}/atmos_param/cloud_generator/betaDistribution.lo \ ${top_srcdir}/atmos_param/lscloud_driver/lscloud_types.lo From 1c4163523051faa9fb9973178e68e2d0ab26e339 Mon Sep 17 00:00:00 2001 From: Raymond Menzel Date: Fri, 25 Jun 2021 16:16:57 -0400 Subject: [PATCH 8/9] add some lines I forgot --- Makefile.am | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Makefile.am b/Makefile.am index a885a358..99e76ee5 100644 --- a/Makefile.am +++ b/Makefile.am @@ -1671,6 +1671,8 @@ morrison_gettelman_microp_mod.mod: ${top_srcdir}/atmos_param/microphysics/morris gamma_mg_mod.mod: ${top_srcdir}/atmos_param/microphysics/gamma_mg.lo micro_mg_mod.mod: ${top_srcdir}/atmos_param/microphysics/micro_mg.lo micro_mg1_5.mod: ${top_srcdir}/atmos_param/microphysics/micro_mg.lo +micro_mg2_mod.mod: ${top_srcdir}/atmos_param/microphysics/micro_mg2.lo +micro_mg2_utils.mod: ${top_srcdir}/atmos_param/microphysics/micro_mg2_utils.lo rotstayn_klein_mp_mod.mod: ${top_srcdir}/atmos_param/microphysics/rotstayn_klein_mp.lo ls_cloud_microphysics_mod.mod: ${top_srcdir}/atmos_param/microphysics/ls_cloud_microphysics.lo simple_pdf_mod.mod: ${top_srcdir}/atmos_param/microphysics/simple_pdf.lo @@ -1983,6 +1985,8 @@ include_HEADERS = atmos_nudge_mod.mod \ gamma_mg_mod.mod \ micro_mg_mod.mod \ micro_mg1_5.mod \ + micro_mg2_mod.mod \ + micro_mg2_utils.mod \ rotstayn_klein_mp_mod.mod \ ls_cloud_microphysics_mod.mod \ simple_pdf_mod.mod \ From 234e657d51d8e6149abcf87c1cf89597868b0b16 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Thu, 5 Aug 2021 17:05:53 -0400 Subject: [PATCH 9/9] Removes the total activation print statement and removes a #ifdef INTERNAL_FILE_NML block --- atmos_param/aerosol_cloud/aerosol_cloud.F90 | 2 -- atmos_param/microphysics/micro_mg2.F90 | 19 ++++--------------- 2 files changed, 4 insertions(+), 17 deletions(-) diff --git a/atmos_param/aerosol_cloud/aerosol_cloud.F90 b/atmos_param/aerosol_cloud/aerosol_cloud.F90 index 3ed0db07..ed3ae2e9 100644 --- a/atmos_param/aerosol_cloud/aerosol_cloud.F90 +++ b/atmos_param/aerosol_cloud/aerosol_cloud.F90 @@ -384,8 +384,6 @@ subroutine determine_activated_aerosol ( & ! downward, the rotstayn-klein microphysics is active, and pdf_clouds ! are not activated; in such a case, no particles are activated. !------------------------------------------------------------------------- - if (mpp_pe() == mpp_root_pe()) & - print*, ' total_activation = ', total_activation call mpp_clock_begin (aero_loop2) if (var_limit_opt == 1) then ! cjg diff --git a/atmos_param/microphysics/micro_mg2.F90 b/atmos_param/microphysics/micro_mg2.F90 index 23abce50..aed9f287 100644 --- a/atmos_param/microphysics/micro_mg2.F90 +++ b/atmos_param/microphysics/micro_mg2.F90 @@ -87,10 +87,10 @@ module micro_mg2_mod use lscloud_types_mod, only: diag_id_type, diag_pt_type use mpp_mod, only: input_nml_file -use fms_mod, only: mpp_pe, file_exist, error_mesg, & - open_namelist_file, FATAL, & +use fms_mod, only: mpp_pe, error_mesg, & + FATAL, & stdlog, write_version_number, & - check_nml_error, close_file, & + check_nml_error, & mpp_root_pe, mpp_chksum !use simple_pdf_mod, only: simple_pdf use sat_vapor_pres_mod, only: lookup_es2, lookup_es3, compute_qs @@ -378,7 +378,7 @@ subroutine micro_mg2_init( & character(128), intent(out) :: errstring ! Output status (non-blank for error return) - INTEGER :: unit, io, ierr, logunit + INTEGER :: io, ierr, logunit !----------------------------------------------------------------------- @@ -409,19 +409,8 @@ subroutine micro_mg2_init( & !--------------------------------------------------------------- ! process namelist !--------------------------------------------------------------- -#ifdef INTERNAL_FILE_NML read (input_nml_file, nml=micro_mg2_nml, iostat=io) ierr = check_nml_error(io,'micro_mg2_nml') -#else - if ( file_exist('input.nml')) then - unit = open_namelist_file () - ierr=1; do while (ierr /= 0) - read (unit, nml=micro_mg2_nml, iostat=io, end=10) - ierr = check_nml_error(io,'micro_mg2_nml') - enddo -10 call close_file (unit) - endif -#endif !----------------------------------------------------------------------- ! write version and namelist to stdlog.