From a4841ab692f738585cdfe19eeb53a7531d5c2d9d Mon Sep 17 00:00:00 2001 From: Jacob Shpund Date: Thu, 4 Apr 2019 14:46:53 +0300 Subject: [PATCH 01/29] A new FSBM version --- Registry/registry.em_shared_collection | 1 + Registry/registry.polrad | 61 + Registry/registry.sbm | 12 +- dyn_em/solve_em.F | 237 +- phys/Makefile | 43 +- phys/module_diag_misc.F | 42 +- phys/module_diagnostics_driver.F | 92 +- phys/module_microphysics_driver.F | 140 +- phys/module_mp_SBM_polar_radar.F | 2972 ++++ phys/module_mp_fast_sbm.F | 17055 ++++++++++++----------- phys/module_physics_init.F | 392 +- 11 files changed, 12087 insertions(+), 8960 deletions(-) create mode 100644 Registry/registry.polrad create mode 100644 phys/module_mp_SBM_polar_radar.F diff --git a/Registry/registry.em_shared_collection b/Registry/registry.em_shared_collection index ca7c06c2bf..80bef30dce 100644 --- a/Registry/registry.em_shared_collection +++ b/Registry/registry.em_shared_collection @@ -18,6 +18,7 @@ include registry.lake include registry.ssib include registry.noahmp include registry.sbm +include registry.polrad include registry.diags include registry.afwa include registry.rasm_diag diff --git a/Registry/registry.polrad b/Registry/registry.polrad new file mode 100644 index 0000000000..8dacaed828 --- /dev/null +++ b/Registry/registry.polrad @@ -0,0 +1,61 @@ + +rconfig integer sbm_diagnostics namelist,physics max_domains 0 rh "sbm_opt" "SBM diagnostic opeion, 1: on" + + +# sbm radar variables +state real - ikjf sbmradar 1 - - - +state real Water_zh ikjf sbmradar 1 - rh03 "Water_zh" "Water Horizontal Refl." "dBZ" +state real Water_zv ikjf sbmradar 1 - rh03 "Water_zv" "Water Vertical Refl." "dBZ" +state real Water_zdr ikjf sbmradar 1 - rh03 "Water_zdr" "Water Differential Refl." "dBZ" +state real Water_ldr ikjf sbmradar 1 - rh03 "Water_ldr" "Water Linear Differntial Refl." "dB" +state real Water_kdp ikjf sbmradar 1 - rh03 "Water_kdp" " Water KDP " "dBZ" +state real Water_crs ikjf sbmradar 1 - rh03 "Water_crs" "Water Cross-Correlation" " " +state real Hail_zh ikjf sbmradar 1 - rh03 "Hail_zh" "Hail Horizontal Refl." "dBZ" +state real Hail_zv ikjf sbmradar 1 - rh03 "Hail_zv" "Hail Vertical Refl." "dBZ" +state real Hail_zdr ikjf sbmradar 1 - rh03 "Hail_zdr" "Hail Differential Refl." "dBZ" +state real Hail_ldr ikjf sbmradar 1 - rh03 "Hail_ldr" "Hail Linear Differntial Refl." "dB" +state real Hail_kdp ikjf sbmradar 1 - rh03 "Hail_kdp" " Hail KDP " "deg km^-1" +state real Hail_crs ikjf sbmradar 1 - rh03 "Hail_crs" "Hail Cross-Correlation" " " +state real Freezing_D_zh ikjf sbmradar 1 - rh03 "Freezing_D_zh" "F.Dx Horizontal Refl." "dBZ" +state real Freezing_D_zv ikjf sbmradar 1 - rh03 "Freezing_D_zv" "F.Dx Vertical Refl." "dBZ" +state real Freezing_D_zdr ikjf sbmradar 1 - rh03 "Freezing_D_zdr" "F.Dx Differential Refl." "dBZ" +state real Freezing_D_ldr ikjf sbmradar 1 - rh03 "Freezing_D_ldr" "F.Dx Linear Differntial Refl." "dB" +state real Freezing_D_kdp ikjf sbmradar 1 - rh03 "Freezing_D_kdp" " F.Dx KDP " "deg km^-1" +state real Freezing_D_crs ikjf sbmradar 1 - rh03 "Freezing_D_crs" "F.Dx Cross-Correlation" " " +state real Graupel_zh ikjf sbmradar 1 - rh03 "Graupel_zh" "Graupel Horizontal Refl." "dBZ" +state real Graupel_zv ikjf sbmradar 1 - rh03 "Graupel_zv" "Graupel Vertical Refl." "dBZ" +state real Graupel_zdr ikjf sbmradar 1 - rh03 "Graupel_zdr" "Graupel Differential Refl." "dBZ" +state real Graupel_ldr ikjf sbmradar 1 - rh03 "Graupel_ldr" "Graupel Linear Differntial Refl." "dB" +state real Graupel_kdp ikjf sbmradar 1 - rh03 "Graupel_kdp" " Graupel KDP " "deg km^-1" +state real Graupel_crs ikjf sbmradar 1 - rh03 "Graupel_crs" "Graupel Cross-Correlation" " " +state real Plates_zh ikjf sbmradar 1 - rh03 "Plates_zh" "Plates Horizontal Refl." "dBZ" +state real Plates_zv ikjf sbmradar 1 - rh03 "Plates_zv" "Plates Vertical Refl." "dBZ" +state real Plates_zdr ikjf sbmradar 1 - rh03 "Plates_zdr" "Plates Differential Refl." "dBZ" +state real Plates_ldr ikjf sbmradar 1 - rh03 "Plates_ldr" "Plates Linear Differntial Refl." "dB" +state real Plates_kdp ikjf sbmradar 1 - rh03 "Plates_kdp" " Plates KDP " "deg km^-1" +state real Plates_crs ikjf sbmradar 1 - rh03 "Plates_crs" "Plates Cross-Correlation" " " +state real Dendrites_zh ikjf sbmradar 1 - rh03 "Dendrites_zh" "Dendrites Horizontal Refl." "dBZ" +state real Dendrites_zv ikjf sbmradar 1 - rh03 "Dendrites_zv" "Dendrites Vertical Refl." "dBZ" +state real Dendrites_zdr ikjf sbmradar 1 - rh03 "Dendrites_zdr" "Dendrites Differential Refl." "dBZ" +state real Dendrites_ldr ikjf sbmradar 1 - rh03 "Dendrites_ldr" "Dendrites Linear Differntial Refl." "dB" +state real Dendrites_kdp ikjf sbmradar 1 - rh03 "Dendrites_kdp" " Dendrites KDP " "deg km^-1" +state real Dendrites_crs ikjf sbmradar 1 - rh03 "Dendrites_crs" "Dendrites Cross-Correlation" " " +state real Snow_zh ikjf sbmradar 1 - rh03 "Snow_zh" "Snow Horizontal Refl." "dBZ" +state real Snow_zv ikjf sbmradar 1 - rh03 "Snow_zv" "Snow Vertical Refl." "dBZ" +state real Snow_zdr ikjf sbmradar 1 - rh03 "Snow_zdr" "Snow Differential Refl." "dBZ" +state real Snow_ldr ikjf sbmradar 1 - rh03 "Snow_ldr" "Snow Linear Differntial Refl." "dB" +state real Snow_kdp ikjf sbmradar 1 - rh03 "Snow_kdp" " Snow KDP " "deg km^-1" +state real Snow_crs ikjf sbmradar 1 - rh03 "Snow_crs" "Snow Cross-Correlation" " " +state real Columns_zh ikjf sbmradar 1 - rh03 "Columns_zh" "Columns Horizontal Refl." "dBZ" +state real Columns_zv ikjf sbmradar 1 - rh03 "Columns_zv" "Columns Vertical Refl." "dBZ" +state real Columns_zdr ikjf sbmradar 1 - rh03 "Columns_zdr" "Columns Differential Refl." "dBZ" +state real Columns_ldr ikjf sbmradar 1 - rh03 "Columns_ldr" "Columns Linear Differntial Refl." "dB" +state real Columns_kdp ikjf sbmradar 1 - rh03 "Columns_kdp" " Columns KDP " "deg km^-1" +state real Columns_crs ikjf sbmradar 1 - rh03 "Columns_crs" "Columns Cross-Correlation" " " +state real Total_zh ikjf sbmradar 1 - rh03 "Total_zh" "Total Horizontal Refl." "dBZ" +state real Total_zv ikjf sbmradar 1 - rh03 "Total_zv" "Total Vertical Refl." "dBZ" +state real Total_zdr ikjf sbmradar 1 - rh03 "Total_zdr" "Total Differential Refl." "dBZ" +state real Total_ldr ikjf sbmradar 1 - rh03 "Total_ldr" "Total Linear Differntial Refl." "dB" +state real Total_kdp ikjf sbmradar 1 - rh03 "Total_kdp" " Total KDP " "deg km^-1" +state real Total_crs ikjf sbmradar 1 - rh03 "Total_crs" "Total Cross-Correlation" " " +package sbm_output sbm_diagnostics==1 - sbmradar:Water_zh,Water_zv,Water_zdr,Water_ldr,Water_kdp,Water_crs,Hail_zh,Hail_zv,Hail_zdr,Hail_ldr,Hail_kdp,Hail_crs,Freezing_D_zh,Freezing_D_zv,Freezing_D_zdr,Freezing_D_ldr,Freezing_D_kdp,Freezing_D_crs,Graupel_zh,Graupel_zv,Graupel_zdr,Graupel_ldr,Graupel_kdp,Graupel_crs,Plates_zh,Plates_zv,Plates_zdr,Plates_ldr,Plates_kdp,Plates_crs,Dendrites_zh,Dendrites_zv,Dendrites_zdr,Dendrites_ldr,Dendrites_kdp,,Dendrites_crs,Snow_zh,Snow_zv,Snow_zdr,Snow_ldr,Snow_kdp,Snow_crs,Columns_zh,Columns_zv,Columns_zdr,Columns_ldr,Columns_kdp,Columns_crs,Total_zh,Total_zv,Total_zdr,Total_ldr,Total_kdp,Total_crs diff --git a/Registry/registry.sbm b/Registry/registry.sbm index 5160b93171..2a519592b2 100644 --- a/Registry/registry.sbm +++ b/Registry/registry.sbm @@ -132,6 +132,16 @@ state real ff8i30 ikjftb scalar 1 - h3rusdf= state real ff8i31 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i31" "aerosols bin 31" "# kg-1" state real ff8i32 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i32" "aerosols bin 32" "# kg-1" state real ff8i33 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i33" "aerosols bin 33" "# kg-1" +state real ff8i34 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i34" "aerosols bin 34" "# kg-1" +state real ff8i35 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i35" "aerosols bin 35" "# kg-1" +state real ff8i36 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i36" "aerosols bin 36" "# kg-1" +state real ff8i37 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i37" "aerosols bin 37" "# kg-1" +state real ff8i38 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i38" "aerosols bin 38" "# kg-1" +state real ff8i39 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i39" "aerosols bin 39" "# kg-1" +state real ff8i40 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i40" "aerosols bin 40" "# kg-1" +state real ff8i41 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i41" "aerosols bin 41" "# kg-1" +state real ff8i42 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i42" "aerosols bin 42" "# kg-1" +state real ff8i43 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff8i43" "aerosols bin 43" "# kg-1" state real ff2i01 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff2i01" "ice/columns bin 1" "# kg kg-1" state real ff2i02 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff2i02" "ice/columns bin 2" "# kg kg-1" state real ff2i03 ikjftb scalar 1 - h3rusdf=(bdy_interp:dt) "ff2i03" "ice/columns bin 3" "# kg kg-1" @@ -305,5 +315,5 @@ state real kext_ft_qs ikj misc 1 - rh05 state real kext_ft_qg ikj misc 1 - rh05 "KEXT_FT_QG" " Extinction Adj. Coefficient for graupel " "m-1" state real height ikj misc 1 - rh5 "HEIGHT" " Height " "m" state real tempc ikj misc 1 - rh5 "TEMPC" " Temperature " "C" -package fast_khain_lynn mp_physics==30 - moist:qv,qc,qr,qi,qs,qg;scalar:ff1i01,ff1i02,ff1i03,ff1i04,ff1i05,ff1i06,ff1i07,ff1i08,ff1i09,ff1i10,ff1i11,ff1i12,ff1i13,ff1i14,ff1i15,ff1i16,ff1i17,ff1i18,ff1i19,ff1i20,ff1i21,ff1i22,ff1i23,ff1i24,ff1i25,ff1i26,ff1i27,ff1i28,ff1i29,ff1i30,ff1i31,ff1i32,ff1i33,ff5i01,ff5i02,ff5i03,ff5i04,ff5i05,ff5i06,ff5i07,ff5i08,ff5i09,ff5i10,ff5i11,ff5i12,ff5i13,ff5i14,ff5i15,ff5i16,ff5i17,ff5i18,ff5i19,ff5i20,ff5i21,ff5i22,ff5i23,ff5i24,ff5i25,ff5i26,ff5i27,ff5i28,ff5i29,ff5i30,ff5i31,ff5i32,ff5i33,ff6i01,ff6i02,ff6i03,ff6i04,ff6i05,ff6i06,ff6i07,ff6i08,ff6i09,ff6i10,ff6i11,ff6i12,ff6i13,ff6i14,ff6i15,ff6i16,ff6i17,ff6i18,ff6i19,ff6i20,ff6i21,ff6i22,ff6i23,ff6i24,ff6i25,ff6i26,ff6i27,ff6i28,ff6i29,ff6i30,ff6i31,ff6i32,ff6i33,ff8i01,ff8i02,ff8i03,ff8i04,ff8i05,ff8i06,ff8i07,ff8i08,ff8i09,ff8i10,ff8i11,ff8i12,ff8i13,ff8i14,ff8i15,ff8i16,ff8i17,ff8i18,ff8i19,ff8i20,ff8i21,ff8i22,ff8i23,ff8i24,ff8i25,ff8i26,ff8i27,ff8i28,ff8i29,ff8i30,ff8i31,ff8i32,ff8i33,qnn,qnc,qnr,qni,qns,qng,effr,ice_effr,tot_effr,th_old,qv_old,tempc,height +package fast_khain_lynn_shpund mp_physics==30 - moist:qv,qc,qr,qi,qs,qg;scalar:ff1i01,ff1i02,ff1i03,ff1i04,ff1i05,ff1i06,ff1i07,ff1i08,ff1i09,ff1i10,ff1i11,ff1i12,ff1i13,ff1i14,ff1i15,ff1i16,ff1i17,ff1i18,ff1i19,ff1i20,ff1i21,ff1i22,ff1i23,ff1i24,ff1i25,ff1i26,ff1i27,ff1i28,ff1i29,ff1i30,ff1i31,ff1i32,ff1i33,ff5i01,ff5i02,ff5i03,ff5i04,ff5i05,ff5i06,ff5i07,ff5i08,ff5i09,ff5i10,ff5i11,ff5i12,ff5i13,ff5i14,ff5i15,ff5i16,ff5i17,ff5i18,ff5i19,ff5i20,ff5i21,ff5i22,ff5i23,ff5i24,ff5i25,ff5i26,ff5i27,ff5i28,ff5i29,ff5i30,ff5i31,ff5i32,ff5i33,ff6i01,ff6i02,ff6i03,ff6i04,ff6i05,ff6i06,ff6i07,ff6i08,ff6i09,ff6i10,ff6i11,ff6i12,ff6i13,ff6i14,ff6i15,ff6i16,ff6i17,ff6i18,ff6i19,ff6i20,ff6i21,ff6i22,ff6i23,ff6i24,ff6i25,ff6i26,ff6i27,ff6i28,ff6i29,ff6i30,ff6i31,ff6i32,ff6i33,ff8i01,ff8i02,ff8i03,ff8i04,ff8i05,ff8i06,ff8i07,ff8i08,ff8i09,ff8i10,ff8i11,ff8i12,ff8i13,ff8i14,ff8i15,ff8i16,ff8i17,ff8i18,ff8i19,ff8i20,ff8i21,ff8i22,ff8i23,ff8i24,ff8i25,ff8i26,ff8i27,ff8i28,ff8i29,ff8i30,ff8i31,ff8i32,ff8i33,ff8i34,ff8i35,ff8i36,ff8i37,ff8i38,ff8i39,ff8i40,ff8i41,ff8i42,ff8i43,qnn,qnc,qnr,qni,qns,qng,effr,ice_effr,tot_effr,th_old,qv_old,tempc,height package full_khain_lynn mp_physics==32 - moist:qv,qc,qr,qi,qic,qip,qid,qs,qg,qh;scalar:ff1i01,ff1i02,ff1i03,ff1i04,ff1i05,ff1i06,ff1i07,ff1i08,ff1i09,ff1i10,ff1i11,ff1i12,ff1i13,ff1i14,ff1i15,ff1i16,ff1i17,ff1i18,ff1i19,ff1i20,ff1i21,ff1i22,ff1i23,ff1i24,ff1i25,ff1i26,ff1i27,ff1i28,ff1i29,ff1i30,ff1i31,ff1i32,ff1i33,ff5i01,ff5i02,ff5i03,ff5i04,ff5i05,ff5i06,ff5i07,ff5i08,ff5i09,ff5i10,ff5i11,ff5i12,ff5i13,ff5i14,ff5i15,ff5i16,ff5i17,ff5i18,ff5i19,ff5i20,ff5i21,ff5i22,ff5i23,ff5i24,ff5i25,ff5i26,ff5i27,ff5i28,ff5i29,ff5i30,ff5i31,ff5i32,ff5i33,ff6i01,ff6i02,ff6i03,ff6i04,ff6i05,ff6i06,ff6i07,ff6i08,ff6i09,ff6i10,ff6i11,ff6i12,ff6i13,ff6i14,ff6i15,ff6i16,ff6i17,ff6i18,ff6i19,ff6i20,ff6i21,ff6i22,ff6i23,ff6i24,ff6i25,ff6i26,ff6i27,ff6i28,ff6i29,ff6i30,ff6i31,ff6i32,ff6i33,ff8i01,ff8i02,ff8i03,ff8i04,ff8i05,ff8i06,ff8i07,ff8i08,ff8i09,ff8i10,ff8i11,ff8i12,ff8i13,ff8i14,ff8i15,ff8i16,ff8i17,ff8i18,ff8i19,ff8i20,ff8i21,ff8i22,ff8i23,ff8i24,ff8i25,ff8i26,ff8i27,ff8i28,ff8i29,ff8i30,ff8i31,ff8i32,ff8i33,ff2i01,ff2i02,ff2i03,ff2i04,ff2i05,ff2i06,ff2i07,ff2i08,ff2i09,ff2i10,ff2i11,ff2i12,ff2i13,ff2i14,ff2i15,ff2i16,ff2i17,ff2i18,ff2i19,ff2i20,ff2i21,ff2i22,ff2i23,ff2i24,ff2i25,ff2i26,ff2i27,ff2i28,ff2i29,ff2i30,ff2i31,ff2i32,ff2i33,ff3i01,ff3i02,ff3i03,ff3i04,ff3i05,ff3i06,ff3i07,ff3i08,ff3i09,ff3i10,ff3i11,ff3i12,ff3i13,ff3i14,ff3i15,ff3i16,ff3i17,ff3i18,ff3i19,ff3i20,ff3i21,ff3i22,ff3i23,ff3i24,ff3i25,ff3i26,ff3i27,ff3i28,ff3i29,ff3i30,ff3i31,ff3i32,ff3i33,ff4i01,ff4i02,ff4i03,ff4i04,ff4i05,ff4i06,ff4i07,ff4i08,ff4i09,ff4i10,ff4i11,ff4i12,ff4i13,ff4i14,ff4i15,ff4i16,ff4i17,ff4i18,ff4i19,ff4i20,ff4i21,ff4i22,ff4i23,ff4i24,ff4i25,ff4i26,ff4i27,ff4i28,ff4i29,ff4i30,ff4i31,ff4i32,ff4i33,ff7i01,ff7i02,ff7i03,ff7i04,ff7i05,ff7i06,ff7i07,ff7i08,ff7i09,ff7i10,ff7i11,ff7i12,ff7i13,ff7i14,ff7i15,ff7i16,ff7i17,ff7i18,ff7i19,ff7i20,ff7i21,ff7i22,ff7i23,ff7i24,ff7i25,ff7i26,ff7i27,ff7i28,ff7i29,ff7i30,ff7i31,ff7i32,ff7i33,qnn,qnc,qnr,qni,qnic,qnip,qnid,qns,qng,qnh,effr,ice_effr,tot_effr,qic_effr,qip_effr,qid_effr;state:kext_ql,kext_qic,kext_qip,kext_qid,kext_qs,kext_qg,kext_qh,kext_qa,kext_ft_qic,kext_ft_qip,kext_ft_qid,kext_ft_qs,kext_ft_qg,th_old,qv_old,tempc,height diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F index 594712b85f..7866c67502 100644 --- a/dyn_em/solve_em.F +++ b/dyn_em/solve_em.F @@ -117,17 +117,17 @@ SUBROUTINE solve_em ( grid , config_flags & LOGICAL :: specified_bdy, channel_bdy REAL :: t_new, time_duration_of_lbcs - + ! Changes in tendency at this timestep real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: h_tendency, & z_tendency - + ! Whether advection should produce decoupled horizontal and vertical advective tendency outputs LOGICAL :: tenddec - + ! Flag for producing diagnostic fields (e.g., radar reflectivity) LOGICAL :: diag_flag - + #if (WRF_CHEM == 1) ! Index cross-referencing array for tendency accumulation INTEGER, DIMENSION( num_chem ) :: adv_ct_indices @@ -142,7 +142,7 @@ SUBROUTINE solve_em ( grid , config_flags & ! time. Potential problem on stack-limited architectures: increases ! amount of data on program stack by making these automatic arrays. - INTEGER :: rc + INTEGER :: rc INTEGER :: number_of_small_timesteps, rk_step INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2 ! for prints/plots only INTEGER :: idum1, idum2, dynamics_option @@ -189,27 +189,27 @@ SUBROUTINE solve_em ( grid , config_flags & ! !
 ! solve_em is the main driver for advancing a grid a single timestep.
-! It is a mediation-layer routine -> DM and SM calls are made where 
-! needed for parallel processing.  
+! It is a mediation-layer routine -> DM and SM calls are made where
+! needed for parallel processing.
 !
 ! solve_em can integrate the equations using 3 time-integration methods
-!      
+!
 !    - 3rd order Runge-Kutta time integration (recommended)
-!      
+!
 !    - 2nd order Runge-Kutta time integration
-!      
+!
 ! The main sections of solve_em are
-!     
+!
 ! (1) Runge-Kutta (RK) loop
-!     
+!
 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
 !     model state variables during the first RK sub-step (loop)
-!     
+!
 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
-!     
+!
 ! (4) scalar advance for moist and chem scalar variables (and TKE)
 !     within the RK sub-steps.
-!     
+!
 ! (5) time-split physics (after the RK step), currently this includes
 !     only microphyics
 !
@@ -234,7 +234,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              ipsx, ipex, jpsx, jpex, kpsx, kpex,    &
                              imsy, imey, jmsy, jmey, kmsy, kmey,    &
                              ipsy, ipey, jpsy, jpey, kpsy, kpey )
- 
+
    CALL get_ijk_from_subgrid (  grid ,                   &
                              sids, side, sjds, sjde, skds, skde,    &
                              sims, sime, sjms, sjme, skms, skme,    &
@@ -393,7 +393,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    dts = grid%dt/float(num_sound_steps)
 
    IF (config_flags%use_adaptive_time_step) THEN
-  
+
      CALL get_wrf_debug_level( debug_level )
      IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
 #ifdef DM_PARALLEL
@@ -456,7 +456,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP END PARALLEL DO
 
      !  Now that we have initialized the moist_old values with P_Qv for
-     !  computing a moist t_tendf after rk_step part2, fill in the halo 
+     !  computing a moist t_tendf after rk_step part2, fill in the halo
      !  and period boundaries.
 
 #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
@@ -509,7 +509,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    !  each part of the timestep
 
      dtm = grid%dt
-     IF ( rk_order == 1 ) THEN   
+     IF ( rk_order == 1 ) THEN
 
        write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
        CALL wrf_error_fatal( wrf_err_message )
@@ -550,7 +550,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      END IF
 
 !  Ensure that polar meridional velocity is zero
-     IF (config_flags%polar) THEN 
+     IF (config_flags%polar) THEN
        !$OMP PARALLEL DO   &
        !$OMP PRIVATE ( ij )
        DO ij = 1 , grid%num_tiles
@@ -570,7 +570,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
        !$OMP END PARALLEL DO
      END IF
 !
-!  Time level t is in the *_2 variable in the first part 
+!  Time level t is in the *_2 variable in the first part
 !  of the step, and in the *_1 variable after the predictor.
 !  the latest predicted values are stored in the *_2 variables.
 !
@@ -605,15 +605,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #ifdef DM_PARALLEL
 !-----------------------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the 
-!         fact that we are carrying the uncoupled variables 
+!  Note:  the small size of this halo exchange reflects the
+!         fact that we are carrying the uncoupled variables
 !         as state variables in the mass coordinate model, as
 !         opposed to the coupled variables as in the height
 !         coordinate model.
 !
 !                           * * * * *
 !         *        * * *    * * * * *
-!       * + *      * + *    * * + * * 
+!       * + *      * + *    * * + * *
 !         *        * * *    * * * * *
 !                           * * * * *
 !
@@ -636,7 +636,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_A.inc"
 #endif
 
-! set boundary conditions on variables 
+! set boundary conditions on variables
 ! from big_step_prep for use in big_step_proc
 
 #ifdef DM_PARALLEL
@@ -651,7 +651,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
        CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
 
-       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      & 
+       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      &
                               grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p,        &
                               ids, ide, jds, jde, kds, kde,      &
                               ims, ime, jms, jme, kms, kme,      &
@@ -674,7 +674,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               grid%j_start(ij), grid%j_end(ij),        &
                               k_start, k_end                )
 
-       IF (config_flags%polar) THEN 
+       IF (config_flags%polar) THEN
 
 !-------------------------------------------------------
 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
@@ -686,14 +686,14 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               grid%i_start(ij), grid%i_end(ij), &
                               grid%j_start(ij), grid%j_end(ij), &
                               k_start, k_end                   )
- 
+
          CALL pole_point_bc ( grid%v_2,                      &
                               ids, ide, jds, jde, kds, kde,     &
                               ims, ime, jms, jme, kms, kme,     &
                               grid%i_start(ij), grid%i_end(ij), &
                               grid%j_start(ij), grid%j_end(ij), &
                               k_start, k_end                   )
- 
+
 !-------------------------------------------------------
 ! end lat-lon grid pole-point (v) specification
 !-------------------------------------------------------
@@ -778,8 +778,8 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              , cu_act_flag , hol , th_phy       &
                              , pi_phy , p_phy , grid%t_phy      &
                              , dz8w , p8w , t8w                 &
-                             , nba_mij, num_nba_mij             & !JDM 
-                             , nba_rij, num_nba_rij             & !JDM  
+                             , nba_mij, num_nba_mij             & !JDM
+                             , nba_rij, num_nba_rij             & !JDM
                              , ids, ide, jds, jde, kds, kde     &
                              , ims, ime, jms, jme, kms, kme     &
                              , ips, ipe, jps, jpe, kps, kpe     &
@@ -840,7 +840,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
            grid%max_vert_cfl = max_vert_cfl_tmp(ij)
          ENDIF
        END DO
-     
+
        IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
          grid%max_cfl_val = grid%max_horiz_cfl
        ENDIF
@@ -854,7 +854,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP PRIVATE ( ij )
      DO ij = 1 , grid%num_tiles
 
-       IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN 
+       IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN
 
          CALL relax_bdy_dry ( config_flags,                                &
                               grid%u_save, grid%v_save, ph_save, grid%t_save,             &
@@ -899,7 +899,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                             grid%j_start(ij), grid%j_end(ij),                &
                             k_start, k_end                                  )
 
-       IF( config_flags%specified .or. config_flags%nested ) THEN 
+       IF( config_flags%specified .or. config_flags%nested ) THEN
          CALL spec_bdy_dry ( config_flags,                                    &
                              grid%ru_tend, grid%rv_tend, ph_tend, t_tend,               &
                              rw_tend, mu_tend,                                &
@@ -927,11 +927,11 @@ SUBROUTINE solve_em ( grid , config_flags  &
        ENDIF
 
 !---------------------------------------------------------------------------------------------
-! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS 
+! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS
 ! pattern passed in for perturbing the specified boundry conditions.  If peturb_bdy=2, user
 ! must provide pattern.  mu_2, mub, msf* also passed in for coupling needed for tendecies.
 !---------------------------------------------------------------------------------------------
-       IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN 
+       IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN
          CALL spec_bdy_dry_perturb ( config_flags,                                 &
                              grid%ru_tend, grid%rv_tend, t_tend,                   &
                              grid%mu_2, grid%mub, grid%c1h, grid%c2h,              &
@@ -945,7 +945,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                &
                              grid%j_start(ij), grid%j_end(ij),                &
                              k_start, k_end                                  )
-     
+
        ENDIF
 
        IF( config_flags%specified .and. config_flags%perturb_bdy==2 ) THEN
@@ -962,7 +962,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                &
                              grid%j_start(ij), grid%j_end(ij),                &
                              k_start, k_end                                  )
-  
+
        ENDIF
 
      END DO
@@ -973,15 +973,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 ! (3) Small (acoustic,sound) steps.
 !
-!    Several acoustic steps are taken each RK pass.  A small step 
-!    sequence begins with calculating perturbation variables 
-!    and coupling them to the column dry-air-mass mu 
+!    Several acoustic steps are taken each RK pass.  A small step
+!    sequence begins with calculating perturbation variables
+!    and coupling them to the column dry-air-mass mu
 !    (call to small_step_prep).  This is followed by computing
 !    coefficients for the vertically implicit part of the
-!    small timestep (call to calc_coef_w).  
+!    small timestep (call to calc_coef_w).
 !
 !    The small steps are taken
-!    in the named loop "small_steps:".  In the small_steps loop, first 
+!    in the named loop "small_steps:".  In the small_steps loop, first
 !    the horizontal momentum (u and v) are advanced (call to advance_uv),
 !    next mu and theta are advanced (call to advance_mu_t) followed by
 !    advancing w and the geopotential (call to advance_w).  Diagnostic
@@ -1001,7 +1001,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
     ! Calculate coefficients for the vertically implicit acoustic/gravity wave
     ! integration.  We only need calculate these for the first pass through -
     ! the predictor step.  They are reused as is for the corrector step.
-    ! For third-order RK, we need to recompute these after the first 
+    ! For third-order RK, we need to recompute these after the first
     ! predictor because we may have changed the small timestep -> grid%dts.
 
        CALL wrf_debug ( 200 , ' call small_step_prep ' )
@@ -1025,7 +1025,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                        &
                              grid%j_start(ij), grid%j_end(ij),                        &
                              k_start    , k_end                                       )
- 
+
        CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
                         grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
                         grid%mu_2, grid%muts,                       &
@@ -1062,15 +1062,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #ifdef DM_PARALLEL
 !-----------------------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the 
-!         fact that we are carrying the uncoupled variables 
+!  Note:  the small size of this halo exchange reflects the
+!         fact that we are carrying the uncoupled variables
 !         as state variables in the mass coordinate model, as
 !         opposed to the coupled variables as in the height
 !         coordinate model.
 !
 !                              * * * * *
 !            *        * * *    * * * * *
-!          * + *      * + *    * * + * * 
+!          * + *      * + *    * * + * *
 !            *        * * *    * * * * *
 !                              * * * * *
 !
@@ -1185,7 +1185,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_END(set_phys_bc2_tim)
      small_steps : DO iteration = 1 , number_of_small_timesteps
 
-       ! Boundary condition time (or communication time).  
+       ! Boundary condition time (or communication time).
 #ifdef DM_PARALLEL
 #      include "PERIOD_BDY_EM_B.inc"
 #endif
@@ -1363,7 +1363,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
 
          grid%muts = grid%mut + grid%mu_2  ! reset muts using filtered mu_2
- 
+
        END IF
 
 !-----------------------------------------------------------
@@ -1644,7 +1644,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
        CALL wrf_debug ( 200 , ' call rk_small_finish' )
 
-      ! change time-perturbation variables back to 
+      ! change time-perturbation variables back to
       ! full perturbation variables.
       ! first get updated mu at u and v points
 
@@ -1661,7 +1661,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
        CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1,     &
                                grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1,    &
                                grid%mu_2, grid%mu_1,                       &
-                               grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs,  & 
+                               grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs,  &
                                grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
                                grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
                                grid%u_save, grid%v_save, w_save,           &
@@ -1716,7 +1716,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                  ips, ipe, jps, jpe,                &
                                  grid%i_start(ij), grid%i_end(ij),  &
                                  grid%j_start(ij), grid%j_end(ij) )
- 
+
        END IF
 
 BENCH_END(small_step_finish_tim)
@@ -1725,7 +1725,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP END PARALLEL DO
 
 !-----------------------------------------------------------
-!  polar filter for full dynamics variables and time-averaged mass fluxes 
+!  polar filter for full dynamics variables and time-averaged mass fluxes
 !-----------------------------------------------------------
 
      IF (config_flags%polar) THEN
@@ -1758,7 +1758,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      END IF
 
 !-----------------------------------------------------------
-!  end polar filter for full dynamics variables and time-averaged mass fluxes 
+!  end polar filter for full dynamics variables and time-averaged mass fluxes
 !-----------------------------------------------------------
 
 !-----------------------------------------------------------------------
@@ -1869,7 +1869,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #else
          WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
          CALL wrf_error_fatal(TRIM(wrf_err_message))
-#endif   
+#endif
   endif
 #endif
 
@@ -1951,7 +1951,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                         grid%i_start(ij), grid%i_end(ij),                &
                                         grid%j_start(ij), grid%j_end(ij),                &
                                         k_start    , k_end                              )
-             END DO 
+             END DO
            ENDIF
          END DO
          !$OMP END PARALLEL DO
@@ -2013,7 +2013,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                         grid%i_start(ij), grid%i_end(ij),                &
                                         grid%j_start(ij), grid%j_end(ij),                &
                                         k_start    , k_end                              )
-             END DO 
+             END DO
            ENDIF
          END DO
          !$OMP END PARALLEL DO
@@ -2083,11 +2083,11 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!          * * * * *            
-!          * * * * *            
-!          * * + * *            
-!          * * * * *            
-!          * * * * *            
+!          * * * * *
+!          * * * * *
+!          * * + * *
+!          * * * * *
+!          * * * * *
 !
 ! ru_m         x
 ! rv_m         x
@@ -2108,7 +2108,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !    For the moist and chem variables, each one is advanced
 !    individually, using named loops "moist_variable_loop:"
 !    and "chem_variable_loop:".  Each RK substep begins by
-!    calculating the advective tendency, and, for the first RK step, 
+!    calculating the advective tendency, and, for the first RK step,
 !    3D mixing (calling rk_scalar_tend) followed by an update
 !    of the scalar (calling rk_update_scalar).
 !

@@ -2132,7 +2132,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                tenddec = .false.
 
 BENCH_START(rk_scalar_tend_tim)
-               CALL rk_scalar_tend (  im, im, config_flags, tenddec,         & 
+               CALL rk_scalar_tend (  im, im, config_flags, tenddec,         &
                            rk_step, dt_rk,                                   &
                            grid%ru_m, grid%rv_m, grid%ww_m,                  &
                            grid%muts, grid%mub, grid%mu_1,                   &
@@ -2141,10 +2141,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
                            moist_old(ims,kms,jms,im),                        &
                            moist(ims,kms,jms,im),                            &
                            moist_tend(ims,kms,jms,im),                       &
-                           advect_tend,h_tendency,z_tendency,grid%rqvften,   & 
+                           advect_tend,h_tendency,z_tendency,grid%rqvften,   &
                            grid%qv_base, .true., grid%fnm, grid%fnp,         &
                            grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
-                           grid%msfvy, grid%msftx,grid%msfty,                & 
+                           grid%msfvy, grid%msftx,grid%msfty,                &
                            grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
                            grid%kvdif, grid%xkhh,                            &
                            grid%diff_6th_opt, grid%diff_6th_factor,          &
@@ -2160,7 +2160,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
                IF( rk_step == 1 .AND. config_flags%use_q_diabatic == 1 )THEN
                IF( im.eq.p_qv .or. im.eq.p_qc )THEN
-                   CALL q_diabatic_add  ( im, im,            & 
+                   CALL q_diabatic_add  ( im, im,            &
                            dt_rk, grid%mut,                  &
                            grid%c1h, grid%c2h,               &
                            grid%qv_diabatic,                 &
@@ -2177,10 +2177,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_END(rk_scalar_tend_tim)
 
 BENCH_START(rlx_bdy_scalar_tim)
-               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN 
+               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
                  IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
                     ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
-                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            & 
+                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            &
                                      moist(ims,kms,jms,im),  grid%mut,         &
                                      grid%c1h, grid%c2h,                       &
                                      moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
@@ -2230,12 +2230,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                scalar_2=moist(ims,kms,jms,im),                         &
                                sc_tend=moist_tend(ims,kms,jms,im),                     &
                                advect_tend=advect_tend,                                &
-                               h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                               h_tendency=h_tendency, z_tendency=z_tendency,           &
                                msftx=grid%msftx,msfty=grid%msfty,                      &
                                c1=grid%c1h, c2=grid%c2h,                               &
                                mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                               config_flags=config_flags, tenddec=tenddec,             & 
+                               config_flags=config_flags, tenddec=tenddec,             &
                                ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2243,7 +2243,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                kts=k_start    , kte=k_end                              )
                IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
                IF( im.eq.p_qv .or. im.eq.p_qc )THEN
-                   CALL q_diabatic_subtr( im, im,            & 
+                   CALL q_diabatic_subtr( im, im,            &
                            dt_rk,                            &
                            grid%qv_diabatic,                 &
                            grid%qc_diabatic,                 &
@@ -2300,7 +2300,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
            CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
            tenddec = .false.
-           CALL rk_scalar_tend ( 1, 1, config_flags, tenddec,                      & 
+           CALL rk_scalar_tend ( 1, 1, config_flags, tenddec,                      &
                             rk_step, dt_rk,                                        &
                             grid%ru_m, grid%rv_m, grid%ww_m,                       &
                             grid%muts, grid%mub, grid%mu_1,                        &
@@ -2309,7 +2309,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                             grid%tke_1,                                            &
                             grid%tke_2,                                            &
                             tke_tend(ims,kms,jms),                                 &
-                            advect_tend,h_tendency,z_tendency,grid%rqvften,        & 
+                            advect_tend,h_tendency,z_tendency,grid%rqvften,        &
                             grid%qv_base, .false., grid%fnm, grid%fnp,             &
                             grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,     &
                             grid%msfvy, grid%msftx,grid%msfty,                     &
@@ -2340,12 +2340,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_2=grid%tke_2,                                    &
                                   sc_tend=tke_tend(ims,kms,jms),                          &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             & 
+                                  config_flags=config_flags, tenddec=tenddec,             &
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2392,7 +2392,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
              tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
                         ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
-             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                & 
+             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                &
                               rk_step, dt_rk,                                    &
                               grid%ru_m, grid%rv_m, grid%ww_m,                   &
                               grid%muts, grid%mub, grid%mu_1,                    &
@@ -2401,7 +2401,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               chem_old(ims,kms,jms,ic),                          &
                               chem(ims,kms,jms,ic),                              &
                               chem_tend(ims,kms,jms,ic),                         &
-                              advect_tend,h_tendency,z_tendency,grid%rqvften,    & 
+                              advect_tend,h_tendency,z_tendency,grid%rqvften,    &
                               grid%qv_base, .false., grid%fnm, grid%fnp,         &
                               grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                               grid%msfvy, grid%msftx,grid%msfty,                 &
@@ -2421,7 +2421,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! Currently, chemistry species with specified boundaries (i.e. the mother
 ! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
 !
            IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
              IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
@@ -2480,12 +2480,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   advh_t=advh_ct(ims,kms,jms,adv_ct_indices(ic)),         &
                                   advz_t=advz_ct(ims,kms,jms,adv_ct_indices(ic)),         &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             & 
+                                  config_flags=config_flags, tenddec=tenddec,             &
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2553,7 +2553,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
              CALL wrf_debug ( 15 , ' call rk_scalar_tend in tracer_tile_loop_1' )
              tenddec = .false.
-             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                & 
+             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                &
                               rk_step, dt_rk,                                    &
                               grid%ru_m, grid%rv_m, grid%ww_m,                   &
                               grid%muts, grid%mub, grid%mu_1,                    &
@@ -2562,7 +2562,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               tracer_old(ims,kms,jms,ic),                        &
                               tracer(ims,kms,jms,ic),                            &
                               tracer_tend(ims,kms,jms,ic),                       &
-                              advect_tend,h_tendency,z_tendency,grid%rqvften,    & 
+                              advect_tend,h_tendency,z_tendency,grid%rqvften,    &
                               grid%qv_base, .false., grid%fnm, grid%fnp,         &
                               grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                               grid%msfvy, grid%msftx,grid%msfty,                 &
@@ -2582,7 +2582,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! Currently, chemistry species with specified boundaries (i.e. the mother
 ! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
 !
            IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
              IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
@@ -2631,15 +2631,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_1=tracer_old(ims,kms,jms,ic),                    &
                                   scalar_2=tracer(ims,kms,jms,ic),                        &
                                   sc_tend=tracer_tend(ims,kms,jms,ic),                    &
-!                                 advh_t=advh_t(ims,kms,jms,1),                           & 
-!                                 advz_t=advz_t(ims,kms,jms,1),                           & 
+!                                 advh_t=advh_t(ims,kms,jms,1),                           &
+!                                 advz_t=advz_t(ims,kms,jms,1),                           &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             & 
+                                  config_flags=config_flags, tenddec=tenddec,             &
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2694,7 +2694,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
            CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
            tenddec = .false.
-           CALL rk_scalar_tend ( is, is, config_flags, tenddec,                   & 
+           CALL rk_scalar_tend ( is, is, config_flags, tenddec,                   &
                                  rk_step, dt_rk,                                  &
                                  grid%ru_m, grid%rv_m, grid%ww_m,                 &
                                  grid%muts, grid%mub, grid%mu_1,                  &
@@ -2703,7 +2703,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                  scalar_old(ims,kms,jms,is),                      &
                                  scalar(ims,kms,jms,is),                          &
                                  scalar_tend(ims,kms,jms,is),                     &
-                                 advect_tend,h_tendency,z_tendency,grid%rqvften,  & 
+                                 advect_tend,h_tendency,z_tendency,grid%rqvften,  &
                                  grid%qv_base, .false., grid%fnm, grid%fnp,       &
                                  grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                                  grid%msfvy, grid%msftx,grid%msfty,               &
@@ -2772,15 +2772,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_1=scalar_old(ims,kms,jms,is),                    &
                                   scalar_2=scalar(ims,kms,jms,is),                        &
                                   sc_tend=scalar_tend(ims,kms,jms,is),                    &
-!                                 advh_t=advh_t(ims,kms,jms,1),                           & 
-!                                 advz_t=advz_t(ims,kms,jms,1),                           & 
+!                                 advh_t=advh_t(ims,kms,jms,1),                           &
+!                                 advz_t=advz_t(ims,kms,jms,1),                           &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             & 
+                                  config_flags=config_flags, tenddec=tenddec,             &
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2810,7 +2810,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !     B = config_flags%use_aero_icbc
 !     C = config_glags%have_bcs_scalar
 
-! Test| A  | B  | C | ( A AND NOT B ) OR ( NOT A AND NOT C ) 
+! Test| A  | B  | C | ( A AND NOT B ) OR ( NOT A AND NOT C )
 ! ----+----+----+---+-----------------------------------------------
 !  1  | T  | T  | T |                 F = DO NOT CALL flow_dep_bdy
 !  2  | T  | T  | F |                 F = DO NOT CALL flow_dep_bdy
@@ -2824,7 +2824,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
 !  If this is     the special friendly fields AND are to use the aero icbc, then NO calls to flow dep: tests 1 and 2
 !  If this is     the special friendly fields AND do not use the aero icbc, then    call     flow dep: tests 3 and 4
-!  If this is not the special friendly fields AND: 
+!  If this is not the special friendly fields AND:
 !           If we        have bcs for scalars, do not call flow dep: tests 5 and 7
 !           If we do not have bcs for scalars,        call flow dep: tests 6 and 8
 
@@ -2883,7 +2883,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !  rk3 substep polar filter for scalars (moist,chem,scalar)
 !-----------------------------------------------------------
 
-       IF (config_flags%polar) THEN 
+       IF (config_flags%polar) THEN
          IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter moist ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_m
@@ -2929,7 +2929,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              END IF
            END DO
          END IF
-   
+
          IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter chem ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_c
@@ -3020,7 +3020,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              END IF
            END DO
          END IF
-   
+
          IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter scalar ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_s
@@ -3075,7 +3075,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !-----------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!  here's where we need a wide comm stencil - these are the 
+!  here's where we need a wide comm stencil - these are the
 !  uncoupled variables so are used for high order calc in
 !  advection and mixong routines.
 !
@@ -3117,7 +3117,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_D2_3.inc"
        ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
 #    include "HALO_EM_D2_5.inc"
-       ELSE 
+       ELSE
          WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
          CALL wrf_error_fatal(TRIM(wrf_err_message))
        ENDIF
@@ -3162,7 +3162,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
          IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
 
            moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
-  
+
              CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags,   &
                                      ids, ide, jds, jde, kds, kde,             &
                                      ims, ime, jms, jme, kms, kme,             &
@@ -3406,7 +3406,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       IF (CurrTime .lt. temp_time + dtInterval) THEN
          WRITE ( message , FMT = '("solve_em: initializing avgflx at time ",A," on domain ",I3)' ) &
               & TRIM(message2), grid%id
-         CALL wrf_message(trim(message)) 
+         CALL wrf_message(trim(message))
          grid%avgflx_count = 0
 !tile-loop for zero_avgflx
    !$OMP PARALLEL DO   &
@@ -3442,7 +3442,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
               &   grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
               &   grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
          CALL wrf_debug(200,'In solve_em, after upd_avgflx call')
-         
+
       ENDDO
       grid%avgflx_count = grid%avgflx_count + 1
    ENDIF
@@ -3501,10 +3501,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 ! (5) time-split physics.
 !
-!     Microphysics are the only time  split physics in the WRF model 
+!     Microphysics are the only time  split physics in the WRF model
 !     at this time.  Split-physics begins with the calculation of
 !     needed diagnostic quantities (pressure, temperature, etc.)
-!     followed by a call to the microphysics driver, 
+!     followed by a call to the microphysics driver,
 !     and finishes with a clean-up, storing off of a diabatic tendency
 !     from the moist physics, and a re-calulation of the  diagnostic
 !     quantities pressure and density.
@@ -3573,7 +3573,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_START(micro_driver_tim)
 
 !
-! WRFU_AlarmIsRinging always returned false, so using an alternate  method to find out if it is time 
+! WRFU_AlarmIsRinging always returned false, so using an alternate  method to find out if it is time
 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
 !
 !     diagflag = .false.
@@ -3799,6 +3799,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,height=grid%height                                         &
       &        ,tempc=grid%tempc                                         &
       &        ,ccn_conc=grid%ccn_conc                                   & ! RAS
+      &        ,sbmradar=sbmradar,num_sbmradar=num_sbmradar              & ! for SBM
       &        ,aerocu=aerocu                                            &
       &        ,aercu_fct=config_flags%aercu_fct                         &
       &        ,aercu_opt=config_flags%aercu_opt                         &
@@ -3808,7 +3809,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,CCN4_GS=grid%CCN4_GS,CCN5_GS=grid%CCN5_GS,CCN6_GS=grid%CCN6_GS &
       &        ,CCN7_GS=grid%CCN7_GS,NR_CU=grid%NR_CU,QR_CU=grid%QR_CU,NS_CU=grid%NS_CU &
       &        ,QS_CU=grid%QS_CU,CU_UAF=grid%CU_UAF,mskf_refl_10cm=grid%mskf_refl_10cm)
-                                                                          
+
 BENCH_END(micro_driver_tim)
 
 #if 0
@@ -3948,7 +3949,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                     ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
                     ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
          END IF
- 
+
          CALL pxft ( grid=grid                                                 &
                   ,lineno=__LINE__                                             &
                   ,flag_uv            = 0                                      &
@@ -3973,7 +3974,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                   ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
                   ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
                   ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
- 
+
          IF ( config_flags%coupled_filtering ) THEN
            CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)      &
                     ,MU=grid%mu_2 , MUB=grid%mub                                 &
@@ -4203,7 +4204,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
    ! b.c. routine for data within patch.
 
-   ! we need to do both time levels of 
+   ! we need to do both time levels of
    ! data because the time filter only works in the physical solution space.
 
    ! First, do patch communications for boundary conditions (periodicity)
@@ -4211,13 +4212,13 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !-----------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!  here's where we need a wide comm stencil - these are the 
+!  here's where we need a wide comm stencil - these are the
 !  uncoupled variables so are used for high order calc in
 !  advection and mixong routines.
 !
 !                              * * * * *
 !            *        * * *    * * * * *
-!          * + *      * + *    * * + * * 
+!          * + *      * + *    * * + * *
 !            *        * * *    * * * * *
 !                              * * * * *
 !
@@ -4250,7 +4251,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_D3_3.inc"
    ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
 #    include "HALO_EM_D3_5.inc"
-   ELSE 
+   ELSE
       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
       CALL wrf_error_fatal(TRIM(wrf_err_message))
    ENDIF
@@ -4351,7 +4352,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
 !  this code forces boundary values to specified values to avoid drift
 
-   IF( config_flags%specified .or. config_flags%nested ) THEN 
+   IF( config_flags%specified .or. config_flags%nested ) THEN
    !$OMP PARALLEL DO   &
    !$OMP PRIVATE ( ij )
    tile_bc_loop_3: DO ij = 1 , grid%num_tiles
@@ -4572,7 +4573,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
   CALL after_all_rk_steps ( grid, config_flags,                  &
                             moist, chem, tracer, scalar,         &
-                            th_phy, pi_phy, p_phy, rho_phy,      &   
+                            th_phy, pi_phy, p_phy, rho_phy,      &
                             p8w, t8w, dz8w,                      &
                             REAL(curr_secs,8), curr_secs2,       &
                             diag_flag,                           &
@@ -4668,7 +4669,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    CALL wrf_debug ( 200 , ' call end of solve_em' )
 
 !  Are we about to read SST input from the wrflowinput file?  That data is saved
-!  for use in fractional merging of external/coupled SST and input SST. 
+!  for use in fractional merging of external/coupled SST and input SST.
    IF ( coupler_on )   grid%just_read_auxinput4 = Is_alarm_tstep(grid%domain_clock, grid%alarms(AUXINPUT4_ALARM))
 
 !  Are we about to read the lateral boundary file?  This is a domain one action only.
diff --git a/phys/Makefile b/phys/Makefile
index f3ab0419fe..60d6ee4488 100644
--- a/phys/Makefile
+++ b/phys/Makefile
@@ -36,7 +36,7 @@ MODULES = \
 	module_bl_shinhong.o \
 	module_bl_mrf.o \
 	module_bl_gfs.o \
-        module_bl_gfsedmf.o \
+	module_bl_gfsedmf.o \
 	module_bl_myjpbl.o \
 	module_bl_qnsepbl.o \
 	module_bl_acm.o \
@@ -87,6 +87,7 @@ MODULES = \
 	module_mp_fer_hires.o \
 	module_mp_HWRF.o \
 	module_mp_thompson.o \
+	module_mp_SBM_polar_radar.o \
 	module_mp_full_sbm.o \
 	module_mp_fast_sbm.o \
 	module_ltng_lpi.o \
@@ -94,9 +95,9 @@ MODULES = \
 	module_mp_gsfcgce_3ice_nuwrf.o \
 	module_mp_gsfcgce_4ice_nuwrf.o \
 	module_mp_morr_two_moment.o \
-        module_mp_p3.o \
-        module_mp_jensen_ishmael.o \
-        module_mp_morr_two_moment_aero.o \
+	module_mp_p3.o \
+	module_mp_jensen_ishmael.o \
+	module_mp_morr_two_moment_aero.o \
 	module_mp_milbrandt2mom.o \
 	module_mp_nssl_2mom.o \
 	module_mp_wdm5.o \
@@ -107,18 +108,18 @@ MODULES = \
 	module_ra_clWRF_support.o  \
 	module_ra_gsfcsw.o \
 	module_ra_goddard.o \
-        module_ra_effective_radius.o \
+	module_ra_effective_radius.o \
 	module_ra_rrtm.o  \
 	module_ra_rrtmg_lw.o  \
 	module_ra_rrtmg_sw.o  \
 	module_ra_rrtmg_lwf.o  \
 	module_ra_rrtmg_swf.o  \
-        module_ra_rrtmg_lwk.o  \
-        module_ra_rrtmg_swk.o  \
-        module_ra_cam_support.o \
-        module_ra_cam.o \
+	module_ra_rrtmg_lwk.o  \
+	module_ra_rrtmg_swk.o  \
+	module_ra_cam_support.o \
+	module_ra_cam.o \
 	module_ra_gfdleta.o \
-        module_ra_flg.o \
+	module_ra_flg.o \
 	module_ra_HWRF.o \
 	module_ra_hs.o  \
 	module_ra_aerosol.o  \
@@ -131,19 +132,19 @@ MODULES = \
 	module_sf_noahdrv.o  \
 	module_sf_noahlsm.o  \
 	module_sf_clm.o  \
-        module_sf_ssib.o  \
+	module_sf_ssib.o  \
 	module_sf_noah_seaice.o \
 	module_sf_noah_seaice_drv.o \
 	module_sf_noahlsm_glacial_only.o \
-        module_sf_noahmp_groundwater.o \
-        module_sf_gecros.o \
+	module_sf_noahmp_groundwater.o \
+	module_sf_gecros.o \
 	module_sf_noahmpdrv.o \
 	module_sf_noahmplsm.o \
 	module_sf_noahmp_glacier.o \
-        module_sf_urban.o  \
-        module_sf_bep.o  \
-        module_sf_bep_bem.o \
-        module_sf_bem.o \
+	module_sf_urban.o  \
+	module_sf_bep.o  \
+	module_sf_bep_bem.o \
+	module_sf_bem.o \
 	module_sf_pxlsm.o \
 	module_sf_pxlsm_data.o \
 	module_sf_ruclsm.o \
@@ -171,7 +172,7 @@ MODULES = \
 	module_progtm.o \
 	module_pbl_driver.o \
 	module_data_gocart_dust.o \
-        module_dust_emis.o \
+	module_dust_emis.o \
 	module_cumulus_driver.o \
 	module_shallowcu_driver.o \
 	module_microphysics_driver.o \
@@ -186,7 +187,7 @@ MODULES = \
 	module_fdda_psufddagd.o \
 	module_fdda_spnudging.o \
 	module_fddagd_driver.o  \
-        module_fddaobs_rtfdda.o \
+	module_fddaobs_rtfdda.o \
 	module_fddaobs_driver.o \
 	module_wind_fitch.o \
 	module_sf_lake.o \
@@ -211,13 +212,13 @@ DIAGNOSTIC_MODULES_EM = \
 	module_diag_pld.o \
 	module_diag_zld.o \
 	module_diag_trad_fields.o
-  
+
 DIAGNOSTIC_MODULES_NMM = \
 	module_diag_refl.o
 
 OBJS    =
 
-NMM_MODULES =  
+NMM_MODULES =
 
 LIBTARGET    =  physics
 TARGETDIR    =  ./
diff --git a/phys/module_diag_misc.F b/phys/module_diag_misc.F
index 1d323974ee..4ebde610e6 100644
--- a/phys/module_diag_misc.F
+++ b/phys/module_diag_misc.F
@@ -65,7 +65,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
       WSM6SCHEME, ETAMPNEW, THOMPSON, THOMPSONAERO,                     &
       MORR_TWO_MOMENT, GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME,           &
       NSSL_2MOM, NSSL_2MOMG, NSSL_2MOMCCN, NSSL_1MOM, NSSL_1MOMLFO,                 &
-      MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN, FULL_KHAIN_LYNN,  &
+      MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN_SHPUND, FULL_KHAIN_LYNN,  &
       MORR_TM_AERO  !TWG 2017  !,MILBRANDT3MOM, NSSL_3MOM
 
    IMPLICIT NONE
@@ -166,8 +166,8 @@ SUBROUTINE diagnostic_output_calc(                                 &
                                                     ,   SNOWNCV  &
                                                     ,       HFX  &
                                                     ,        LH  &
-                                                    ,    SFCEVP  &  
-                                                    ,        T2     
+                                                    ,    SFCEVP  &
+                                                    ,        T2
 
    REAL, DIMENSION( ims:ime , jms:jme ),                         &
           INTENT(INOUT) ::                                DPSDT  &
@@ -176,7 +176,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
                                                     ,     RAINC  &
                                                     ,     MU_2M  &
                                                     ,      PK1M
- 
+
    REAL,  INTENT(IN   ) :: DT, XTIME
    INTEGER,  INTENT(IN   ) :: SBW
    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) ::     &
@@ -278,7 +278,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
         DO i=i_start(ij),i_end(ij)
           i_rainnc(i,j) = 0
           i_rainc(i,j) = 0
-        ENDDO      
+        ENDDO
         ENDDO
       ENDIF
       DO j=j_start(ij),j_end(ij)
@@ -291,7 +291,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           rainc(i,j) = rainc(i,j) - bucket_mm
           i_rainc(i,j) =  i_rainc(i,j) + 1
         ENDIF
-      ENDDO      
+      ENDDO
       ENDDO
 
       IF (xtime .eq. 0.0 .and. bucket_J .gt. 0.0 .and. PRESENT(ACSWUPT))THEN
@@ -305,7 +305,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           i_acswupbc(i,j) = 0
           i_acswdnb(i,j) = 0
           i_acswdnbc(i,j) = 0
-        ENDDO      
+        ENDDO
         ENDDO
       ENDIF
       IF (xtime .eq. 0.0  .and. bucket_J .gt. 0.0 .and. PRESENT(ACLWUPT))THEN
@@ -319,7 +319,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           i_aclwupbc(i,j) = 0
           i_aclwdnb(i,j) = 0
           i_aclwdnbc(i,j) = 0
-        ENDDO      
+        ENDDO
         ENDDO
       ENDIF
       IF (PRESENT(ACSWUPT) .and. bucket_J .gt. 0.0)THEN
@@ -357,7 +357,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           acswdnbc(i,j) = acswdnbc(i,j) - bucket_J
           i_acswdnbc(i,j) =  i_acswdnbc(i,j) + 1
         ENDIF
-      ENDDO      
+      ENDDO
       ENDDO
       ENDIF
       IF (PRESENT(ACLWUPT) .and. bucket_J .gt. 0.0)THEN
@@ -395,7 +395,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           aclwdnbc(i,j) = aclwdnbc(i,j) - bucket_J
           i_aclwdnbc(i,j) =  i_aclwdnbc(i,j) + 1
         ENDIF
-      ENDDO      
+      ENDDO
       ENDDO
       ENDIF
    ENDDO
@@ -427,10 +427,10 @@ SUBROUTINE diagnostic_output_calc(                                 &
          snow_acc_nc(i,j)   = snow_acc_nc(i,j) +  RAINCV(i,j)
          snow_acc_nc(i,j)   = MAX (snow_acc_nc(i,j), 0.0)
          ENDIF
-      ENDDO     
-      ENDDO     
+      ENDDO
+      ENDDO
 
-   ENDDO     
+   ENDDO
 
 !  !$OMP END PARALLEL DO
    ENDIF
@@ -580,8 +580,8 @@ SUBROUTINE diagnostic_output_calc(                                 &
 
 
 
-!+---+-----------------------------------------------------------------+ 
-!+---+-----------------------------------------------------------------+ 
+!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+
 !..Calculate a maximum hail diameter from the characteristics of the
 !.. graupel category mixing ratio and number concentration (or hail, if
 !.. available).  This diagnostic uses the actual spectral distribution
@@ -589,7 +589,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
 !.. from 0.5mm to 7.5cm.  Once a minimum number concentration of 0.01
 !.. particle per cubic meter of air is reached, from the upper size
 !.. limit, then this bin is considered the max size.
-!+---+-----------------------------------------------------------------+ 
+!+---+-----------------------------------------------------------------+
 
       WRITE(outstring,*) 'GT-Diagnostics, computing max-hail diameter'
       CALL wrf_debug (100, TRIM(outstring))
@@ -908,7 +908,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
 !      explicit bin scheme so code below not applicable
 !      scheme authors need to implement if desired.
 
-     CASE (FAST_KHAIN_LYNN)
+     CASE (FAST_KHAIN_LYNN_SHPUND)
 !      explicit bin scheme so code below not applicable
 !      scheme authors need to implement if desired.
 
@@ -1004,7 +1004,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
            idp=i
            jdp=j
          endif
-      ENDDO      
+      ENDDO
       ENDDO
 
    ENDDO
@@ -1160,7 +1160,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
    END SUBROUTINE diagnostic_output_calc
 
 
-!+---+-----------------------------------------------------------------+ 
+!+---+-----------------------------------------------------------------+
       REAL FUNCTION GAMMLN(XX)
 !     --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0.
       IMPLICIT NONE
@@ -1185,7 +1185,7 @@ REAL FUNCTION GAMMLN(XX)
       GAMMLN=TMP+LOG(STP*SER/X)
       END FUNCTION GAMMLN
 !  (C) Copr. 1986-92 Numerical Recipes Software 2.02
-!+---+-----------------------------------------------------------------+ 
+!+---+-----------------------------------------------------------------+
       REAL FUNCTION WGAMMA(y)
 
       IMPLICIT NONE
@@ -1194,7 +1194,7 @@ REAL FUNCTION WGAMMA(y)
       WGAMMA = EXP(GAMMLN(y))
 
       END FUNCTION WGAMMA
-!+---+-----------------------------------------------------------------+ 
+!+---+-----------------------------------------------------------------+
 
 
 END MODULE module_diag_misc
diff --git a/phys/module_diagnostics_driver.F b/phys/module_diagnostics_driver.F
index 29dc825796..b268d0db2d 100644
--- a/phys/module_diagnostics_driver.F
+++ b/phys/module_diagnostics_driver.F
@@ -16,7 +16,7 @@ MODULE module_diagnostics_driver
 
    SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                                    moist, chem, tracer, scalar,         &
-                                   th_phy, pi_phy, p_phy, rho_phy,      & 
+                                   th_phy, pi_phy, p_phy, rho_phy,      &
                                    p8w, t8w, dz8w,                      &
                                    curr_secs, curr_secs2,               &
                                    diag_flag,                           &
@@ -44,7 +44,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                      WSM6SCHEME, ETAMPNEW, THOMPSON, THOMPSONAERO,                     &
                      MORR_TWO_MOMENT, GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME,           &
                      NSSL_2MOM, NSSL_2MOMCCN, NSSL_1MOM, NSSL_1MOMLFO,                 &
-                     MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN, FULL_KHAIN_LYNN,  &
+                     MILBRANDT2MOM , CAMMGMPSCHEME, FAST_KHAIN_LYNN_SHPUND, FULL_KHAIN_LYNN,  &
                      MORR_TM_AERO !TWG add    !,MILBRANDT3MOM, NSSL_3MOM, MORR_MILB_P3
 
       USE module_driver_constants, ONLY: max_plevs, max_zlevs
@@ -66,13 +66,13 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                                    model_config_rec
 
       USE module_streams
-      USE module_utility, ONLY : WRFU_Time 
+      USE module_utility, ONLY : WRFU_Time
 
       !=============================================================
       !  USE Association for the Diagnostic Packages
       !=============================================================
-      
-      USE module_lightning_driver, ONLY : lightning_driver      
+
+      USE module_lightning_driver, ONLY : lightning_driver
       USE module_diag_misc, ONLY : diagnostic_output_calc
       USE module_diag_cl, ONLY : clwrf_output_calc
       USE module_diag_pld, ONLY : pld
@@ -134,7 +134,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
       !           incrementing index
       !        k: refers to the vertical direction form bottom to top, the second dimension
       !           in all 3d arrays
-      !     The second letter: 
+      !     The second letter:
       !        d: refers to the domain size, the geophysical extent of the entire domain,
       !           not used in dimensions or looping, used to determine when we are close to
       !           the edge of the boundary
@@ -196,15 +196,15 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
 
       !  Lightning flash rate diagnostic production.
 
-      LIGHTNING: IF ( config_flags%lightning_option /= 0 ) THEN 
+      LIGHTNING: IF ( config_flags%lightning_option /= 0 ) THEN
          CALL wrf_debug ( 100 , '--> CALL DIAGNOSTICS PACKAGE: LIGHTNING_DRIVER' )
          CALL lightning_driver ( &
           ! Frequently used prognostics
             curr_secs, grid%dt, grid%dx, grid%dy,              &
             grid%xlat, grid%xlong, grid%xland, grid%ht,        &
             grid%t_phy, p_phy, grid%rho,                       &
-            grid%u_phy, grid%v_phy, grid%w_2,                  &    
-            th_phy,     pi_phy,dz8w,                           &  
+            grid%u_phy, grid%v_phy, grid%w_2,                  &
+            th_phy,     pi_phy,dz8w,                           &
             grid%z, moist,                                     &
           ! Scheme specific prognostics
             grid%ktop_deep, grid%refl_10cm,                    &
@@ -224,15 +224,15 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
           ! Scheme specific namelist inputs
             config_flags%cellcount_method,                     &
             config_flags%cldtop_adjustment,                    &
-          ! Order dependent args for domain, mem, and tile dims 
+          ! Order dependent args for domain, mem, and tile dims
             ids, ide, jds, jde, kds, kde,         &
             ims, ime, jms, jme, kms, kme,         &
             ips, ipe, jps, jpe, kps, kpe,         &
           ! Mandatory outputs for all quantitative schemes
             grid%ic_flashcount, grid%ic_flashrate,          &
             grid%cg_flashcount, grid%cg_flashrate,          &
-            grid%lpi                                        &   
-      )    
+            grid%lpi                                        &
+      )
       END IF LIGHTNING
 
 
@@ -268,7 +268,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
         !$OMP END PARALLEL DO
       END IF HAILCAST
 
-      TRADITIONAL_FIELDS: IF ( config_flags%diag_nwp2 == do_trad_fields ) THEN 
+      TRADITIONAL_FIELDS: IF ( config_flags%diag_nwp2 == do_trad_fields ) THEN
          !$OMP PARALLEL DO   &
          !$OMP PRIVATE ( ij )
          DO ij = 1 , grid%num_tiles
@@ -298,7 +298,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                ,e=grid%e                                            &
                ,sina=grid%sina                                      &
                ,cosa=grid%cosa                                      &
-               !  Input model diagnostic vraiables 
+               !  Input model diagnostic vraiables
                ,rho=grid%rho                                        &
                ,dz8w=dz8w                                           &
                ,qc=moist(:,:,:,P_QC)                                &
@@ -306,8 +306,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                ,rainnc=grid%rainnc                                  &
                ,snownc=grid%snownc                                  &
                ,graupelnc=grid%graupelnc                            &
-               ,hailnc=grid%hailnc                                  & 
-               !  Terrestrial data                
+               ,hailnc=grid%hailnc                                  &
+               !  Terrestrial data
                ,ht=grid%ht                                          &
                !  Namelist info
                ,use_theta_m=config_flags%use_theta_m                &
@@ -357,8 +357,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -376,7 +376,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag 
+      ! Selection flag
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -390,7 +390,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -432,8 +432,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -451,7 +451,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag 
+      ! Selection flag
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -465,7 +465,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -509,8 +509,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -528,7 +528,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag 
+      ! Selection flag
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -542,7 +542,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -585,8 +585,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -604,7 +604,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag 
+      ! Selection flag
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -618,7 +618,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -661,8 +661,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -680,7 +680,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag 
+      ! Selection flag
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -694,7 +694,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -751,7 +751,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
 
 !       CASE (FULL_KHAIN_LYNN)
 
-!       CASE (FAST_KHAIN_LYNN)
+!       CASE (FAST_KHAIN_LYNN_SHPUND)
 
 !       CASE (WSM3SCHEME)
 
@@ -768,8 +768,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -787,7 +787,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag 
+      ! Selection flag
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -801,7 +801,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -1109,7 +1109,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                        ,TH2=grid%th2, TH2_MEAN=grid%th2_mean                  &
                        ,Q2=grid%q2, Q2_MEAN=grid%q2_mean                      &
                        ,U10=grid%u10, U10_MEAN=grid%u10_mean                  &
-                       ,V10=grid%v10, V10_MEAN=grid%v10_mean                  &           
+                       ,V10=grid%v10, V10_MEAN=grid%v10_mean                  &
                        ,HFX=grid%hfx, HFX_MEAN=grid%hfx_mean                  &
                        ,LH=grid%lh, LH_MEAN=grid%lh_mean                      &
                        ,SWDNB=grid%swdnb, SWDNB_MEAN=grid%swdnb_mean          &
@@ -1188,8 +1188,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
            ,LWUPT_DIURN=grid%LWUPT_DIURN, LWDNT_DIURN=grid%LWDNT_DIURN        &
          ! Dimension arguments
            ,IDS=ids, IDE=ide, JDS=jds, JDE=jde, KDS=kds, KDE=kde              &
-           ,IMS=ims, IME=ime, JMS=jms, JME=jme, KMS=kms, KME=kme              & 
-           ,IPS=ips, IPE=ipe, JPS=jps, JPE=jpe, KPS=kps, KPE=kpe              &         
+           ,IMS=ims, IME=ime, JMS=jms, JME=jme, KMS=kms, KME=kme              &
+           ,IPS=ips, IPE=ipe, JPS=jps, JPE=jpe, KPS=kps, KPE=kpe              &
            ,I_START=grid%i_start, I_END=min(grid%i_end, ide-1)                &
            ,J_START=grid%j_start, J_END=min(grid%j_end, jde-1)                &
            ,NUM_TILES=grid%num_tiles                                          &
@@ -1206,7 +1206,7 @@ END SUBROUTINE diagnostics_driver
    SUBROUTINE update_phys_fields ( grid, config_flags, moist,           &
                                    ids,  ide,  jds,  jde,  kds,  kde,   &
                                    ims,  ime,  jms,  jme,  kms,  kme,   &
-                                   ips,  ipe,  jps,  jpe,  kps,  kpe    ) 
+                                   ips,  ipe,  jps,  jpe,  kps,  kpe    )
 
       USE module_domain, ONLY : domain
       USE module_configure, ONLY : grid_config_rec_type
@@ -1231,7 +1231,7 @@ SUBROUTINE update_phys_fields ( grid, config_flags, moist,           &
 
       !  Local variables
 
-      INTEGER :: i, j, k 
+      INTEGER :: i, j, k
 
       !  Moist or dry theta
 
diff --git a/phys/module_microphysics_driver.F b/phys/module_microphysics_driver.F
index 02b93c62e0..ff97c99a0a 100644
--- a/phys/module_microphysics_driver.F
+++ b/phys/module_microphysics_driver.F
@@ -37,7 +37,7 @@ SUBROUTINE microphysics_driver(                                          &
                       ,qme3d,prain3d,nevapr3d,rate1ord_cw2pr_st3d        &
                       ,dgnum4D,dgnumwet4D                                &
 #endif
-!======================                                   
+!======================
                       ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr   &
                       ,qic_curr,qip_curr,qid_curr &
                       ,qnic_curr,qnip_curr,qnid_curr &
@@ -53,7 +53,7 @@ SUBROUTINE microphysics_driver(                                          &
                       ,qvoli2_curr,qaoli2_curr                           & ! for Jensen ISHMAEL
                       ,qi3_curr,qni3_curr,qvoli3_curr,qaoli3_curr        & ! for Jensen ISHMAEL
                       ,effr_curr,ice_effr_curr,tot_effr_curr             &
-                      ,qic_effr_curr,qip_effr_curr,qid_effr_curr         &             
+                      ,qic_effr_curr,qip_effr_curr,qid_effr_curr         &
                       ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni      &
                       ,f_qns,f_qnr,f_qng,f_qnc,f_qnn,f_qh,f_qnh          &
                       ,            f_qzr,f_qzi,f_qzs,f_qzg,f_qzh         &
@@ -66,7 +66,7 @@ SUBROUTINE microphysics_driver(                                          &
                       ,f_qvoli2,f_qaoli2                                 & ! for Jensen ISHMAEL
                       ,f_qi3,f_qni3,f_qvoli3,f_qaoli3                    & ! for Jensen ISHMAEL
                       ,f_effr,f_ice_effr,f_tot_effr                      &
-                      ,f_qic_effr,f_qip_effr,f_qid_effr                  &                 
+                      ,f_qic_effr,f_qip_effr,f_qid_effr                  &
                       ,cu_used                                           &
                       ,qrcuten, qscuten, qicuten, qccuten                &
                       ,qt_curr,f_qt                                      &
@@ -86,7 +86,7 @@ SUBROUTINE microphysics_driver(                                          &
 #endif
 !NUWRF JJS 20110525 ^^^^^
 !                     ,ccntype                                           & ! for mp_milbrandt2mom
-                      ,u,v,w,z                                          &   
+                      ,u,v,w,z                                          &
                       ,rainnc,    rainncv                                &
                       ,snownc,    snowncv                                &
                       ,hailnc,    hailncv                                &
@@ -97,13 +97,13 @@ SUBROUTINE microphysics_driver(                                          &
 #endif
                       ,qnwfa2d, qnifa2d                                  & ! for water/ice-friendly aerosols
                       ,refl_10cm                                         & ! HM, 9/22/09, add for refl
-                      ,vmi3d                                             & ! for P3 
-                      ,di3d                                              & ! for P3 
-                      ,rhopo3d                                           & ! for P3 
+                      ,vmi3d                                             & ! for P3
+                      ,di3d                                              & ! for P3
+                      ,rhopo3d                                           & ! for P3
                       ,phii3d                                            & ! for Jensen ISHMAEL
-                      ,vmi3d_2                                           & ! for P3 
-                      ,di3d_2                                            & ! for P3 
-                      ,rhopo3d_2                                         & ! for P3 
+                      ,vmi3d_2                                           & ! for P3
+                      ,di3d_2                                            & ! for P3
+                      ,rhopo3d_2                                         & ! for P3
                       ,phii3d_2                                          & ! for Jensen ISHMAEL
                       ,vmi3d_3                                           & ! for Jensen ISHMAEL
                       ,di3d_3                                            & ! for Jensen ISHMAEL
@@ -132,6 +132,7 @@ SUBROUTINE microphysics_driver(                                          &
                       ,xlat,xlong,ivgtyp                                 &
                       ,qrimef_curr,f_qrimef                              &
                       ,aercu_opt                                         &
+                      ,sbmradar,num_sbmradar                             &
 # if( EM_CORE==1 )
                       ,aerocu,aercu_fct,no_src_types_cu                  &
                       ,PBL,EFCG,EFIG,EFSG,WACT,CCN1_GS,CCN2_GS           &
@@ -148,12 +149,12 @@ SUBROUTINE microphysics_driver(                                          &
                     ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN, NSSL_2MOMG  &
                     ,NSSL_1MOM,NSSL_1MOMLFO, FER_MP_HIRES_ADVECT &
                     ,WSM7SCHEME, WDM7SCHEME &
-                    ,NUWRF3ICESCHEME, NUWRF4ICESCHEME & 
-                    ,MILBRANDT2MOM, P3_1CATEGORY, P3_1CATEGORY_NC, JENSEN_ISHMAEL  !, P3_2CATEGORY ,MILBRANDT3MOM 
+                    ,NUWRF3ICESCHEME, NUWRF4ICESCHEME &
+                    ,MILBRANDT2MOM, P3_1CATEGORY, P3_1CATEGORY_NC, JENSEN_ISHMAEL  !, P3_2CATEGORY ,MILBRANDT3MOM
 #else
    USE module_state_description, ONLY :                                  &
                      KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME    &
-                    ,WSM6SCHEME, ETAMPNEW, FER_MP_HIRES, THOMPSON, THOMPSONAERO, FAST_KHAIN_LYNN, MORR_TWO_MOMENT     &
+                    ,WSM6SCHEME, ETAMPNEW, FER_MP_HIRES, THOMPSON, THOMPSONAERO, FAST_KHAIN_LYNN_SHPUND, MORR_TWO_MOMENT     &
                     ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN, NSSL_2MOMG  &
                     ,NSSL_1MOM,NSSL_1MOMLFO, FER_MP_HIRES_ADVECT & ! ,NSSL_3MOM       &
                     ,WSM7SCHEME, WDM7SCHEME &
@@ -171,7 +172,7 @@ SUBROUTINE microphysics_driver(                                          &
                     ,p_dust_1, p_dust_2, p_dust_3                       & !inline gocart
                     ,p_dust_4, p_dust_5                                 & !inline gocart
                     ,p_sulf, p_seas_1, p_seas_2                         & !inline gocart
-                    ,p_seas_3, p_seas_4 
+                    ,p_seas_3, p_seas_4
 
 #endif
 
@@ -184,9 +185,9 @@ SUBROUTINE microphysics_driver(                                          &
    USE module_model_constants
    USE module_wrf_error
    USE module_configure, only: grid_config_rec_type
-#if ( WRF_CHEM == 1 )   
+#if ( WRF_CHEM == 1 )
 !mchen   USE module_state_description, only: num_scalar               ! For CAMMGMP scheme Prognostic aerosols
-   USE module_state_description, only: num_chem               ! mchen 
+   USE module_state_description, only: num_chem               ! mchen
    USE modal_aero_data, only:  ntot_amode_cam_mam => ntot_amode ! For CAMMGMP scheme Prognostic aerosols
 #endif
 
@@ -399,7 +400,7 @@ SUBROUTINE microphysics_driver(                                          &
    INTEGER, OPTIONAL, INTENT(IN   )    :: hail, ice2 !, ccntype
 !
    INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
-   INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme,num_scalar
+   INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme,num_scalar,num_sbmradar
    INTEGER, OPTIONAL, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
    INTEGER,      INTENT(IN   )    ::                         kts,kte
    INTEGER,      INTENT(IN   )    ::     itimestep,num_tiles,spec_zone
@@ -458,22 +459,23 @@ SUBROUTINE microphysics_driver(                                          &
 
     REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),INTENT(INOUT), OPTIONAL :: th_old,qv_old
     REAL,DIMENSION(ims:ime,kms:kme,jms:jme,num_scalar),INTENT(INOUT), OPTIONAL   :: scalar
+    REAL, DIMENSION(ims:ime,kms:kme,jms:jme,num_sbmradar),INTENT(INOUT) :: sbmradar
     INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN), OPTIONAL::   IVGTYP
     REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN), OPTIONAL    :: XLAT, XLONG
 
 !=================
 !Data for CAMMGMP scheme
-   REAL,INTENT(IN), OPTIONAL ::accum_mode,aitken_mode,coarse_mode  
+   REAL,INTENT(IN), OPTIONAL ::accum_mode,aitken_mode,coarse_mode
 !1D variables required for CAMMGMP scheme
    REAL , DIMENSION( kms:kme ) ,                                      &
         INTENT(IN   ) , OPTIONAL ::                                        fnm,  & !Factors for interpolation at "w" grid (interfaces)
-                                                                fnp     
+                                                                fnp
 !2D variables required for CAMMGMP scheme
    REAL, DIMENSION( ims:ime, jms:jme ),                               &
         INTENT(IN), OPTIONAL ::                                                 &
                                                                  qfx, &    !Moisture flux at surface (kg m-2 s-1)
                                                                  rliq      !Vertically-integrated reserved cloud condensate(m/s)
- 
+
  !3D variables required for CAMMGMP scheme
  REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
       INTENT(IN), OPTIONAL ::                                                   &
@@ -482,7 +484,7 @@ SUBROUTINE microphysics_driver(                                          &
                                                                t_phy, &    !Temprature at the mid points (K)
                                                                p_hyd, &    !Hydrostatic pressure(Pa)
                                                              p8w_hyd, &    !Hydrostatic Pressure at level interface (Pa)
-                                                              z_at_w, &    !Height above sea level at layer interfaces (m) 
+                                                              z_at_w, &    !Height above sea level at layer interfaces (m)
                                                              tke_pbl, &    !Turbulence kinetic energy
                                                           turbtype3d, &    !Turbulent interface types [ no unit ]
                                                               smaw3d, &    !Normalized Galperin instability function for momentum [no units]
@@ -497,7 +499,7 @@ SUBROUTINE microphysics_driver(                                          &
  REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme,ntot_amode_cam_mam ),     &
         INTENT(IN) ::                                                 &
                                                              dgnum4D, &
-                                                          dgnumwet4D 
+                                                          dgnumwet4D
 #endif
 !In-outs
  REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
@@ -509,19 +511,19 @@ SUBROUTINE microphysics_driver(                                          &
 #if ( WRF_CHEM == 1 )
  REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem),     &
       INTENT(INOUT) ::                                                &
-                                                                 chem      !Chem array for CAMMGMP scheme Prognostic aerosols      
+                                                                 chem      !Chem array for CAMMGMP scheme Prognostic aerosols
 #endif
 !outs
 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
       INTENT(INOUT) , OPTIONAL::                                                 &
-                                                            wsedl3d, &    !Sedimentation velocity of stratiform liquid cloud droplet (m/s) 
+                                                            wsedl3d, &    !Sedimentation velocity of stratiform liquid cloud droplet (m/s)
                                                           cldfra_mp, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                       cldfra_mp_all, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                             cldfrai, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                             cldfral, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                             lradius, &    !Old Cloud fraction for CAMMGMP microphysics only
-                                                            iradius, &    !Old Cloud fraction for CAMMGMP microphysics only                                                            
-                                                        cldfra_conv 
+                                                            iradius, &    !Old Cloud fraction for CAMMGMP microphysics only
+                                                        cldfra_conv
 
 
 
@@ -633,7 +635,7 @@ SUBROUTINE microphysics_driver(                                          &
                                                       ,GRAUPELNCV &
                                                           ,HAILNC &
                                                           ,HAILNCV
-                                                          
+
 #if ( WRF_CHEM == 1)
 ! NUWRF JJS 20110525 vvvvv
 ! for inline Gocart coupling
@@ -644,7 +646,7 @@ SUBROUTINE microphysics_driver(                                          &
  REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(OUT) :: nc_diag
  integer, intent(in) :: gsfcgce_gocart_coupling ! EMK
  REAL, PARAMETER :: frac(4)=(/ 0.01053,0.08421,0.25263,0.65263 /) !fraction for fine dust
- 
+
 ! NUWRF JJS 20110525 ^^^^^
 #endif
 
@@ -687,7 +689,7 @@ SUBROUTINE microphysics_driver(                                          &
   INTEGER, OPTIONAL, INTENT(IN   )    :: PBL
   INTEGER,           INTENT(IN   )    :: no_src_types_cu
   REAL,              INTENT(IN   )    :: aercu_fct
-  REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), INTENT(INOUT) & 
+  REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), INTENT(INOUT) &
                                       :: aerocu
   REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) &
                                       :: EFCG,           &
@@ -788,7 +790,7 @@ SUBROUTINE microphysics_driver(                                          &
             ,has_reqs=has_reqs                                 &
             ,re_cloud=re_cloud                                 &
             ,re_ice=re_ice                                     &
-            ,re_snow=re_snow                                   &  ! for radiation -  
+            ,re_snow=re_snow                                   &  ! for radiation -
             ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
             ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
             ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
@@ -820,7 +822,7 @@ SUBROUTINE microphysics_driver(                                          &
 
 !-----------
        IF( PRESENT(chem_opt) .AND. PRESENT(progn) ) THEN
-       
+
        ! ERM: check whether to use built-in droplet nucleation or use qndrop from CHEM
        IF ( mp_physics==NSSL_2MOMCCN .or. mp_physics==NSSL_2MOM .or. mp_physics==NSSL_2MOMG ) THEN
          IF ( progn > 0 ) THEN
@@ -829,7 +831,7 @@ SUBROUTINE microphysics_driver(                                          &
            nssl_progn = .false. ! use NUCOND for droplet nucleation
          ENDIF
        ENDIF
-       
+
        !Add pass for dust-only wrf-chem option - RAS
        IF( (chem_opt==0 .OR. chem_opt==401) .AND. progn==1 .AND. (mp_physics==LINSCHEME  .OR. mp_physics==MORR_TWO_MOMENT)) THEN
           IF( PRESENT( QNDROP_CURR ) ) THEN
@@ -1067,7 +1069,7 @@ SUBROUTINE microphysics_driver(                                          &
                 CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
              ENDIF
 #if (EM_CORE==1)
-       CASE (FAST_KHAIN_LYNN)
+       CASE (FAST_KHAIN_LYNN_SHPUND)
              CALL wrf_debug ( 100 , 'microphysics_driver: calling sbm' )
                CALL fast_sbm(W=w,U=u,V=v,TH_OLD=th_old          &
                  ,CHEM_new=scalar,N_CHEM=num_scalar                     &
@@ -1086,15 +1088,15 @@ SUBROUTINE microphysics_driver(                                          &
                  ,QV_OLD=qv_old                                     &
                  ,QNC=qnc_curr                                      &
                  ,QNR=qnr_curr                                      &
+                 ,QNI=qni_curr                                      &
                  ,QNS=qns_curr                                      &
                  ,QNG=qng_curr                                      &
                  ,QNA=qnn_curr                                      &
+                 ,sbmradar=sbmradar,num_sbmradar=num_sbmradar       &
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
-                 ,REFL_10CM=refl_10cm                 &  ! added for radar reflectivity
                  ,diagflag=diagflag                   &  ! added for radar reflectivity
-                 ,do_radar_ref=do_radar_ref           &  ! added for radar reflectivity
                  ,RAINNC=rainnc                       &
                  ,RAINNCV=rainncv                     &
                  ,SNOWNC=snownc                       &
@@ -1185,25 +1187,25 @@ SUBROUTINE microphysics_driver(                                          &
              PRESENT (QI3_CURR).AND. PRESENT (QNI3_CURR) .AND. &
              PRESENT (QVOLI3_CURR).AND. PRESENT (QAOLI3_CURR)) THEN
              CALL mp_jensen_ishmael(             &
-             ITIMESTEP=itimestep,                &  !*                                                                         
+             ITIMESTEP=itimestep,                &  !*
              DT_IN=dt,                           &  !*
-             P=p,                                &  !*                                                                         
+             P=p,                                &  !*
              DZ=dz8w,                            &  !* !
-             TH=th,                              &  !*                                                                         
-             QV=qv_curr,                         &  !*                                                                         
-             QC=qc_curr,                         &  !*                                                                         
-             QR=qr_curr,                         &  !*                                                                         
+             TH=th,                              &  !*
+             QV=qv_curr,                         &  !*
+             QC=qc_curr,                         &  !*
+             QR=qr_curr,                         &  !*
              NR=qnr_curr,                        &  !* !
-             QI1=qi_curr,                        &  !*                                                                         
-             NI1=qni_curr,                       &  !*                                                                         
+             QI1=qi_curr,                        &  !*
+             NI1=qni_curr,                       &  !*
              AI1=qvoli_curr,                     &  !*
              CI1=qaoli_curr,                     &  !*
-             QI2=qi2_curr,                       &  !*                                                                         
-             NI2=qni2_curr,                      &  !*                                                                         
+             QI2=qi2_curr,                       &  !*
+             NI2=qni2_curr,                      &  !*
              AI2=qvoli2_curr,                    &  !*
              CI2=qaoli2_curr,                    &  !*
-             QI3=qi3_curr,                       &  !*                                                                         
-             NI3=qni3_curr,                      &  !*                                                                         
+             QI3=qi3_curr,                       &  !*
+             NI3=qni3_curr,                      &  !*
              AI3=qvoli3_curr,                    &  !*
              CI3=qaoli3_curr,                    &  !*
              IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
@@ -1647,7 +1649,7 @@ SUBROUTINE microphysics_driver(                                          &
 #endif
              PRESENT ( W      )  .AND. &
              PRESENT (QVOLG_CURR) ) THEN
-             
+
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -1706,7 +1708,7 @@ SUBROUTINE microphysics_driver(                                          &
              PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. &
 #endif
              PRESENT ( W      )  ) THEN
-             
+
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -1758,7 +1760,7 @@ SUBROUTINE microphysics_driver(                                          &
              PRESENT ( W      )  .AND. &
              PRESENT (QVOLG_CURR) .AND. F_QVOLG  .AND.         &
              PRESENT (QVOLH_CURR) .AND. F_QVOLH ) THEN
-             
+
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -1836,7 +1838,7 @@ SUBROUTINE microphysics_driver(                                          &
 #endif
              PRESENT ( W      )  .AND. &
              PRESENT (QVOLG_CURR) .AND. F_QVOLG  ) THEN
-             
+
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -1914,7 +1916,7 @@ SUBROUTINE microphysics_driver(                                          &
              PRESENT (QVOLG_CURR) .AND. F_QVOLG  .AND.         &
              PRESENT (QVOLH_CURR) .AND. F_QVOLH  .AND.         &
              PRESENT( QNN_CURR )                          ) THEN
-             
+
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -2066,7 +2068,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,CHEM_OPT=chem_opt                                 &
                  ,GSFCGCE_GOCART_COUPLING=gsfcgce_gocart_coupling   &
 #endif
-!NUWRF JJS 20110525 ^^^^^         
+!NUWRF JJS 20110525 ^^^^^
                                                                     )
 
                do j=jts,jte
@@ -2131,7 +2133,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,F_QG=f_qg                                         &
                  ,QG=qg_curr                                        &
 !                 ,IHAIL=hail, ICE4=ice2                             & ! hardcoded in the 4ice scheme
-                                                                       ! ihail = 0, ice4=4 
+                                                                       ! ihail = 0, ice4=4
 !NUWRF JJS 20110525 vvvvv
                  ,PHYSC=physc, PHYSE=physe, PHYSD=physd             &
                  ,PHYSS=physs, PHYSM=physm, PHYSF=physf             &
@@ -2165,7 +2167,7 @@ SUBROUTINE microphysics_driver(                                          &
                         acphys_tot(i,k,j) = acphysc(i,k,j) + acphyse(i,k,j) + &
                              acphysd(i,k,j) + acphyss(i,k,j) + acphysm(i,k,j) + &
                              acphysf(i,k,j)
-                        
+
                      end do
                   end do
                end do
@@ -2283,7 +2285,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
                  ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -  
+                 ,re_snow=re_snow                                   &  ! for radiation -
 # endif
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
@@ -2326,7 +2328,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
                  ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -  
+                 ,re_snow=re_snow                                   &  ! for radiation -
 # endif
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
@@ -2370,7 +2372,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
                  ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -  
+                 ,re_snow=re_snow                                   &  ! for radiation -
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
@@ -2462,8 +2464,8 @@ SUBROUTINE microphysics_driver(                                          &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
                  ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -       
-                 ,ITIMESTEP=itimestep                               & 
+                 ,re_snow=re_snow                                   &  ! for radiation -
+                 ,ITIMESTEP=itimestep                               &
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
@@ -2506,13 +2508,13 @@ SUBROUTINE microphysics_driver(                                          &
                  ,diagflag=diagflag                                 &  ! added for radar reflectivity
                  ,do_radar_ref=do_radar_ref                         &  ! added for radar reflectivity
                  ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv          &
-                 ,ITIMESTEP=itimestep                               & 
+                 ,ITIMESTEP=itimestep                               &
                  ,has_reqc=has_reqc                                 &  ! for radiation +
                  ,has_reqi=has_reqi                                 &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
-                 ,re_ice=re_ice                                     & 
-                 ,re_snow=re_snow                                   &  ! for radiation -  
+                 ,re_ice=re_ice                                     &
+                 ,re_snow=re_snow                                   &  ! for radiation -
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
@@ -2702,7 +2704,7 @@ SUBROUTINE microphysics_driver(                                          &
                   PRESENT( qs_curr    ) .AND.                              &
                   PRESENT( qv_curr    ) .AND. PRESENT( qc_curr     ) .AND. &
                   PRESENT( qi_curr    ) .AND. PRESENT( f_qc        ) .AND. &
-                  PRESENT( qr_curr    ) .AND. PRESENT( qndrop_curr ) .AND. &                  
+                  PRESENT( qr_curr    ) .AND. PRESENT( qndrop_curr ) .AND. &
                   PRESENT( f_qi       ) .AND. PRESENT( qnc_curr    ) .AND. &
                   PRESENT( RAINNCV    ) .AND. PRESENT( SNOWNCV     ) .AND. &
                   PRESENT( qns_curr   ) .AND. PRESENT( qnr_curr    ) .AND. &
@@ -2717,7 +2719,7 @@ SUBROUTINE microphysics_driver(                                          &
                 qi_b4mp(its:ite,kts:kte,jts:jte) = qi_curr(its:ite,kts:kte,jts:jte)
                 qs_b4mp(its:ite,kts:kte,jts:jte) = qs_curr(its:ite,kts:kte,jts:jte)
 #endif
-                  
+
                 CALL CAMMGMP(ITIMESTEP=itimestep,DT=dt,P8W=p8w_hyd,P_HYD=p_hyd    &
                      ,T_PHY=t_phy,PI_PHY=pi_phy,Z_AT_W=z_at_w,QFX=qfx             &
                      ,TKE_PBL=tke_pbl,TURBTYPE3D=turbtype3d,SMAW3D=smaw3d     &
@@ -2761,14 +2763,14 @@ SUBROUTINE microphysics_driver(                                          &
              CALL wrf_debug ( 100 , 'microphysics_driver: calling lscond' )
              IF ( PRESENT( QV_CURR ) .AND.                          &
                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV )) THEN
-                                          
+
                CALL lscond(                                         &
                   TH=th                                              &
-                 ,P=p                                               & 
+                 ,P=p                                               &
                  ,QV=qv_curr                                        &
-                 ,RHO=rho, PII=pi_phy, XLV=xlv, CP=cp               &  
+                 ,RHO=rho, PII=pi_phy, XLV=xlv, CP=cp               &
                  ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
-                 ,SVP3=svp3,SVPT0=svpt0                             & 
+                 ,SVP3=svp3,SVPT0=svpt0                             &
                  ,R_V= R_v                                          & ! added
                  ,DZ8W=dz8w                                         &
                  ,RAINNC=rainnc,RAINNCV=rainncv                     &
diff --git a/phys/module_mp_SBM_polar_radar.F b/phys/module_mp_SBM_polar_radar.F
new file mode 100644
index 0000000000..6c77f85fd7
--- /dev/null
+++ b/phys/module_mp_SBM_polar_radar.F
@@ -0,0 +1,2972 @@
+!******************
+module scatt_tables
+! JCS - This module pertains to the reading of scattering amplitude files
+
+!use microprm
+
+implicit none
+
+private
+public :: faf1,fbf1,fab1,fbb1,         &
+        ! faf1fd,fbf1fd,fab1fd,fbb1fd, &
+        ! faf2d,fbf2d,fab2d,fbb2d,     &
+        ! faf2p,fbf2p,fab2p,fbb2p,     &
+        ! faf2c,fbf2c,fab2c,fbb2c,     &
+          faf3,fbf3,fab3,fbb3,         &
+          faf4,fbf4,fab4,fbb4,         &
+          faf5,fbf5,fab5,fbb5,         &
+          LOAD_TABLES,                 &
+          temps_water,temps_fd,temps_crystals,      &
+          temps_snow,temps_graupel,temps_hail,      &
+          fws_fd,fws_crystals,fws_snow,             &
+          fws_graupel,fws_hail,                     &
+          usetables,                                &
+          twolayer_hail,twolayer_graupel,twolayer_fd,twolayer_snow,rpquada,usequad
+
+SAVE ! [KS >> This "SAVE" possibly interfering]
+
+! JCS -- if usetables is TRUE, this module will read the precomputed scattering amplitudes.
+! If usetables is 0, this module will do nothing, and the program will
+! calculate the scattering amplitudes as necessary within the program (that is,
+! no lookup tables will be used). If usetables is 1, we'll use precomputed
+! scattering amplitudes. usetables(water,fd,crystals,snow,graupel,hail)
+integer, dimension(6) :: usetables = (/1,0,0,1,1,1/)
+! JCS -- If set to 1, the two-layer T-matrix scattering code will be used where
+! necessary. If 0, then we'll only use the homogeneous-mixture T-matrix code.
+integer :: twolayer_hail = 1
+integer :: twolayer_graupel = 1
+integer :: twolayer_fd = 1
+integer :: twolayer_snow = 1
+
+! JCS - Use quad precision for two-layer calculations for large sizes?
+logical,parameter :: usequad = .true.
+! JCS - If usequad is true, then rpquada will be used to define the rp at which
+! quad-precision 2-layer t-matrix will be called (that is, quad-precision is
+! used for rp >= rpquada). rpquada(water, fd, snow/crystals, gruapel, hail)
+double precision, dimension(5) :: rpquada = (/10.0d1,2.0d0,1.5d0,2.0d0,2.0d0/)
+
+! JCS -- in the current version of HUCM, each species has the same number of
+! bins (i.e., NKR, which is set in the microprm.F90 file/module).
+! >> KS (comment-out) : integer, parameter :: nbins=NKR
+
+! JCS -- each hydrometeor species will have a 3-dimensional table sized
+! NKR x ntemps x nfws (that is, number of bins by number of temperatures by
+! number of water fractions).
+! JCS -- arrays are ordered as (water,fd,snow/crystals,graupel,hail)
+integer, dimension(5),parameter :: tstart = (/-20,-20,-20,-20,-20/), ntemps = (/61,31,31,61,61/),  &
+                                   dtemp = (/1,1,1,1,1/), nfws = (/1,101,101,101,101/)
+
+! >> [KS] integer, allocatable :: temps_water(:), temps_fd(:), temps_crystals(:), temps_snow(:), temps_graupel(:), temps_hail(:)
+integer :: i,ios,iiwl,ispecies
+integer, parameter, dimension(ntemps(1)) :: temps_water=(/ (dtemp(1)*(i-1)+tstart(1),i=1,ntemps(1) )/)
+integer, parameter, dimension(ntemps(2)) :: temps_fd=(/(dtemp(2)*(i-1)+tstart(2),i=1,ntemps(2))/)
+integer, parameter, dimension(ntemps(3)) :: temps_crystals=(/(dtemp(3)*(i-1)+tstart(3),i=1,ntemps(3))/)
+integer, parameter, dimension(ntemps(3)) :: temps_snow=(/(dtemp(3)*(i-1)+tstart(3),i=1,ntemps(3))/)
+integer, parameter, dimension(ntemps(4)) :: temps_graupel=(/(dtemp(4)*(i-1)+tstart(4),i=1,ntemps(4))/)
+integer, parameter, dimension(ntemps(5)) :: temps_hail=(/(dtemp(5)*(i-1)+tstart(5),i=1,ntemps(5))/)
+
+! JCS - If fvw=1.0 (i.e., 100%), then it should be considered rain.
+! Units are decimal fraction from 0.0 to 1.0
+real :: fws_water=1.0
+! >> [KS] real, allocatable :: fws_fd(:), fws_crystals(:), fws_snow(:), fws_graupel(:), fws_hail(:)
+real, parameter, dimension(nfws(2)) :: fws_fd=(/(1.0/(nfws(2)-1)*(i-1),i=1,nfws(2))/)
+real, parameter, dimension(nfws(3)) :: fws_crystals=(/(1.0/(nfws(3)-1)*(i-1),i=1,nfws(3))/)
+real, parameter, dimension(nfws(3)) :: fws_snow=(/(1.0/(nfws(3)-1)*(i-1),i=1,nfws(3))/)
+real, parameter, dimension(nfws(4)) :: fws_graupel=(/(1.0/(nfws(4)-1)*(i-1),i=1,nfws(4))/)
+real, parameter, dimension(nfws(5)) :: fws_hail=(/(1.0/(nfws(5)-1)*(i-1),i=1,nfws(5))/)
+
+! JCS - Array of wavelengths used in the polarimetric emulator/polar_hucm.F90
+! Wavelengths should be in units of cm. The number of wavelengths must match the
+! number of filesnames and the size of the FILENAMES array
+INTEGER,parameter :: nwavelengths = 1
+DOUBLE PRECISION :: WAVELENGTH1, WAVELENGTH2, WAVELENGTH3
+DOUBLE PRECISION, DIMENSION(3),parameter :: WAVELENGTHS = (/11.0D0, 5.5D0, 3.2D0/)
+CHARACTER(LEN=20),parameter :: OUTFILENAME1='GRADS_MOV_SBAND', OUTFILENAME2='GRADS_MOV_CBAND', &
+                                OUTFILENAME3='GRADS_MOV_XBAND'
+
+! >> [KS] CHARACTER(LEN=20), ALLOCATABLE :: FILENAMES(:)
+CHARACTER(LEN=20),parameter,dimension(nwavelengths) :: FILENAMES=(/OUTFILENAME1/)
+
+CHARACTER(LEN=256),parameter :: scattering_dir_prefix = 'scattering_tables_2layer_high_quad_1dT_1%fw'
+! >> [KS] CHARACTER(LEN=256), ALLOCATABLE :: scattering_dir(:)
+CHARACTER(LEN=256),dimension(nwavelengths) :: scattering_dir
+
+CHARACTER(Len=3) :: wlstr
+
+! JCS - below are the tables that will hold the scattering amplitudes
+! They are named as f(a for horizontal, b for vertical)(f for forward, b for
+! backward),(1 for water, 1fd for freezing drops, 2d for dendrites, 2p for plates,
+! 2c for columns, 3 for snow aggregates, 4 for graupel, and 5 for hail)
+double complex, allocatable :: faf1(:,:,:,:),fbf1(:,:,:,:),fab1(:,:,:,:),fbb1(:,:,:,:)
+double complex, allocatable :: faf1fd(:,:,:,:),fbf1fd(:,:,:,:),fab1fd(:,:,:,:),fbb1fd(:,:,:,:)
+double complex, allocatable :: faf2d(:,:,:,:),fbf2d(:,:,:,:),fab2d(:,:,:,:),fbb2d(:,:,:,:)
+double complex, allocatable :: faf2p(:,:,:,:),fbf2p(:,:,:,:),fab2p(:,:,:,:),fbb2p(:,:,:,:)
+double complex, allocatable :: faf2c(:,:,:,:),fbf2c(:,:,:,:),fab2c(:,:,:,:),fbb2c(:,:,:,:)
+double complex, allocatable :: faf3(:,:,:,:),fbf3(:,:,:,:),fab3(:,:,:,:),fbb3(:,:,:,:)
+double complex, allocatable :: faf4(:,:,:,:),fbf4(:,:,:,:),fab4(:,:,:,:),fbb4(:,:,:,:)
+double complex, allocatable :: faf5(:,:,:,:),fbf5(:,:,:,:),fab5(:,:,:,:),fbb5(:,:,:,:)
+
+integer, dimension(1) :: itemp, infw
+! >> [KS] integer :: ispecies, i, ios, iiwl
+
+!NAMELIST /scatttables/ usetables,twolayer_hail,twolayer_graupel,twolayer_fd,twolayer_snow, &
+!                       usequad,rpquada,tstart,ntemps,dtemp,nfws, &
+!                       nwavelengths, wavelengths, outfilename1, outfilename2, outfilename3, &
+!                       scattering_dir_prefix
+
+CONTAINS
+
+SUBROUTINE LOAD_TABLES(nbins)
+
+implicit none
+
+integer istatus
+character*256 :: header,header2
+character*256 :: fname
+integer :: i,j,k
+character*3 :: temp, fw
+integer,intent(in) :: nbins   ! >> (KS)
+real,dimension(nbins) :: m    ! >> (KS)
+
+
+!OPEN(101,FILE='scatt_tables.input',STATUS="old")
+!    read(101,scatttables)
+!CLOSE(101)
+!print *,wavelengths
+
+!>>ALLOCATE(temps_water(ntemps(1)),stat=istatus)
+!>>ALLOCATE(temps_fd(ntemps(2)),stat=istatus)
+!>>ALLOCATE(temps_crystals(ntemps(3)),stat=istatus)
+!>>ALLOCATE(temps_snow(ntemps(3)),stat=istatus)
+!>>ALLOCATE(temps_graupel(ntemps(4)),stat=istatus)
+!>>ALLOCATE(temps_hail(ntemps(5)),stat=istatus)
+
+!>>ALLOCATE(fws_fd(nfws(2)),stat=istatus)
+!>>ALLOCATE(fws_crystals(nfws(3)),stat=istatus)
+!>>ALLOCATE(fws_snow(nfws(3)),stat=istatus)
+!>>ALLOCATE(fws_graupel(nfws(4)),stat=istatus)
+!>>ALLOCATE(fws_hail(nfws(5)),stat=istatus)
+
+!>>temps_water=(/ (dtemp(1)*(i-1)+tstart(1),i=1,ntemps(1) )/)
+!>>temps_fd=(/(dtemp(2)*(i-1)+tstart(2),i=1,ntemps(2))/)
+!>>temps_crystals=(/(dtemp(3)*(i-1)+tstart(3),i=1,ntemps(3))/)
+!>>temps_snow=(/(dtemp(3)*(i-1)+tstart(3),i=1,ntemps(3))/)
+!>>temps_graupel=(/(dtemp(4)*(i-1)+tstart(4),i=1,ntemps(4))/)
+!>>temps_hail=(/(dtemp(5)*(i-1)+tstart(5),i=1,ntemps(5))/)
+
+!>>fws_fd=(/(1.0/(nfws(2)-1)*(i-1),i=1,nfws(2))/)
+!>>fws_crystals=(/(1.0/(nfws(3)-1)*(i-1),i=1,nfws(3))/)
+!>>fws_snow=(/(1.0/(nfws(3)-1)*(i-1),i=1,nfws(3))/)
+!>>fws_graupel=(/(1.0/(nfws(4)-1)*(i-1),i=1,nfws(4))/)
+!>>fws_hail=(/(1.0/(nfws(5)-1)*(i-1),i=1,nfws(5))/)
+
+!>>ALLOCATE(FILENAMES(nwavelengths),stat=istatus)
+!ALLOCATE(WAVELENGTHS(nwavelengths),stat=istatus)
+!>>ALLOCATE(scattering_dir(nwavelengths),stat=istatus)
+
+!>>FILENAMES=(/OUTFILENAME1,OUTFILENAME2,OUTFILENAME3/)
+!WAVELENGTHS=(/WAVELENGTH1,WAVELENGTH2,WAVELENGTH3/)
+
+do iiwl=1,nwavelengths
+  write(wlstr,'(I3.3)') int(WAVELENGTHS(iiwl)*10.0d0)
+  scattering_dir(iiwl)=TRIM(scattering_dir_prefix)//'_'//wlstr//'/'
+  WRITE(*,*) 'scattering input directory is source/',TRIM(scattering_dir(iiwl))
+enddo
+
+DO ispecies=1,size(usetables)
+  if((ispecies==1) .AND. usetables(ispecies)) then ! rain
+      WRITE(*,*) 'READING SCATTERING TABLES: RAIN'
+      ALLOCATE(faf1(nbins,nfws(1),ntemps(1),nwavelengths),stat=istatus)
+      ALLOCATE(fbf1(nbins,nfws(1),ntemps(1),nwavelengths),stat=istatus)
+      ALLOCATE(fab1(nbins,nfws(1),ntemps(1),nwavelengths),stat=istatus)
+      ALLOCATE(fbb1(nbins,nfws(1),ntemps(1),nwavelengths),stat=istatus)
+      do iiwl=1,nwavelengths
+        do k=1,ntemps(1)
+          write(temp,"(SP,I3.2)") temps_water(k)
+          !>>fname='source/'//TRIM(scattering_dir(iiwl))//'/RAIN_'//temp//'C_100fvw.sct'
+          fname=TRIM(scattering_dir(iiwl))//'/RAIN_'//temp//'C_100fvw.sct'
+!!          WRITE(*,*) TRIM(fname)
+          open(unit=1,file=fname,status="old",form="formatted",iostat=ios)
+          if(ios.eq.0) then
+              read(1,*) header
+              read(1,*) header2
+              do i=1,nbins
+                read(1,'(9e13.5)') m(i), fab1(i,1,k,iiwl), fbb1(i,1,k,iiwl), &
+                                        faf1(i,1,k,iiwl), fbf1(i,1,k,iiwl)
+              enddo
+              close(1)
+          else
+              WRITE(*,*) '*****PROBLEM READING RAIN SCATTERING AMPLITUDE FILE*****'
+              WRITE(*,*) TRIM(fname)
+!!              WRITE(*,*) 'Temp=',TRIM(temp),' C, fvw=100'
+              WRITE(*,*) '*****NO LOOKUP TABLES FOR RAIN WILL BE USED*****'
+              usetables(1)=0
+          endif
+        enddo
+      enddo
+  elseif(ispecies==2 .AND. usetables(ispecies)) then ! fd
+      WRITE(*,*) 'READING SCATTERING TABLES: FD'
+      ALLOCATE(faf1fd(nbins,nfws(2),ntemps(2),nwavelengths),stat=istatus)
+      ALLOCATE(fbf1fd(nbins,nfws(2),ntemps(2),nwavelengths),stat=istatus)
+      ALLOCATE(fab1fd(nbins,nfws(2),ntemps(2),nwavelengths),stat=istatus)
+      ALLOCATE(fbb1fd(nbins,nfws(2),ntemps(2),nwavelengths),stat=istatus)
+      do iiwl=1,nwavelengths
+       do k=1,ntemps(2)
+        write(temp,"(SP,I3.2)") temps_fd(k)
+        do j=1,nfws(2)
+          write(fw,"(I3.3)") NINT(fws_fd(j)*100)
+          !>>fname='source/'//TRIM(scattering_dir(iiwl))//'/FD_'//temp//'C_'//fw//'fvw.sct'
+          fname=TRIM(scattering_dir(iiwl))//'/FD_'//temp//'C_'//fw//'fvw.sct'
+          open(unit=1,file=fname,status="old",form="formatted",iostat=ios)
+          if(ios.eq.0) then
+              read(1,*) header
+              read(1,*) header2
+              do i=1,nbins
+                read(1,'(9e13.5)') m(i), fab1fd(i,j,k,iiwl), fbb1fd(i,j,k,iiwl), &
+                    faf1fd(i,j,k,iiwl), fbf1fd(i,j,k,iiwl)
+              enddo
+              close(1)
+          else
+              WRITE(*,*) '*****PROBLEM READING FD SCATTERING AMPLITUDE FILE*****'
+              WRITE(*,*) TRIM(fname)
+!!              WRITE(*,*) 'Temp=',TRIM(temp),' C, fvw=',TRIM(fw)
+              WRITE(*,*) '*****NO LOOKUP TABLES FOR FD WILL BE USED*****'
+              usetables(2)=0
+          endif
+        enddo
+       enddo
+      enddo
+  elseif(ispecies==3 .AND. usetables(ispecies)) then ! ice crystals (plates, dendrites, columns)
+      WRITE(*,*) 'READING SCATTERING TABLES: ICE CRYSTALS'
+      ALLOCATE(faf2d(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fbf2d(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fab2d(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fbb2d(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(faf2p(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fbf2p(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fab2p(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fbb2p(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(faf2c(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fbf2c(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fab2c(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fbb2c(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      do iiwl=1,nwavelengths
+       do k=1,ntemps(3)
+        write(temp,"(SP,I3.2)") temps_crystals(k)
+        do j=1,nfws(3)
+          write(fw,"(I3.3)") NINT(fws_crystals(j)*100)
+          !>>fname='source/'//TRIM(scattering_dir(iiwl))//'/DENDRITES_'//temp//'C_'//fw//'fvw.sct'
+          fname=TRIM(scattering_dir(iiwl))//'/DENDRITES_'//temp//'C_'//fw//'fvw.sct'
+          open(unit=1,file=fname,status="old",form="formatted",iostat=ios)
+          if(ios.eq.0) then
+              read(1,*) header
+              read(1,*) header2
+              do i=1,nbins
+                read(1,'(9e13.5)') m(i), fab2d(i,j,k,iiwl), fbb2d(i,j,k,iiwl), &
+                    faf2d(i,j,k,iiwl), fbf2d(i,j,k,iiwl)
+              enddo
+              close(1)
+          else
+              WRITE(*,*) '*****PROBLEM READING DENDRITES SCATTERING AMPLITUDE FILE*****'
+              WRITE(*,*) 'Temp=',TRIM(temp),' C, fvw=',TRIM(fw)
+              WRITE(*,*) '*****NO LOOKUP TABLES FOR DENDRITES WILL BE USED*****'
+              usetables(3)=0
+          endif
+        enddo
+       enddo
+       do k=1,ntemps(3)
+        write(temp,"(SP,I3.2)") temps_crystals(k)
+        do j=1,nfws(3)
+          write(fw,"(I3.3)") NINT(fws_crystals(j)*100)
+          !>>fname='source/'//TRIM(scattering_dir(iiwl))//'/PLATES_'//temp//'C_'//fw//'fvw.sct'
+          fname=TRIM(scattering_dir(iiwl))//'/PLATES_'//temp//'C_'//fw//'fvw.sct'
+          open(unit=1,file=fname,status="old",form="formatted",iostat=ios)
+          if(ios.eq.0) then
+              read(1,*) header
+              read(1,*) header2
+              do i=1,nbins
+                read(1,'(f5.2,8e13.5)') m(i), fab2p(i,j,k,iiwl), fbb2p(i,j,k,iiwl), &
+                    faf2p(i,j,k,iiwl), fbf2p(i,j,k,iiwl)
+              enddo
+              close(1)
+          else
+              WRITE(*,*) '*****PROBLEM READING PLATES SCATTERING AMPLITUDE FILE*****'
+              WRITE(*,*) 'Temp=',TRIM(temp),' C, fvw=',TRIM(fw)
+              WRITE(*,*) '*****NO LOOKUP TABLES FOR PLATES WILL BE USED*****'
+              usetables(3)=0
+          endif
+        enddo
+       enddo
+       do k=1,ntemps(3)
+        write(temp,"(SP,I3.2)") temps_crystals(k)
+        do j=1,nfws(3)
+          write(fw,"(I3.3)") NINT(fws_crystals(j)*100)
+          !fname='source/'//TRIM(scattering_dir(iiwl))//'/COLUMNS_'//temp//'C_'//fw//'fvw.sct'
+          fname=TRIM(scattering_dir(iiwl))//'/COLUMNS_'//temp//'C_'//fw//'fvw.sct'
+          open(unit=1,file=fname,status="old",form="formatted",iostat=ios)
+          if(ios.eq.0) then
+              read(1,*) header
+              read(1,*) header2
+              do i=1,nbins
+                read(1,'(9e13.5)') m(i), fab2c(i,j,k,iiwl), fbb2c(i,j,k,iiwl), &
+                    faf2c(i,j,k,iiwl), fbf2c(i,j,k,iiwl)
+              enddo
+              close(1)
+          else
+              WRITE(*,*) '*****PROBLEM READING COLUMNS SCATTERING AMPLITUDE FILE*****'
+              WRITE(*,*) 'Temp=',TRIM(temp),' C, fvw=',TRIM(fw)
+              WRITE(*,*) '*****NO LOOKUP TABLES FOR COLUMNS WILL BE USED*****'
+              usetables(3)=0
+          endif
+        enddo
+       enddo
+      enddo
+  elseif(ispecies==4 .AND. usetables(ispecies)) then ! snow (aggregates)
+      WRITE(*,*) 'READING SCATTERING TABLES: SNOW'
+      ALLOCATE(faf3(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fbf3(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fab3(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      ALLOCATE(fbb3(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
+      do iiwl=1,nwavelengths
+       do k=1,ntemps(3)
+        write(temp,"(SP,I3.2)") temps_snow(k)
+        do j=1,nfws(3)
+          write(fw,"(I3.3)") NINT(fws_snow(j)*100)
+          !>>fname='source/'//TRIM(scattering_dir(iiwl))//'/SNOW_'//temp//'C_'//fw//'fvw.sct'
+          fname=TRIM(scattering_dir(iiwl))//'/SNOW_'//temp//'C_'//fw//'fvw.sct'
+          open(unit=1,file=fname,status="old",form="formatted",iostat=ios)
+          if(ios.eq.0) then
+              read(1,*) header
+              read(1,*) header2
+              do i=1,nbins
+                read(1,'(9e13.5)') m(i), fab3(i,j,k,iiwl), fbb3(i,j,k,iiwl), &
+                    faf3(i,j,k,iiwl), fbf3(i,j,k,iiwl)
+              enddo
+              close(1)
+          else
+              WRITE(*,*) '*****PROBLEM READING SNOW SCATTERING AMPLITUDE FILE*****'
+              WRITE(*,*) TRIM(fname)
+!!              WRITE(*,*) 'Temp=',TRIM(temp),' C, fvw=',TRIM(fw)
+              WRITE(*,*) '*****NO LOOKUP TABLES FOR SNOW WILL BE USED*****'
+              usetables(4)=0
+          endif
+        enddo
+       enddo
+      enddo
+  elseif(ispecies==5 .AND. usetables(ispecies)) then ! graupel
+      WRITE(*,*) 'READING SCATTERING TABLES: GRAUPEL'
+      ALLOCATE(faf4(nbins,nfws(4),ntemps(4),nwavelengths),stat=istatus)
+      ALLOCATE(fbf4(nbins,nfws(4),ntemps(4),nwavelengths),stat=istatus)
+      ALLOCATE(fab4(nbins,nfws(4),ntemps(4),nwavelengths),stat=istatus)
+      ALLOCATE(fbb4(nbins,nfws(4),ntemps(4),nwavelengths),stat=istatus)
+      do iiwl=1,nwavelengths
+       do k=1,ntemps(4)
+        write(temp,"(SP,I3.2)") temps_graupel(k)
+        do j=1,nfws(4)
+          write(fw,"(I3.3)") NINT(fws_graupel(j)*100)
+          !>>fname='source/'//TRIM(scattering_dir(iiwl))//'/GRAUPEL_'//temp//'C_'//fw//'fvw.sct'
+          fname=TRIM(scattering_dir(iiwl))//'/GRAUPEL_'//temp//'C_'//fw//'fvw.sct'
+          open(unit=1,file=fname,status="old",form="formatted",iostat=ios)
+          if(ios.eq.0) then
+              read(1,*) header
+              read(1,*) header2
+              do i=1,nbins
+                read(1,'(9e13.5)') m(i), fab4(i,j,k,iiwl), fbb4(i,j,k,iiwl), &
+                    faf4(i,j,k,iiwl), fbf4(i,j,k,iiwl)
+              enddo
+              close(1)
+          else
+              WRITE(*,*) '*****PROBLEM READING GRAUPEL SCATTERING AMPLITUDE FILE*****'
+              WRITE(*,*) TRIM(fname)
+!!              WRITE(*,*) 'Temp=',TRIM(temp),' C, fvw=',TRIM(fw)
+              WRITE(*,*) '*****NO LOOKUP TABLES FOR GRAUPEL WILL BE USED*****'
+              usetables(5)=0
+          endif
+        enddo
+       enddo
+      enddo
+  elseif(ispecies==6 .AND. usetables(ispecies)) then ! hail
+      WRITE(*,*) 'READING SCATTERING TABLES: HAIL'
+      ALLOCATE(faf5(nbins,nfws(5),ntemps(5),nwavelengths),stat=istatus)
+      ALLOCATE(fbf5(nbins,nfws(5),ntemps(5),nwavelengths),stat=istatus)
+      ALLOCATE(fab5(nbins,nfws(5),ntemps(5),nwavelengths),stat=istatus)
+      ALLOCATE(fbb5(nbins,nfws(5),ntemps(5),nwavelengths),stat=istatus)
+      do iiwl=1,nwavelengths
+       do k=1,ntemps(5)
+        write(temp,"(SP,I3.2)") temps_hail(k)
+        do j=1,nfws(5)
+          write(fw,"(I3.3)") NINT(fws_hail(j)*100)
+          !>>fname='source/'//TRIM(scattering_dir(iiwl))//'/HAIL_'//temp//'C_'//fw//'fvw.sct'
+          fname=TRIM(scattering_dir(iiwl))//'/HAIL_'//temp//'C_'//fw//'fvw.sct'
+          open(unit=1,file=fname,status="old",form="formatted",iostat=ios)
+          if(ios.eq.0) then
+              read(1,*) header
+              read(1,*) header2
+              do i=1,nbins
+                read(1,'(9e13.5)') m(i), fab5(i,j,k,iiwl), fbb5(i,j,k,iiwl), &
+                    faf5(i,j,k,iiwl), fbf5(i,j,k,iiwl)
+              enddo
+              close(1)
+          else
+              WRITE(*,*) '*****PROBLEM READING HAIL SCATTERING AMPLITUDE FILE*****'
+              WRITE(*,*) TRIM(fname)
+!!              WRITE(*,*) 'Temp=',TRIM(temp),' C, fvw=',TRIM(fw)
+              WRITE(*,*) '*****NO LOOKUP TABLES FOR HAIL WILL BE USED*****'
+              usetables(6)=0
+          endif
+        enddo
+       enddo
+      enddo
+  endif
+enddo
+
+END SUBROUTINE LOAD_TABLES
+
+SUBROUTINE CHECK_ALLOCATION_STATUS(istatus)
+implicit none
+integer :: istatus
+
+END SUBROUTINE CHECK_ALLOCATION_STATUS
+
+
+END MODULE scatt_tables
+! +----------------------------------------------------------------------------+
+! +----------------------------------------------------------------------------+
+MODULE module_mp_SBM_polar_radar
+
+! Kind paramater
+INTEGER, PARAMETER, PRIVATE:: R8SIZE = 8
+INTEGER, PARAMETER, PRIVATE:: R4SIZE = 4
+
+private
+public polar_hucm
+
+     !  Parameter (NPN1=100, NPNG1=500, NPNG2=2*NPNG1, NPN2=2*NPN1,NPL=NPN2+1, NPN3=NPN1+1,  NPN4=NPN1, NPN5=2*NPN4, NPN6=NPN4+1)
+      LOGICAL, PRIVATE,PARAMETER :: TRANSMISSION=.FALSE.
+     ! INTEGER, PRIVATE,PARAMETER :: ICEMAX = 3, NKR_43Bins = 43, NKR_33Bins = 33
+     ! INTEGER, PRIVATE,PARAMETER :: ICEMAX=3,NKR=33
+     ! INTEGER :: NKR
+       CONTAINS
+
+
+       subroutine polar_hucm &
+				  (FF1,FF2,FF3,FF4,FF5,FF1_FD, 								&
+				   FL3,FL4,FL5,FL1_FD, 										&
+				   bulk,temp,RORD,wavelength,iwl,distance, 					&
+				   dx,dy,zmks_1d, 											&
+				   out1,out2,out3,out4,out5,out6,out7,out8,out9,   			&
+				   bin_mass,tab_colum,tab_dendr, tab_snow, bin_log, 		&
+				   ijk,kx,ky,kz,kts,kte,number_bin,ICEMAX,icloud,itimestep, &
+				   faf1,fbf1,fab1,fbb1, 									&
+				   !faf1fd,fbf1fd,fab1fd,fbb1fd, 							&
+				   !faf2d,fbf2d,fab2d,fbb2d,     							&
+				   !faf2p,fbf2p,fab2p,fbb2p,     							&
+				   !faf2c,fbf2c,fab2c,fbb2c,     							&
+					faf3,fbf3,fab3,fbb3,         							&
+					faf4,fbf4,fab4,fbb4,         							&
+					faf5,fbf5,fab5,fbb5,         							&
+					temps_water,temps_fd,temps_crystals,  					&
+					temps_snow,temps_graupel,temps_hail,  					&
+					fws_fd,fws_crystals,fws_snow,		  					&
+					fws_graupel,fws_hail,usetables)
+
+!**** *****************************************
+!     temperature          Celsius degree
+!     wavelength           cm
+!     density              g/cm^3
+!     equivolume diameter  mm
+!     amplitudes           mm
+!     mass                 g
+!     dx                   m
+!     dz                   m
+!     distance             m
+!     elevation            degree
+! &
+!**** ******************************************
+
+	  implicit none
+
+! ### (KS) : Interface Vars.
+
+	  integer,intent(in) :: number_bin, icemax, kte, kts, kz, ky, kx, ijk, icloud, itimestep, iwl
+	  real(kind=r8size),intent(in) :: zmks_1d(KTS:KTE), bin_mass(number_bin), tab_colum(number_bin), tab_dendr(number_bin), &
+                       				     tab_snow(number_bin),bin_log(number_bin), bulk(number_bin), temp, RORD, wavelength,   &
+			                             distance, dx,dy
+	  real(kind=r8size),intent(out) ::  out1(10), out2(10), out3(10), out4(10), &
+									                   out5(10),out6(10), out7(10),out8(10), out9(10)
+	  real(kind=r8size),intent(inout) :: FF1(number_bin),FF2(number_bin,ICEMAX),FF3(number_bin),FF4(number_bin),FF5(number_bin), &
+						                          FF1_FD(number_bin), FL3(number_bin),FL4(number_bin),FL5(number_bin), &
+		                                  FL1_FD(number_bin)
+	  double complex,intent(in), dimension(:,:,:,:) :: faf1,fbf1,fab1,fbb1, 									&
+													  !faf1fd,fbf1fd,fab1fd,fbb1fd, 							&
+													  !faf2d,fbf2d,fab2d,fbb2d,     							&
+													  !faf2p,fbf2p,fab2p,fbb2p,     							&
+													  !faf2c,fbf2c,fab2c,fbb2c,     							&
+													   faf3,fbf3,fab3,fbb3,         							&
+													   faf4,fbf4,fab4,fbb4,         							&
+													   faf5,fbf5,fab5,fbb5
+	  integer,intent(in),dimension(:) :: temps_water,temps_fd,temps_crystals,  					&
+										 temps_snow,temps_graupel,temps_hail,  					&
+										 usetables
+	  real(kind=r4size),intent(in),dimension(:) :: fws_fd,fws_crystals,fws_snow,fws_graupel,fws_hail
+
+! ### Interface Vars.
+
+! ### Local Vars.
+
+	real(kind=r8size) :: bin_conc(number_bin)
+	real(kind=r8size) :: ldr, kdp, cdr, ah, adp, zh
+
+	complex(8) :: dc_water, dc_ice, dc_wet, rhv, fa, fb, fa0, fb0, dc_wet_core
+	complex(8) :: dc_wet_inner, dc_snow
+	complex(8) :: sum_rhv, &
+                   ssum_rhv
+
+	complex(8) :: f_a(number_bin), f_b(number_bin), &
+                 f_a0(number_bin), f_b0(number_bin)
+
+	real(kind=r8size) :: a_w(7), a_column(7), a(7,number_bin)
+	real(kind=r8size), parameter :: pi = 3.14159265D0, den_water = 1.0d0, den_ice = 0.91, den_grau0 = 0.4
+	real(kind=r8size) :: sum_zh, sum_zv, ssum_zv, sum_ldr, sum_kdp, ssum_zh, ssum, zv, ssum_ldr, ssum_kdp,    &
+						sum_cdr, ssum_cdr, sum_ah, sum_adp, ssum_ah, ssum_adp, degree, z, x, elev, &
+						temperature, b_mass, water_mass, coef1, coef2, coef3, hail_mass, fract_mass_water, &
+						density_average, fvw, fd_mass, density_bulk, grau_mass, fract_water_crit,fract_water_scaled, &
+						fvw_core, density_core, plate_mass, dendr_mass, bulk_mass, dendr_log, density_dry, &
+						dd_dry, snow_mass, snow_log, beta, colum_mass, colum_log
+	integer :: kb, i, itemp_w(size(temps_water)), infw_w, itemp_fd(size(temps_fd)), infw_fd(size(fws_fd)), &
+			   itemp_g(size(temps_graupel)), infw_g(size(fws_graupel)), itemp_h(size(temps_hail)), infw_h(size(fws_hail)), &
+			   itemp_s(size(temps_snow)), infw_s(size(fws_snow))
+
+! ### Local Vars.
+
+  itemp_w = 0
+
+
+
+!**** **************************************************
+! General input &
+!**** ********************
+      sum_zh   =  0.0d0
+      sum_zv   =  0.0d0
+      sum_ldr  =  0.0d0
+      sum_kdp  =  0.0d0
+      ssum_zh  =  0.0d0
+      ssum_zv  =  0.0d0
+      ssum_ldr =  0.0d0
+      ssum_kdp =  0.0d0
+      sum_rhv  = (0.d0,0.d0)
+      ssum_rhv = (0.d0,0.d0)
+      sum_cdr = 0.0d0
+      ssum_cdr = 0.0d0
+      sum_ah = 0.0d0
+      sum_adp = 0.0d0
+      ssum_ah=0.0d0
+      ssum_adp=0.0d0
+
+      degree=1.0d0/3.0d0
+
+!     z = dz*(kz-1)
+      z = zmks_1d(kz)
+      x = dx*(kx-1)
+
+! JCS - Set elevation to 0 degrees
+      !elev=atan(z/(x+distance))
+	  elev = 0.0d0
+
+!**** ******************************************************
+! Water and ice dielectric constant &
+!**** *************************************
+
+      temperature = temp-273.15d0
+
+      call calc_dc_water(temperature, wavelength, dc_water)
+
+!*** JCS - Don't allow ice to exceed 0.0 C!
+      call calc_dc_ice(min(temperature,0.0D0), wavelength, dc_ice)
+
+!**** ******************************************************
+! Water amplitude &
+!**** *************************
+! Andrei's new change of 4.08.11                              (start)
+
+      call calc_orient_water(a_w)
+
+! Andrei's new change of 4.08.11                                (end)
+
+      do kb=1,number_bin
+
+         bin_conc(kb)= 0.23105d6*FF1(kb)*RORD/bin_mass(kb)
+         b_mass      = bin_conc(kb)*bin_mass(kb)
+
+         if(b_mass.gt.1.0d-8) then
+
+           water_mass = bin_mass(kb)
+
+	         if(usetables(1) == 1) then
+               itemp_w = minloc(abs(dble(temps_water)-temperature))
+               infw_w = 1
+               f_a(kb)  = fab1(kb,1,itemp_w(1),iwl)
+               f_b(kb)  = fbb1(kb,1,itemp_w(1),iwl)
+               f_a0(kb) = faf1(kb,1,itemp_w(1),iwl)
+               f_b0(kb) = fbf1(kb,1,itemp_w(1),iwl)
+           else
+
+   				      call calc_scattering_water &
+  						        (wavelength, water_mass,dc_water,fa,fb,fa0,fb0)
+
+ 				               f_a(kb)  = fa
+		                   f_b(kb)  = fb
+		                   f_a0(kb) = fa0
+   				             f_b0(kb) = fb0
+            endif
+
+         else
+
+           f_a(kb)  = (0.d0,0.d0)
+           f_b(kb)  = (0.d0,0.d0)
+           f_a0(kb) = (0.d0,0.d0)
+           f_b0(kb) = (0.d0,0.d0)
+
+         endif
+
+      enddo
+! cycle by kb
+
+! Andrei's new change of 4.08.11                              (start)
+      do kb=1,number_bin  ! ### (KS)
+         do i=1,7
+	    	     a(i,kb)=a_w(i)
+ 		     enddo
+      enddo
+! Andrei's new change of 4.08.11                                (end)
+
+      call integr &
+      			(a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk,kx,kz,1,number_bin)
+
+      coef1 = 4.0d4*(wavelength/pi)**4/ &
+                     abs((dc_water-1.0d0)/(dc_water+2.0d0))**2
+
+      coef2 = 0.18d1*wavelength/pi
+      coef3 = 8.686d-2*wavelength
+
+      sum_zh  = coef1*zh
+      sum_zv  = coef1*zv
+      sum_ldr = coef1*ldr
+      sum_kdp = coef2*kdp
+      sum_rhv = coef1*rhv
+      !sum_cdr = (zh+zv-2*abs(rhv))/(zh+zv+2*abs(rhv))
+      sum_cdr = cdr
+      sum_ah = coef3*ah
+      sum_adp = coef3*adp
+
+      call output(sum_zh,sum_zv,sum_ldr,sum_kdp,sum_rhv,sum_cdr,sum_ah,sum_adp,out1)
+
+!**** ********************************************************
+! Hail  amplitude &
+!**** *******************
+
+      do kb=1,number_bin
+
+         bin_conc(kb)=0.23105d6*FF5(kb)*RORD/bin_mass(kb)
+
+         b_mass=bin_conc(kb)*bin_mass(kb)
+
+         if(b_mass.gt.1.0d-8) then
+
+           hail_mass=bin_mass(kb)
+
+           if(FL5(kb) < 0.01d0) FL5(kb) = 0.01d0
+
+           fract_mass_water=FL5(kb)
+
+           fvw = den_ice*fract_mass_water/((1-fract_mass_water)*den_water+fract_mass_water*den_ice)
+
+  	       if(usetables(6) == 1) then
+                 itemp_h = minloc(abs(temps_hail-temperature))
+                 infw_h = minloc(abs(fws_hail-fvw))
+                 f_a(kb)  = fab5(kb,infw_h(1),itemp_h(1),iwl)
+                 f_b(kb)  = fbb5(kb,infw_h(1),itemp_h(1),iwl)
+                 f_a0(kb) = faf5(kb,infw_h(1),itemp_h(1),iwl)
+                 f_b0(kb) = fbf5(kb,infw_h(1),itemp_h(1),iwl)
+  			         !if (f_a(kb)*f_b(kb)*f_a0(kb)*f_b0(kb) == 0.0d0) then
+                 ! print *,'One of the scattering amplitudes for kb=',kb,' is 0. FIX THIS!'
+                 !endif
+            else
+
+     				     density_average=(1.0d0-fvw)*den_ice+fvw*den_water
+  ! JCS - Although calc_dc_wet_snow uses fvw, it's calculated in the subroutine
+  ! using den_ice, density of water, and fract_mass_water
+  				       call calc_dc_wet_snow &
+  							               (den_ice,fract_mass_water,dc_water,dc_ice,dc_wet)
+                 call calc_scattering_hail(wavelength,hail_mass, &
+  							               den_ice,fract_mass_water,dc_water,dc_ice,dc_wet,fa,fb,fa0,fb0)
+
+        				f_a(kb)  = fa
+        				f_b(kb)  = fb
+        				f_a0(kb) = fa0
+        				f_b0(kb) = fb0
+  	      endif
+
+! new change 4.08.11                                         (start)
+		      call calc_orient(fract_mass_water,a,kb,number_bin) ! ### (KS)
+! new change 4.08.11                                           (end)
+         else
+           f_a(kb)  = (0.d0,0.d0)
+           f_b(kb)  = (0.d0,0.d0)
+           f_a0(kb) = (0.d0,0.d0)
+           f_b0(kb) = (0.d0,0.d0)
+         endif
+      enddo
+! cycle by kb
+
+      call integr &
+      		  (a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk,kx,kz,2,number_bin)
+
+      coef1 = 4.0d4*(wavelength/pi)**4/ &
+              abs((dc_water-1.0d0)/(dc_water+2.0d0))**2
+
+      coef2 = 0.18d1*wavelength/pi
+
+      ssum_zh  = coef1*zh
+      ssum_zv  = coef1*zv
+      ssum_ldr = coef1*ldr
+      ssum_kdp = coef2*kdp
+      ssum_rhv = coef1*rhv
+      !ssum_cdr = (zh+zv-2*abs(rhv))/(zh+zv+2*abs(rhv))
+      ssum_cdr = cdr
+      ssum_ah = coef3*ah
+      ssum_adp = coef3*adp
+
+      sum_zh  = sum_zh + ssum_zh
+      sum_zv  = sum_zv + ssum_zv
+      sum_ldr = sum_ldr + ssum_ldr
+      sum_kdp = sum_kdp + ssum_kdp
+      sum_rhv = sum_rhv + ssum_rhv
+      sum_cdr = sum_cdr + ssum_cdr
+      sum_ah  = sum_ah + ssum_ah
+      sum_adp = sum_adp + ssum_adp
+
+      call output(ssum_zh,ssum_zv,ssum_ldr,ssum_kdp,ssum_rhv,ssum_cdr,&
+                  ssum_ah,ssum_adp,out2)
+
+!**** ********************************************************
+! Freezing drops amplitude &
+!**** *******************
+! ###################################### !
+! We currently do not have FD in WRF-SBM
+! ###################################### !
+
+
+      do kb=1,number_bin
+
+         bin_conc(kb)=0.23105d6*FF1_FD(kb)*RORD/bin_mass(kb)
+
+         b_mass=bin_conc(kb)*bin_mass(kb)
+
+         if(b_mass.gt.1.0d-8) then
+
+           fd_mass = bin_mass(kb)
+
+           if(FL1_FD(kb).lt.0.01d0) FL1_FD(kb)=0.01d0
+
+           fract_mass_water=FL1_FD(kb)
+
+           density_bulk = &
+             			den_water*den_ice*(1.0d0-fract_mass_water)/ &
+            			(den_water*(1.0d0-fract_mass_water)+ &
+             			den_ice*fract_mass_water)
+
+           fvw = den_ice*fract_mass_water/((1-fract_mass_water)*den_water+fract_mass_water*den_ice)
+
+			if(usetables(2) == 1) then
+			    !itemp_fd = minloc(abs(temps_fd-temperature))
+			    !infw_fd = minloc(abs(fws_fd-fvw))
+			    !f_a(kb)  = fab1fd(kb,infw_fd(1),itemp_fd(1),iwl)
+			    !f_b(kb)  = fbb1fd(kb,infw_fd(1),itemp_fd(1),iwl)
+			    !f_a0(kb) = faf1fd(kb,infw_fd(1),itemp_fd(1),iwl)
+			    !f_b0(kb) = fbf1fd(kb,infw_fd(1),itemp_fd(1),iwl)
+			else
+
+				density_average=(1.0d0-fvw)*den_ice+fvw*den_water
+
+				call calc_dc_wet_snow &
+							(den_ice,fract_mass_water,dc_water,dc_ice,dc_wet)
+
+! JCS -- Needed to modify argument list to pass in dc_wet for tmatrix
+! calculations
+				call calc_scattering_fd &
+			 			(wavelength,fd_mass, &
+			 			density_average,fract_mass_water,dc_water,dc_ice,dc_wet, &
+			 			fa,fb,fa0,fb0)
+
+				f_a(kb)  = fa
+				f_b(kb)  = fb
+				f_a0(kb) = fa0
+				f_b0(kb) = fb0
+			endif
+
+			call calc_orient(fract_mass_water,a,kb,number_bin) ! ### (KS)
+
+         else
+
+           f_a(kb)  = (0.d0,0.d0)
+           f_b(kb)  = (0.d0,0.d0)
+           f_a0(kb) = (0.d0,0.d0)
+           f_b0(kb) = (0.d0,0.d0)
+
+         endif
+
+      enddo
+! cycle by kb
+
+      call integr &
+      		(a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk,kx,kz,3,number_bin)
+
+      coef1 = 4.0d4*(wavelength/pi)**4/ &
+              abs((dc_water-1.0d0)/(dc_water+2.0d0))**2
+
+      coef2 = 0.18d1*wavelength/pi
+
+      ssum_zh  = coef1*zh
+      ssum_zv  = coef1*zv
+      ssum_ldr = coef1*ldr
+      ssum_kdp = coef2*kdp
+      ssum_rhv = coef1*rhv
+      !ssum_cdr = (zh+zv-2*abs(rhv))/(zh+zv+2*abs(rhv))
+      ssum_cdr = cdr
+      ssum_ah  = coef3*ah
+      ssum_adp = coef3*adp
+
+      sum_zh  = sum_zh +ssum_zh
+      sum_zv  = sum_zv +ssum_zv
+      sum_ldr = sum_ldr+ssum_ldr
+      sum_kdp = sum_kdp+ssum_kdp
+      sum_rhv = sum_rhv+ssum_rhv
+      sum_ah  = sum_ah +ssum_ah
+      sum_adp = sum_adp+ssum_adp
+      sum_cdr = sum_cdr+ssum_cdr
+
+      call output(ssum_zh,ssum_zv,ssum_ldr,ssum_kdp,ssum_rhv,ssum_cdr,&
+         			ssum_ah,ssum_adp,out3)
+
+
+!**** ***************************************************************
+! Graupel  amplitude &
+!**** ********************
+
+      do kb=1,number_bin
+
+         bin_conc(kb)=0.23105d6*FF4(kb)*RORD/bin_mass(kb)
+
+         b_mass=bin_conc(kb)*bin_mass(kb)
+
+         if(b_mass.gt.1.d-8) then
+
+           grau_mass= bin_mass(kb)
+           fract_mass_water=FL4(kb)
+
+! new change 4.08.11                                         (start)
+           call calc_orient(fract_mass_water,a,kb,number_bin) ! ### (KS)
+! new change 4.08.11                                           (end)
+! JCS - I don't know where the following equation comes from. Regardless,
+! we'll use it to define the maximum fractional water that a particle can have
+! before it begins to have a water coating.
+           fract_water_crit = den_water*(den_ice-den_grau0)/ &
+          						(den_water*(den_ice-den_grau0)+den_ice*den_grau0)
+
+           density_bulk =  &
+             			den_water*den_grau0*(1.0d0-fract_mass_water)/ &
+            			(den_water*(1.0d0-fract_mass_water)+ &
+             			den_grau0*fract_mass_water)
+
+! JCS - Calculate the average density of the graupel varying between
+! den_grau0 and den_water based upon fractional volume of water. The average
+! density needs the fractional volume of water (not fractional mass of water)!
+           fvw = den_grau0*fract_mass_water/((1-fract_mass_water)*den_water+fract_mass_water*den_grau0)
+
+	   	   if(usetables(5) == 1) then
+               itemp_g = minloc(abs(temps_graupel-temperature))
+               infw_g = minloc(abs(fws_graupel-fvw))
+               f_a(kb)  = fab4(kb,infw_g(1),itemp_g(1),iwl)
+               f_b(kb)  = fbb4(kb,infw_g(1),itemp_g(1),iwl)
+               f_a0(kb) = faf4(kb,infw_g(1),itemp_g(1),iwl)
+               f_b0(kb) = fbf4(kb,infw_g(1),itemp_g(1),iwl)
+           else
+
+	   			density_average=(1.0d0-fvw)*den_grau0+fvw*den_water
+! JCS - DC_wet will be between the DC of a dry graupel particle (with density of
+! den_grau0) and the DC of a water drop).
+           		call calc_dc_wet_snow &
+									(den_grau0,fract_mass_water, &
+									dc_water,dc_ice,dc_wet)
+
+           		if(fract_mass_water.lt.fract_water_crit) then
+! JCS - Model graupel as spongy and use the dc_wet obtained above
+             		call calc_scattering_grau1 &
+            								(wavelength,grau_mass,density_average, &
+             								fract_mass_water,dc_wet,fa,fb,fa0,fb0)
+           		else
+! JCS - fract_water_scaled is the fractional water in the soaked ice core. The
+! rest of the water is going to coat the particle. We need to find the DC of the
+! soaked inner core, which means we'll need the fvw of only the core (ignore the
+! excess water that'll coat the particle).
+! Barry/Kobby Correction  FRACT_CRIT_WATER
+             		fract_water_scaled = fract_water_crit/(1-fract_mass_water+fract_water_crit)
+             		fvw_core = den_grau0*fract_water_scaled/((1-fract_water_scaled)*den_water+ &
+                               fract_water_scaled*den_grau0)
+! JCS - density_core is the density of the interior of the soaked particle.
+! We'll use fvw_core to find what's essentially the critical density
+             		density_core=(1.d0-fvw_core)*den_grau0+fvw_core*den_water
+! JCS - calculate dc_wet_inner as the dielectric constant of the soaked inner
+! spongy core. This will only be used for two-layer calculations. The
+! dc_wet, which is for the entire particle, is used for T-matrix calculations
+! since the T-matrix code assumes a homogeneous mixture at this time.
+             		call calc_dc_wet_snow &
+                  						(den_grau0,fract_water_scaled, &
+                  						dc_water,dc_ice,dc_wet_core)
+! Model using two-layer if the particle is Rayleigh-sized; if it's larger, then
+! it'll be modeled as a homogeneous mixture using the t_matrix.F90 subroutine.
+				 	call calc_scattering_grau2 &
+										(wavelength,grau_mass, &
+										density_core,fract_mass_water,fract_water_crit,dc_water,dc_ice,dc_wet_core, &
+										dc_wet,fa,fb,fa0,fb0)
+           		endif
+		   		! in case fract_mass_water.lt.fract_water_crit
+
+           f_a(kb)  = fa
+           f_b(kb)  = fb
+           f_a0(kb) = fa0
+           f_b0(kb) = fb0
+
+		endif
+
+
+	 else
+	! in case b_mass.le.1.d-8
+
+	   	f_a(kb)  = (0.d0,0.d0)
+	   	f_b(kb)  = (0.d0,0.d0)
+	   	f_a0(kb) = (0.d0,0.d0)
+	   	f_b0(kb) = (0.d0,0.d0)
+
+	 endif
+  enddo
+! cycle by kb
+
+      call integr &
+      			(a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk,kx,kz,4,number_bin)
+
+      coef1 = 4.0d4*(wavelength/pi)**4/ &
+              abs((dc_water-1.0d0)/(dc_water+2.0d0))**2
+
+      coef2 = 0.18d1*wavelength/pi
+
+      ssum_zh  = coef1*zh
+      ssum_zv  = coef1*zv
+      ssum_ldr = coef1*ldr
+      ssum_kdp = coef2*kdp
+      ssum_rhv = coef1*rhv
+      ssum_cdr = cdr
+      ssum_ah = coef3*ah
+      ssum_adp = coef3*adp
+
+      sum_zh  = sum_zh +ssum_zh
+      sum_zv  = sum_zv +ssum_zv
+      sum_ldr = sum_ldr+ssum_ldr
+      sum_kdp = sum_kdp+ssum_kdp
+      sum_rhv = sum_rhv+ssum_rhv
+      sum_cdr = sum_cdr+ssum_cdr
+      sum_ah = sum_ah+ssum_ah
+      sum_adp = sum_adp+ssum_adp
+
+      call output(ssum_zh,ssum_zv,ssum_ldr,ssum_kdp,ssum_rhv,ssum_cdr,&
+           		 	ssum_ah,ssum_adp,out4)
+
+!**** ********************************************************
+! Plate  amplitude   * &
+!**** ******************
+
+      do kb=1,number_bin
+
+         bin_conc(kb)=0.23105d6*FF2(kb,2)*RORD/bin_mass(kb)
+
+         b_mass=bin_conc(kb)*bin_mass(kb)
+
+         if(b_mass.gt.1.d-8) then
+
+           plate_mass= bin_mass(kb)
+           fract_mass_water=0.0d0
+
+		   ! new change 4.08.11                                         (start)
+           call calc_orient(fract_mass_water,a,kb,number_bin) ! ### (KS)
+			! new change 4.08.11                                           (end)
+
+           call calc_rayleigh_plate &
+          						(wavelength,plate_mass, &
+           						den_ice,fract_mass_water,dc_water,dc_ice, &
+           						fa,fb,fa0,fb0)
+
+           f_a(kb)  = fa
+           f_b(kb)  = fb
+           f_a0(kb) = fa0
+           f_b0(kb) = fb0
+
+         else
+
+           f_a(kb)  = (0.d0,0.d0)
+           f_b(kb)  = (0.d0,0.d0)
+           f_a0(kb) = (0.d0,0.d0)
+           f_b0(kb) = (0.d0,0.d0)
+
+         endif
+
+      enddo
+
+      call integr &
+				(a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk,kx,kz,5,number_bin)
+
+      coef1 = 4.0d4*(wavelength/pi)**4/ &
+              abs((dc_water-1.0d0)/(dc_water+2.0d0))**2
+
+      coef2 = 0.18d1*wavelength/pi
+
+      ssum_zh  = coef1*zh
+      ssum_zv  = coef1*zv
+      ssum_ldr = coef1*ldr
+      ssum_kdp = coef2*kdp
+      ssum_rhv = coef1*rhv
+      ssum_cdr = cdr
+      ssum_ah = coef3*ah
+      ssum_adp = coef3*adp
+
+      sum_zh  = sum_zh +ssum_zh
+      sum_zv  = sum_zv +ssum_zv
+      sum_ldr = sum_ldr+ssum_ldr
+      sum_kdp = sum_kdp+ssum_kdp
+      sum_rhv = sum_rhv+ssum_rhv
+      sum_cdr = sum_cdr+ssum_cdr
+      sum_ah = sum_ah+ssum_ah
+      sum_adp = sum_adp+ssum_adp
+
+      call output(ssum_zh,ssum_zv,ssum_ldr,ssum_kdp,ssum_rhv,ssum_cdr,&
+           			ssum_ah,ssum_adp,out5)
+
+!**** ********************************************************
+! Dendrit amplitude   * &
+!**** ********************
+
+      do kb=1,number_bin
+
+         bin_conc(kb)=0.23105d6*FF2(kb,3)*RORD/bin_mass(kb)
+
+         b_mass=bin_conc(kb)*bin_mass(kb)
+
+         if(b_mass.gt.1.d-8) then
+
+           dendr_mass= bin_mass(kb)
+           fract_mass_water=0.0d0
+
+! new change 4.08.11                                         (start)
+           call calc_orient(fract_mass_water,a,kb,number_bin) ! ### (KS)
+! new change 4.08.11                                           (end)
+
+           bulk_mass = (1.0d0-fract_mass_water)*dendr_mass
+           dendr_log =  log10(bulk_mass)
+
+           call INTERPOL &
+          			(number_bin,bin_log,tab_dendr,dendr_log,density_bulk)
+
+           dendr_log  = log10(dendr_mass)
+
+           call INTERPOL &
+          			(number_bin,bin_log,tab_dendr,dendr_log,density_dry)
+
+           dd_dry = 1.d1*(dendr_mass/density_dry)**degree
+
+           call calc_dc_wet_snow &
+          			(density_bulk,fract_mass_water,dc_water,dc_ice,dc_wet)
+
+           call calc_rayleigh_dendr &
+          			(wavelength,dendr_mass, &
+           			density_bulk,fract_mass_water,dd_dry,dc_wet, &
+           			fa,fb,fa0,fb0,ijk,kx,kz,kb)
+
+           f_a(kb)  = fa
+           f_b(kb)  = fb
+           f_a0(kb) = fa0
+           f_b0(kb) = fb0
+
+! in case b_mass.gt.1.d-8
+
+         else
+
+! in case b_mass.le.1.d-8
+
+           f_a(kb)  = (0.d0,0.d0)
+           f_b(kb)  = (0.d0,0.d0)
+           f_a0(kb) = (0.d0,0.d0)
+           f_b0(kb) = (0.d0,0.d0)
+
+         endif
+
+      enddo
+
+      call integr &
+      			(a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk,kx,kz,6,number_bin)
+
+      coef1 = 4.0d4*(wavelength/pi)**4/ &
+              abs((dc_water-1.0d0)/(dc_water+2.0d0))**2
+
+      coef2 = 0.18d1*wavelength/pi
+
+      ssum_zh  = coef1*zh
+      ssum_zv  = coef1*zv
+      ssum_ldr = coef1*ldr
+      ssum_kdp = coef2*kdp
+      ssum_rhv = coef1*rhv
+      ssum_cdr = cdr
+      ssum_ah = coef3*ah
+      ssum_adp = coef3*adp
+
+      sum_zh  = sum_zh +ssum_zh
+      sum_zv  = sum_zv +ssum_zv
+      sum_ldr = sum_ldr+ssum_ldr
+      sum_kdp = sum_kdp+ssum_kdp
+      sum_rhv = sum_rhv+ssum_rhv
+      sum_cdr = sum_cdr+ssum_cdr
+      sum_ah = sum_ah+ssum_ah
+      sum_adp = sum_adp+ssum_adp
+
+      call output(ssum_zh,ssum_zv,ssum_ldr,ssum_kdp,ssum_rhv,ssum_cdr,&
+				  ssum_ah,ssum_adp,out6)
+
+
+!**** ********************************************************
+! Snow flakes  amplitude   * &
+!**** ***********************
+
+      do kb=1,number_bin
+
+         bin_conc(kb)=0.23105d6*FF3(kb)*RORD/bin_mass(kb)
+
+         b_mass=bin_conc(kb)*bin_mass(kb)
+
+         if(b_mass.gt.1.d-8) then
+
+           snow_mass        = bin_mass(kb)
+           fract_mass_water = FL3(kb)
+
+! new change 4.08.11                                         (start)
+           call calc_orient(fract_mass_water,a,kb,number_bin) ! ### (KS)
+! new change 4.08.11                                           (end)
+
+           density_bulk = bulk(kb)
+
+           snow_log  = log10(snow_mass)
+
+           call INTERPOL &
+          			(number_bin,bin_log,tab_snow,snow_log,density_dry)
+
+		   fvw=density_dry*fract_mass_water/((1-fract_mass_water)*den_water+fract_mass_water*density_dry)
+
+           if(usetables(4) == 1) then
+               itemp_s = minloc(abs(temps_snow-temperature))
+               infw_s = minloc(abs(fws_snow-fvw))
+               f_a(kb)  = fab3(kb,infw_s(1),itemp_s(1),iwl)
+               f_b(kb)  = fbb3(kb,infw_s(1),itemp_s(1),iwl)
+               f_a0(kb) = faf3(kb,infw_s(1),itemp_s(1),iwl)
+               f_b0(kb) = fbf3(kb,infw_s(1),itemp_s(1),iwl)
+               !if (f_a(kb)*f_b(kb)*f_a0(kb)*f_b0(kb) == 0.0d0) then
+               !  print *,'One of the scattering amplitudes (SNOW) for kb=',kb,' is 0. FIX THIS!'
+               !endif
+           else
+
+				density_average=(1.0d0-fvw)*density_dry+fvw*den_water
+! JCS - Although calc_dc_wet_snow uses fvw, it's calculated in the subroutine
+! using den_ice, density of water, and fract_mass_water
+		   		call calc_dc_dry_snow(density_dry,dc_ice,dc_snow)
+		   		call calc_dc_wet_snow(density_average,fract_mass_water,dc_water,dc_ice,dc_wet)
+		   		call calc_scattering_snow(wavelength,snow_mass,density_dry,density_average, &
+                                     	  fract_mass_water,dc_water,dc_snow,dc_wet,fa,fb,fa0,fb0)
+		   		f_a(kb)  = fa
+		   		f_b(kb)  = fb
+				f_a0(kb) = fa0
+		   		f_b0(kb) = fb0
+           endif
+! new change 4.08.11                                         (start)
+           call calc_orient(fract_mass_water,a,kb,number_bin)  ! ### [KS]
+! new change 4.08.11                                           (end)
+         else
+
+           f_a(kb)  = (0.d0,0.d0)
+           f_b(kb)  = (0.d0,0.d0)
+           f_a0(kb) = (0.d0,0.d0)
+           f_b0(kb) = (0.d0,0.d0)
+
+         endif
+      enddo
+! cycle by kb
+
+      call integr &
+      			(a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk,kx,kz,7,number_bin)
+
+      coef1 = 4.0d4*(wavelength/pi)**4/ &
+              abs((dc_water-1.0d0)/(dc_water+2.0d0))**2
+
+      coef2 = 0.18d1*wavelength/pi
+
+      ssum_zh  = coef1*zh
+      ssum_zv  = coef1*zv
+      ssum_ldr = coef1*ldr
+      ssum_kdp = coef2*kdp
+      ssum_rhv = coef1*rhv
+      ssum_cdr = cdr
+      ssum_ah = coef3*ah
+      ssum_adp = coef3*adp
+
+      sum_zh  = sum_zh +ssum_zh
+      sum_zv  = sum_zv +ssum_zv
+      sum_ldr = sum_ldr+ssum_ldr
+      sum_kdp = sum_kdp+ssum_kdp
+      sum_rhv = sum_rhv+ssum_rhv
+      sum_cdr = sum_cdr+ssum_cdr
+      sum_ah = sum_ah+ssum_ah
+      sum_adp = sum_adp+ssum_adp
+
+      call output(ssum_zh,ssum_zv,ssum_ldr,ssum_kdp,ssum_rhv,ssum_cdr,&
+           		  ssum_ah,ssum_adp,out7)
+
+!**** ********************************************************
+! Column  amplitude   * &
+!**** *******************
+! Andrei's new change of 4.08.11                             (start)
+
+      fract_mass_water = 0.0d0
+
+      beta = elev
+
+      call calc_orient_colum(beta,a_column)
+
+! Andrei's new change of 4.08.11                                (end)
+
+      do kb=1,number_bin
+
+         bin_conc(kb)=0.23105d6*FF2(kb,1)*RORD/bin_mass(kb)
+
+         b_mass=bin_conc(kb)*bin_mass(kb)
+
+         if(b_mass.gt.1.d-8) then
+
+           colum_mass= bin_mass(kb)
+           bulk_mass = (1.0d0-fract_mass_water)*colum_mass
+           colum_log = log10(bulk_mass)
+
+           call INTERPOL &
+          			(number_bin,bin_log,tab_colum,colum_log,density_bulk)
+
+           colum_log = log10(colum_mass)
+
+           call INTERPOL &
+          			(number_bin,bin_log,tab_colum,colum_log,density_dry)
+
+           dd_dry = 1.d1*(colum_mass/density_dry)**degree
+
+           call calc_dc_wet_snow &
+          			(density_bulk,fract_mass_water,dc_water,dc_ice,dc_wet)
+
+           call calc_rayleigh_colum &
+          			(wavelength,colum_mass,density_bulk,fract_mass_water, &
+           			dd_dry,dc_water,dc_wet,fa,fb,fa0,fb0)
+
+           f_a(kb)  = fa
+           f_b(kb)  = fb
+           f_a0(kb) = fa0
+           f_b0(kb) = fb0
+
+         else
+
+           f_a(kb)  = (0.d0,0.d0)
+           f_b(kb)  = (0.d0,0.d0)
+           f_a0(kb) = (0.d0,0.d0)
+           f_b0(kb) = (0.d0,0.d0)
+
+         endif
+      enddo
+! cycle by kb
+
+! Andrei's new change of 4.08.11                              (start)
+
+      do kb=1,number_bin ! ### (KS)
+         do i=1,7
+	    a(i,kb)=a_column(i)
+	 enddo
+      enddo
+
+! Andrei's new change of 4.08.11                                (end)
+
+      call integr &
+     	 	(a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk,kx,kz,8,number_bin)
+
+      coef1 = 4.0d4*(wavelength/pi)**4/ &
+               abs((dc_water-1.0d0)/(dc_water+2.0d0))**2
+
+      coef2 = 0.18d1*wavelength/pi
+
+      ssum_zh  = coef1*zh
+      ssum_zv  = coef1*zv
+      ssum_ldr = coef1*ldr
+      ssum_kdp = coef2*kdp
+      ssum_rhv = coef1*rhv
+      ssum_cdr = cdr
+      ssum_ah = coef3*ah
+      ssum_adp = coef3*adp
+
+      sum_zh  = sum_zh +ssum_zh
+      sum_zv  = sum_zv +ssum_zv
+      sum_ldr = sum_ldr+ssum_ldr
+      sum_kdp = sum_kdp+ssum_kdp
+      sum_rhv = sum_rhv+ssum_rhv
+      sum_cdr = sum_cdr+ssum_cdr
+      sum_ah = sum_ah+ssum_ah
+      sum_adp = sum_adp+ssum_adp
+
+      call output(ssum_zh,ssum_zv,ssum_ldr,ssum_kdp,ssum_rhv,ssum_cdr,&
+                  ssum_ah,ssum_adp,out8)
+
+      call output(sum_zh,sum_zv,sum_ldr,sum_kdp,sum_rhv,sum_cdr,sum_ah,&
+                  sum_adp,out9)
+
+      return
+      end subroutine polar_hucm
+
+! subroutine polar_hucm &
+
+!**** ************************************************************** &
+!**** **************************************************************
+
+      SUBROUTINE INTERPOL(NH, H_TAB, X_TAB, H, X)
+
+      !IMPLICIT DOUBLE PRECISION (A-H,O-Z)
+	   implicit none
+! ### Interface
+	  integer :: NH
+      double precision :: H_TAB(NH), X_TAB(NH)
+	  double precision :: H, X
+! ### Interface
+	  integer :: I, J
+
+      IF(H.LT.H_TAB(1)) THEN
+
+         X=X_TAB(1)
+
+         RETURN
+
+      ENDIF
+
+      IF(H.GT.H_TAB(NH)) THEN
+
+         X=X_TAB(NH)
+
+         RETURN
+
+      ENDIF
+
+      DO I=2,NH
+
+         IF(H.LT.H_TAB(I)) THEN
+
+            J=I-1
+            X=X_TAB(J)+(X_TAB(I)-X_TAB(J))/ &
+           (H_TAB(I)-H_TAB(J))*(H-H_TAB(J))
+
+            RETURN
+
+         ENDIF
+
+      ENDDO
+
+      RETURN
+      END SUBROUTINE INTERPOL
+
+! SUBROUTINE INTERPOL &
+
+!**** ******************************************************************** &
+!**** ********************************************************************
+
+      subroutine calc_dc_water(temp,wl,dc_water)
+
+      !implicit double precision (a-h,o-z)
+      implicit none
+! ### Interface
+	  complex(8) :: dc_water
+	  double precision :: temp,wl
+! ### Interface
+	  double precision :: tt_rad, eps0, epsinf, alfa, wl0, rat, si, co, dc_re, dc_im
+      double precision, parameter :: pi = 3.14159265D0, sig = 12.5664d8
+
+      tt_rad     = temp-25.0d0
+      eps0   = 78.54d0*(1.d0-4.579d-3*tt_rad+1.19d-5*tt_rad**2-2.8d-8*tt_rad**3)
+      epsinf = 5.27137d0+0.021647*temp-0.00131198*temp**2
+      tt_rad     = temp+273.0d0
+      alfa   = -16.8129d0/tt_rad+0.0609265d0
+      wl0    = 0.00033836d0*exp(2513.98d0/tt_rad)
+      rat    = (wl0/wl)**(1.0d0-alfa)
+      si     = sin(0.5d0*alfa*pi)
+      co     = cos(0.5d0*alfa*pi)
+
+      dc_re  = epsinf+(eps0-epsinf)*(1.0d0+rat*si)/ &
+                      (1.0d0+2.0d0*rat*si+rat**2)
+      dc_im  = (eps0-epsinf)*rat*co/(1.0d0+2.0d0*rat*si+rat**2)+ &
+               sig*wl/18.8496d10
+
+      dc_water = cmplx(dc_re,dc_im)
+
+      return
+      end subroutine calc_dc_water
+
+! subroutine calc_dc_water &
+
+!**** ****************************************************************** &
+!**** ******************************************************************
+
+      subroutine calc_dc_ice(temp, wl, dc_ice)
+
+      !implicit double precision (a-h,o-z)
+      implicit none
+! ### Interface
+	  complex(8) :: dc_ice
+	  double precision :: temp, wl
+! ### Interface
+	  double precision :: eps0, alfa, tt_rad, wl0, sig, rat, si, co, dc_re, dc_im
+      double precision,parameter :: pi = 3.14159265D0, epsinf = 3.168d0
+
+      eps0   = 203.168d0+2.5d0*temp+0.15d0*temp**2
+      alfa   = 0.288d0+0.0052d0*temp+0.00023d0*temp**2
+      tt_rad     = temp+273.0d0
+      wl0    = 0.0009990288d0*exp(6.6435d3/tt_rad)
+      sig    = 1.26d0*exp(-6.2912d3/tt_rad)
+      rat    = (wl0/wl)**(1.0d0-alfa)
+      si     = sin(0.5d0*alfa*pi)
+      co     = cos(0.5d0*alfa*pi)
+
+      dc_re  = epsinf+(eps0-epsinf)*(1.0d0+rat*si)/ &
+                      (1.0d0+2.0d0*rat*si+rat**2)
+      dc_im  = (eps0-epsinf)*rat*co/(1.0d0+2.0d0*rat*si+rat**2)+ &
+               sig*wl/18.8496d10
+
+      dc_ice = cmplx(dc_re,dc_im)
+
+      return
+      end  subroutine calc_dc_ice
+
+! subroutine calc_dc_ice &
+
+!**** ****************************************************************** &
+!**** ******************************************************************
+
+      subroutine calc_dc_dry_snow(den_bulk,dc_ice,dc_snow)
+
+      !implicit double precision (a-h,o-z)
+       implicit none
+! ### INterface
+	  double precision :: den_bulk
+      complex(8) :: dc_ice, dc_snow, ratc ! ### [KS] : complex(8)
+! ### Interface
+
+      double precision,parameter :: den_ice = 0.91d0
+	  double precision :: rat
+
+      rat     =  den_bulk/den_ice
+      ratc    = (dc_ice-1.0d0)/(dc_ice+2.0d0)
+
+      dc_snow =  1.0d0+3.0d0*rat*ratc/(1.0d0-rat*ratc)
+
+      return
+      end subroutine calc_dc_dry_snow
+
+! subroutine calc_dc_dry_snow &
+
+!**** ****************************************************************** &
+!**** ******************************************************************
+
+      subroutine calc_dc_wet_snow &
+      					(den_bulk,fract_mass_water,dc_water,dc_ice,dc_wet_snow)
+
+      !implicit double precision (a-h,o-z)
+	  implicit none
+! ### Interface
+      complex(8) :: dc_water,dc_ice,dc_dry_snow,dc_wet_snow1, &  ! ### [KS] : complex(8)
+                     dc_wet_snow2,ratc,dc_wet_snow
+	  double precision :: den_bulk, fract_mass_water
+! ### Interface
+
+      double precision,parameter :: den_water = 1.0d0, den_ice = 0.91d0
+	  double precision :: rat, fract_volume_water, t
+
+
+      rat         =  den_bulk/den_ice
+      ratc        = (dc_ice-1.0d0)/(dc_ice+2.0d0)
+      dc_dry_snow =  1.0d0+3.0d0*rat*ratc/(1.0d0-rat*ratc)
+! den_bulk should be the density of DRY snow, graupel, hail, etc.!
+      rat                = den_bulk/den_water
+      fract_volume_water = 1.0d0-(1.0d0-fract_mass_water)/ &
+                          (1.0d0+fract_mass_water*(rat-1.0d0))
+
+      ratc = (dc_water-dc_dry_snow)/(dc_water+2.0d0*dc_dry_snow)
+
+      dc_wet_snow1 = dc_dry_snow* &
+                    (1.0d0+3.0d0*fract_volume_water*ratc/ &
+                    (1.0d0-fract_volume_water*ratc))
+
+      ratc = (dc_dry_snow-dc_water)/(dc_dry_snow+2.0d0*dc_water)
+
+      dc_wet_snow2 = dc_water* &
+                    (1.0d0+3.0d0*(1.0d0-fract_volume_water)*ratc/ &
+                    (1.0d0-(1.0d0-fract_volume_water)*ratc))
+! new change 18.01.09                                         (start)
+      if(fract_volume_water.gt.1.0d-10) then
+         t=derf((1.0d0-fract_volume_water)/fract_volume_water-0.2d0)
+      else
+         t=1.0d0
+      endif
+! new change 18.01.09                                           (end)
+
+      dc_wet_snow = 0.5d0*((1.0d0+t)*dc_wet_snow1+ &
+                           (1.0d0-t)*dc_wet_snow2)
+
+      return
+      end subroutine calc_dc_wet_snow
+
+! subroutine calc_dc_wet_snow &
+
+!**** *************************************************************** &
+!**** ***************************************************************
+
+      subroutine calc_scattering_water(wl,water_mass,dc,f_a,f_b,f_a0,f_b0)
+
+      !implicit double precision (a-h,o-z)
+	   implicit none
+
+	   intrinsic DCONJG
+! ### Interface
+	   double precision :: wl, water_mass
+	   complex(8) :: dc, f_a, f_b, f_a0, f_b0
+! ### Interface
+
+      double precision,parameter :: pi = 3.14159265D0, den_water = 1.0d0
+	  double precision :: degree, dd, aspect, rp, angle, ff, ff2, shape_a, shape_b, tmp
+
+      degree=1.0d0/3.0d0
+
+      dd  = 1.d1*((6.0D0/pi)*water_mass/den_water)**degree
+
+      if(dd.lt.1.0d1) then
+        aspect = 0.9951d0+0.0251d0*dd-0.03644*dd**2+ &
+                 0.005303*dd**3-0.0002492*dd**4
+      else
+        aspect = 0.4131d0
+      endif
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      rp = dd*abs(sqrt(dc))/(1.d1*wl)
+
+      if(rp.gt.0.1d0) then
+
+         angle = 1.8d2
+
+!         call t_matrix(dd,wl,dc,aspect,angle,f_a,f_b,6,'water') ! [KS] >> This is not linked as we use lookup tables
+
+         angle = 0.0d0
+
+!        call t_matrix(dd,wl,dc,aspect,angle,f_a0,f_b0,6,'water') ! [KS] >> This is not linked as we use lookup tables
+         f_b0 = -DCONJG(f_b0)
+         f_a0 = DCONJG(f_a0)
+
+      else
+
+         ff      = sqrt((1.0d0/aspect)**2-1.0d0)
+         ff2     = ff**2
+         shape_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+         shape_b = 0.5d0*(1.0d0-shape_a)
+         tmp     = pi**2*dd**3/(6.0d2*wl**2)
+         f_a0     = tmp/(shape_a+1.0d0/(dc-1.0d0))
+         f_b0     = tmp/(shape_b+1.0d0/(dc-1.0d0))
+         f_a    = dconjg(f_a0)
+         f_b    = dconjg(f_b0)
+
+      endif
+
+      return
+      end subroutine calc_scattering_water
+
+! subroutine calc_scattering_water &
+
+!**** ******************************************************************** &
+!**** ********************************************************************
+
+      subroutine calc_scattering_hail &
+      			(wl, hail_mass, den_bulk,fract_mass_water,dc_water,dc_hail,dc_wet, &
+       			 f_a,f_b,f_a0,f_b0)
+
+	  USE scatt_tables,ONLY:twolayer_hail,rpquada,usequad
+      !USE t_matrix2_quad_mod             ! ### [KS] : this is not linked since we use look-up-tables
+      !USE t_matrix2_double_mod           ! ### [KS] : this is not linked since we use look-up-tables
+
+	  implicit none
+
+	  intrinsic DCONJG
+     ! implicit double precision (a-h,o-z)
+      double precision :: degree, factor, hail_mass, fvw, rpquad
+      double precision :: wl, den_bulk, fract_mass_water, aspect_melt, aspect_dry, aspect, aspect2
+      double precision :: dd, dd_dmelt, dd_dry, dd2,dd1, dd_melt, dcore, rp, angle
+      double precision :: ff, ff2, shape2_a, shape2_b, shape1_a, shape1_b, psi, tmp
+
+      complex(8) :: dc_water,dc_hail,dc_wet,num,denum,f_a,f_b,f_a0,f_b0
+
+      double precision, parameter :: pi = 3.14159265D0, den_water = 1.0d0, den0 = 0.91d0
+
+      degree=1.0d0/3.0d0
+
+      dd_dry = 1.d1*((6.0D0/pi)*hail_mass/den0)**degree
+
+      if(dd_dry.lt.1.0d1) then
+         aspect_dry = 1.0d0-2.0d-2*dd_dry
+      else
+         aspect_dry = 0.8d0
+         aspect     = aspect_dry
+         go to 1
+      end if
+
+      if(fract_mass_water.lt.0.2d0) then
+         aspect=aspect_dry-5.0d0*(aspect_dry-0.8d0)*fract_mass_water
+         go to 1
+      end if
+
+      if(fract_mass_water.ge.0.2d0.and.fract_mass_water.lt.0.8d0) &
+      then
+         aspect = 0.88d0-0.4d0*fract_mass_water
+         goto 1
+      end if
+
+      dd_melt = 1.d1*((6.0D0/pi)*hail_mass/den_water)**degree
+
+      aspect_melt = 0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                    0.005303*dd_melt**3-0.0002492*dd_melt**4
+
+      aspect      = 2.8d0-4.0d0*aspect_melt+5.0d0* &
+                    (aspect_melt-0.56d0)*fract_mass_water
+   1  continue
+!      dd=1.d1*(hail_mass*(1.0d0-fract_mass_water)/den0)**degree*factor
+      fvw=den0*fract_mass_water/((1-fract_mass_water)*den_water+fract_mass_water*den0)
+      dd=1.d1*((6.0D0/pi)*hail_mass/(fvw*den_water+(1.0d0-fvw)*den0))**degree
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      rp = dd*abs(sqrt(dc_wet))/(1.d1*wl)
+
+      if(rp.gt.0.1d0) then
+         if(twolayer_hail == 1) then
+             aspect2 = aspect
+             dcore = (1.d0-fvw)**(1.d0/3.d0)*dd
+             rpquad = rpquada(5)
+             if ((rp.lt.rpquad) .OR. (usequad .EQV. .FALSE.)) then
+            !call t_matrix2_dp(wl,dd,dcore,aspect,aspect2,dc_water,dc_hail,f_a,f_b,f_a0,f_b0)
+				    ! [KS] >> This code is not linked
+             else
+            !call t_matrix2_qp(wl,dd,dcore,aspect,aspect2,dc_water,dc_hail,f_a,f_b,f_a0,f_b0)
+				    ! [KS] >> This code is not linked
+             endif
+         else
+             angle = 1.8d2
+            ! call t_matrix(dd,wl,dc_wet,aspect,angle,f_a,f_b,6,'Hail')
+             angle = 0.0d0
+            ! call t_matrix(dd,wl,dc_wet,aspect,angle,f_a0,f_b0,6,'Hail')
+             f_b0 = -DCONJG(f_b0)
+             f_a0 = DCONJG(f_a0)
+         endif
+      else
+!     **************   external spheroid    ***************
+
+          dd2=1.d1*((6.0D0/pi)*hail_mass*(fract_mass_water/den_water+(1-fract_mass_water)/den0))**degree
+
+
+          ff       = sqrt((1.0d0/aspect)**2-1.0d0)
+          ff2      = ff**2
+
+          shape2_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+          shape2_b = 0.5d0*(1.0d0-shape2_a)
+
+!     ************   inner spheroid   ********************
+
+          dd1=1.d1*((6.0D0/pi)*hail_mass*(1.0d0-fract_mass_water)/den0)**degree
+
+          shape1_a = shape2_a
+          shape1_b = shape2_b
+          psi      = (dd1/dd2)**3
+
+!     ******   Scattering amplitudes    *********
+
+          tmp   =  pi**2*dd2**3/(6.0d2*wl**2)
+
+          num   = (dc_water-1.0d0)*(dc_water+(dc_hail-dc_water)* &
+                  (shape1_a-psi*shape2_a))+ &
+                  psi*dc_water*(dc_hail-dc_water)
+
+          denum = (dc_water+(dc_hail-dc_water)*(shape1_a-psi*shape2_a))* &
+                  (1.0d0+(dc_water-1.0d0)*shape2_a)+ &
+                  psi*shape2_a*dc_water*(dc_hail-dc_water)
+
+          f_a0   = tmp*num/denum
+          f_a  = DCONJG(f_a0)
+
+          num   = (dc_water-1.0d0)*(dc_water+(dc_hail-dc_water)* &
+                  (shape1_b-psi*shape2_b))+ &
+                   psi*dc_water*(dc_hail-dc_water)
+
+          denum=(dc_water+(dc_hail-dc_water)*(shape1_b-psi*shape2_b))* &
+                (1.0d0+(dc_water-1.0d0)*shape2_b)+ &
+                 psi*shape2_b*dc_water*(dc_hail-dc_water)
+
+          f_b0  = tmp*num/denum
+          f_b = DCONJG(f_b0)
+      end if
+
+      return
+      end subroutine calc_scattering_hail
+
+! subroutine calc_scattering_hail
+!**** ********************************************************************
+
+      subroutine calc_scattering_fd &
+      			(wl, fd_mass, den_bulk,fract_mass_water,dc_water,dc_ice,dc_wet, &
+       			 f_a,f_b,f_a0,f_b0)
+
+	  USE scatt_tables,ONLY:twolayer_fd,rpquada,usequad
+      !USE t_matrix2_quad_mod              ! ### [KS] : this is not linked since we use look-up-tables
+      !USE t_matrix2_double_mod 	       ! ### [KS] : this is not linked since we use look-up-tables
+
+      !implicit double precision (a-h,o-z)
+	  implicit none
+
+	  intrinsic DCONJG
+
+! ### Interface
+ 	  double precision :: wl, fd_mass, den_bulk, fract_mass_water
+      complex(8) :: dc_water,dc_ice,dc_wet,num,denum,f_a,f_b,f_a0,f_b0
+! ### INterfcae
+
+      double precision, parameter :: pi = 3.14159265D0, den_water = 1.0d0, den_ice = 0.91d0
+	  double precision :: degree, dd_dry, aspect_dry, aspect, aspect2, dd_melt, fvw, aspect_melt, dd, rp, &
+	  					  angle, dd2, asp_w, asp_i, ff, ff2, shape2_a, shape2_b, dd1, shape1_a, shape1_b, &
+						  psi, tmp, dcore, rpquad
+
+
+      degree=1.0d0/3.0d0
+
+      dd_dry = 1.d1*((6.0D0/pi)*fd_mass/den_ice)**degree
+
+      if(dd_dry.lt.1.0d1) then
+         aspect_dry = 1.0d0-2.0d-2*dd_dry
+      else
+         aspect_dry = 0.8d0
+         aspect     = aspect_dry
+         go to 1
+      end if
+
+      if(fract_mass_water.lt.0.2d0) then
+         aspect=aspect_dry-5.0d0*(aspect_dry-0.8d0)*fract_mass_water
+         go to 1
+      end if
+
+      if(fract_mass_water.ge.0.2d0.and.fract_mass_water.lt.0.8d0) &
+      then
+         aspect = 0.88d0-0.4d0*fract_mass_water
+         goto 1
+      end if
+
+      dd_melt = 1.d1*((6.0D0/pi)*fd_mass/den_water)**degree
+
+      aspect_melt = 0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                    0.005303*dd_melt**3-0.0002492*dd_melt**4
+
+      aspect      = 2.8d0-4.0d0*aspect_melt+5.0d0* &
+                    (aspect_melt-0.56d0)*fract_mass_water
+   1  continue
+      fvw=den_ice*fract_mass_water/((1-fract_mass_water)*den_water+fract_mass_water*den_ice)
+      dd=1.d1*((6.0D0/pi)*fd_mass/(fvw*den_water+(1.0d0-fvw)*den_ice))**degree
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      rp = dd*abs(sqrt(dc_wet))/(1.d1*wl)
+
+      if(rp.gt.0.1d0) then
+         if(twolayer_fd == 1 ) then
+             aspect2 = aspect
+             dcore = fvw**(1.d0/3.d0)*dd
+             rpquad = rpquada(2)
+             if ((rp.lt.rpquad) .OR. (usequad .EQV. .FALSE.)) then
+             !call t_matrix2_dp(wl,dd,dcore,aspect,aspect2,dc_ice,dc_water,f_a,f_b,f_a0,f_b0)
+             ! [KS] >> This part is not reached
+			 else
+            !call t_matrix2_qp(wl,dd,dcore,aspect,aspect2,dc_ice,dc_water,f_a,f_b,f_a0,f_b0)
+            ! >>[KS] : This part is not reached
+			 endif
+         else
+             angle = 1.8d2
+          !   call t_matrix(dd,wl,dc_wet,aspect,angle,f_a,f_b,4,'FD')
+             angle = 0.0d0
+          !   call t_matrix(dd,wl,dc_wet,aspect,angle,f_a0,f_b0,4,'FD')
+             f_b0 = -DCONJG(f_b0)
+             f_a0 = DCONJG(f_a0)
+         endif
+      else
+
+!     **************   external spheroid    ***************
+          dd2=1.d1*((6.0D0/pi)*fd_mass*(fract_mass_water/den_water+ &
+             (1.0d0-fract_mass_water)/den_ice))**degree
+
+          if(dd2.lt.1.0d1) then
+            asp_w = 0.9951d0+0.0251d0*dd2-0.03644*dd2**2+ &
+                    0.005303*dd2**3-0.0002492*dd2**4
+            asp_i = 1.0d0-0.02d0*dd2
+          else
+            asp_w = 0.4131d0
+            asp_i = 0.8d0
+          endif
+
+          aspect = fract_mass_water*asp_w+ &
+                   (1.d0-fract_mass_water)*asp_i
+
+          if(aspect.eq.1.0d0) aspect=0.9999d0
+
+
+          ff       = sqrt((1.0d0/aspect)**2-1.0d0)
+          ff2      = ff**2
+
+          shape2_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+          shape2_b = 0.5d0*(1.0d0-shape2_a)
+
+
+    !     ************   inner spheroid   ********************
+
+
+          dd1=1.d1*((6.0D0/pi)*fd_mass*fract_mass_water/den_water)**degree
+
+          shape1_a = shape2_a
+          shape1_b = shape2_b
+          psi      = (dd1/dd2)**3
+
+
+    !     ******   Scattering amplitudes    *********
+
+          tmp   =  pi**2*dd2**3/(6.0d2*wl**2)
+
+
+          num   = (dc_ice-1.0d0)*(dc_ice+(dc_water-dc_ice)* &
+                  (shape1_a-psi*shape2_a))+ &
+                   psi*dc_ice*(dc_water-dc_ice)
+
+          denum = (dc_ice+(dc_water-dc_ice)*(shape1_a-psi*shape2_a))* &
+                  (1.0d0+(dc_ice-1.0d0)*shape2_a)+ &
+                   psi*shape2_a*dc_ice*(dc_water-dc_ice)
+
+
+
+          f_a0   = tmp*num/denum
+          f_a  = DCONJG(f_a0)
+
+
+          num   = (dc_ice-1.0d0)*(dc_ice+(dc_water-dc_ice)* &
+                  (shape1_b-psi*shape2_b))+ &
+                   psi*dc_ice*(dc_water-dc_ice)
+
+          denum=(dc_ice+(dc_water-dc_ice)*(shape1_b-psi*shape2_b))* &
+                (1.0d0+(dc_ice-1.0d0)*shape2_b)+ &
+                 psi*shape2_b*dc_ice*(dc_water-dc_ice)
+
+          f_b0  = tmp*num/denum
+          f_b = DCONJG(f_b0)
+      endif
+
+      return
+      end  subroutine calc_scattering_fd
+!**************************************************************************
+      subroutine calc_scattering_grau1 &
+                 (wl,grau_mass,den_bulk,fract_mass_water,dc,f_a,f_b,f_a0,f_b0)
+
+      !implicit double precision (a-h,o-z)
+ 	   implicit none
+
+	   intrinsic DCONJG
+! ### Interface
+      double precision :: wl, grau_mass,den_bulk, fract_mass_water
+	  complex(8) :: dc, f_a, f_b, f_a0, f_b0
+! ### Interface
+
+      double precision, parameter :: pi = 3.14159265D0, den0 = 0.4d0
+      double precision,parameter :: den_water = 1.0d0
+	  double precision :: degree, dd, dd_dry, aspect_dry, aspect_melt, rp, angle, ff, ff2, shape_a, &
+	  					  shape_b, tmp, aspect, dd_melt
+
+      degree=1.0d0/3.0d0
+
+     !dd=1.d1*(grau_mass*(1.0d0-fract_mass_water)/den0)**degree*factor
+      dd=1.d1*((6.0D0/pi)*grau_mass*((1.0d0-fract_mass_water)/den0+fract_mass_water/den_water))**degree
+
+      dd_dry = 1.d1*((6.0D0/pi)*grau_mass/den0)**degree
+
+      if(dd_dry.lt.1.0d1) then
+         aspect_dry = 1.0d0-2.0d-2*dd_dry
+      else
+         aspect_dry = 0.8d0
+      endif
+
+      if(fract_mass_water.lt.0.2d0) then
+         aspect=aspect_dry-5.0d0*(aspect_dry-0.8d0)*fract_mass_water
+         goto 1
+      endif
+
+      if(fract_mass_water.ge.0.2d0.and.fract_mass_water.lt.0.8d0) &
+      then
+         aspect = 0.88d0-0.4d0*fract_mass_water
+         goto 1
+      endif
+
+      dd_melt     = 1.d1*((6.0D0/pi)*grau_mass/den_water)**degree
+
+      if(dd_melt.lt.1.0d1) then
+
+         aspect_melt=0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                     0.005303*dd_melt**3-0.0002492*dd_melt**4
+      else
+         aspect_melt  = 0.4131d0
+      endif
+
+      aspect = 2.8d0-4.0d0*aspect_melt+5.0d0* &
+              (aspect_melt-0.56d0)*fract_mass_water
+   1  continue
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      rp = dd*abs(sqrt(dc))/(1.d1*wl)
+
+      if(rp.gt.0.1d0) then
+
+         angle = 1.8d2
+
+        ! call t_matrix(dd,wl,dc,aspect,angle,f_a,f_b,7,'grau1') ! [KS] >> This is not linked as we use lookup tables
+
+         angle = 0.0d0
+
+         ! call t_matrix(dd,wl,dc,aspect,angle,f_a0,f_b0,7,'grau1') ! [KS] >> This is not linked as we use lookup tables
+         f_b0 = -DCONJG(f_b0)
+         f_a0 = DCONJG(f_a0)
+
+      else
+
+         ff      = sqrt((1.0d0/aspect)**2-1.0d0)
+         ff2     = ff**2
+         shape_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+         shape_b = 0.5d0*(1.0d0-shape_a)
+         tmp     = pi**2*dd**3/(6.0d2*wl**2)
+         f_a0    = tmp/(shape_a+1.0d0/(dc-1.0d0))
+         f_b0    = tmp/(shape_b+1.0d0/(dc-1.0d0))
+         f_a     = DCONJG(f_a0)
+         f_b     = DCONJG(f_b0)
+
+      end if
+
+      return
+      end subroutine calc_scattering_grau1
+
+! subroutine calc_scattering_grau1
+!**** ********************************************************************
+! JCS -- Modified list of arguments and equation for dd.  Now, dc_wet_inner
+! represents the dc of the inner spongy 'layer', whereas dc_wet represents the
+! dc for the entire particle. We need both because the t_matrix scattering
+! subroutine still assume a homogeneous mixture; in contast, the two-layer
+! Rayleigh calculations work on the spongy inner layer, for which dc_wet_inner
+! is used.
+      subroutine calc_scattering_grau2 &
+      				(wl,grau_mass,den_inner, &
+					     fract_mass_water,fract_mass_crit,dc_water,dc_ice,dc_wet_inner,dc_wet, &
+       				 f_a,f_b,f_a0,f_b0)
+
+      USE scatt_tables,ONLY:twolayer_graupel,rpquada,usequad
+      !USE t_matrix2_quad_mod                ! ### [KS] : this is not linked since we use look-up-tables
+      !USE t_matrix2_double_mod              ! ### [KS] : this is not linked since we use look-up-tables
+
+	  !implicit double precision (a-h,o-z)
+	  implicit none
+
+	  intrinsic DCONJG
+! ### INterface
+	  double precision :: wl,grau_mass,den_inner, fract_mass_water,fract_mass_crit
+      complex(8) :: dc_water,dc_ice,dc_wet_inner,dc_wet,num,denum,f_a,f_b,f_a0,f_b0
+! ### Interface
+      double precision,parameter :: pi = 3.14159265D0, den_water = 1.0d0, den0 = 0.4d0
+	  double precision :: degree, dd, dd_dry, aspect_dry, aspect, aspect2, dd_melt, rp, angle, &
+	  				     fract_mass_excess, shape2_a, shape2_b, dd1, psi, tmp, aspect_melt, &
+						 dd2, ff, ff2, shape1_a, shape1_b, rpquad, fvw
+
+      degree=1.0d0/3.0d0
+
+!      dd=1.d1*(grau_mass*(1.0d0-fract_mass_water)/den0)**degree*factor
+      dd=1.d1*((6.0D0/pi)*grau_mass*((1.0d0-fract_mass_water)/den0+fract_mass_water/den_water))**degree
+
+      dd_dry = 1.d1*((6.0D0/pi)*grau_mass/den0)**degree
+
+      if(dd_dry.lt.1.0d1) then
+         aspect_dry = 1.0d0-2.0d-2*dd_dry
+      else
+         aspect_dry = 0.8d0
+      endif
+
+      if(fract_mass_water.lt.0.2d0) then
+         aspect=aspect_dry-5.0d0*(aspect_dry-0.8d0)*fract_mass_water
+         goto 1
+      endif
+
+      if(fract_mass_water.ge.0.2d0.and.fract_mass_water.lt.0.8d0) &
+      then
+         aspect = 0.88d0-0.4d0*fract_mass_water
+         goto 1
+      endif
+
+      dd_melt     = 1.d1*((6.0D0/pi)*grau_mass/den_water)**degree
+
+      if(dd_melt.lt.1.0d1) then
+
+         aspect_melt=0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                     0.005303*dd_melt**3-0.0002492*dd_melt**4
+      else
+         aspect_melt  = 0.4131d0
+      endif
+
+      aspect = 2.8d0-4.0d0*aspect_melt+5.0d0* &
+              (aspect_melt-0.56d0)*fract_mass_water
+   1  continue
+! JCS - fract_mass_excess is the excess water that will be kept entirely water.
+! The rest of the water was used to soak the interior of the particle.
+      fract_mass_excess=fract_mass_water-fract_mass_crit
+! dd2 is outer diameter
+      dd2=1.d1*((6.0D0/pi)*grau_mass*(fract_mass_excess/den_water+ &
+         (1.0d0-fract_mass_excess)/den_inner))**degree
+! dd1 is core or inner diameter
+      dd1=1.d1*((6.0D0/pi)*grau_mass*(1.0d0-fract_mass_excess)/den_inner)**degree
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      rp = dd*abs(sqrt(dc_wet))/(1.d1*wl)
+
+      if(rp.gt.0.1d0) then
+         if(twolayer_graupel == 1) then
+             aspect2 = aspect
+             fvw = den_inner*fract_mass_excess/((1.d0-fract_mass_excess)*den_water+fract_mass_excess*den_inner)
+             rpquad = rpquada(4)
+             if ((rp.lt.rpquad) .OR. (usequad .EQV. .FALSE.)) then
+                 !call t_matrix2_dp(wl,dd2,dd1,aspect,aspect2,dc_water,dc_wet_inner,f_a,f_b,f_a0,f_b0)
+             	   ! [KS] >> This part is not reached
+			 else
+                 !call t_matrix2_qp(wl,dd2,dd1,aspect,aspect2,dc_water,dc_wet_inner,f_a,f_b,f_a0,f_b0)
+             	  ! [KS] >> This part is not reached
+			 endif
+         else
+             angle = 1.8d2
+            ! call t_matrix(dd,wl,dc_wet,aspect,angle,f_a,f_b,7,'grau2') ! [KS] >> This is not linked as we use lookup tables
+             angle = 0.0d0
+            ! call t_matrix(dd,wl,dc_wet,aspect,angle,f_a0,f_b0,7,'grau2') ! [KS] >> This is not linked as we use lookup tables
+             f_b0 = -DCONJG(f_b0)
+             f_a0 = DCONJG(f_a0)
+         endif
+      else
+
+	!    **************   external spheroid    ***************
+
+          ff  = sqrt((1.0d0/aspect)**2-1.0d0)
+          ff2 = ff**2
+
+          shape2_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+
+          shape2_b = 0.5d0*(1.0d0-shape2_a)
+
+    !     ************   Inner spheroid    ***************
+
+          shape1_a =  shape2_a
+          shape1_b =  shape2_b
+
+          psi      = (dd1/dd2)**3
+
+    !      ********  Scettering amplitudes    ****
+
+          tmp   = pi**2*dd2**3/(6.0d2*wl**2)
+
+          num   = (dc_water-1.0d0)*(dc_water+(dc_wet_inner-dc_water)* &
+                  (shape1_a-psi*shape2_a))+ &
+                   psi*dc_water*(dc_wet_inner-dc_water)
+
+          denum = (dc_water+(dc_wet_inner-dc_water)* &
+                  (shape1_a-psi*shape2_a))* &
+                  (1.0d0+(dc_water-1.0d0)*shape2_a)+ &
+                   psi*shape2_a*dc_water*(dc_wet_inner-dc_water)
+
+          f_a0   = tmp*num/denum
+          f_a  = DCONJG(f_a0)
+
+          num   = (dc_water-1.0d0)*(dc_water+(dc_wet_inner-dc_water)* &
+                  (shape1_b-psi*shape2_b))+ &
+                   psi*dc_water*(dc_wet_inner-dc_water)
+
+          denum = (dc_water+(dc_wet_inner-dc_water)* &
+                  (shape1_b-psi*shape2_b))* &
+                  (1.0d0+(dc_water-1.0d0)*shape2_b)+ &
+                   psi*shape2_b*dc_water*(dc_wet_inner-dc_water)
+
+          f_b0   = tmp*num/denum
+          f_b  = DCONJG(f_b0)
+      endif
+      return
+      end subroutine calc_scattering_grau2
+
+! subroutine calc_scattering_grau2
+!**** ********************************************************************
+      subroutine calc_rayleigh_plate &
+      						(wl,plate_mass,den_bulk, &
+       					     fract_mass_water,dc_water,dc_plate,f_a,f_b,f_a0,f_b0)
+
+      ! implicit double precision (a-h,o-z)
+		implicit none
+
+		intrinsic DCONJG
+! ### Interface
+      double precision :: wl,plate_mass,den_bulk, fract_mass_water
+	  complex(8) :: dc_water,dc_plate,num,denum,f_a,f_b,f_a0,f_b0
+! ### INterface
+
+      double precision, parameter :: pi = 3.14159265D0, den_water = 1.0d0
+      double precision, parameter :: alfa  = 0.047d0, beta = 0.474d0
+	  double precision :: degree, dd2, dd_dry, tmp, aa, bb, aspect_dry, dd_melt, aspect, aspect_melt, &
+	  					  ff, ff2, shape2_a, shape2_b, psi, dd1, shape1_a, shape1_b
+
+      degree=1.0d0/3.0d0
+
+!     **************   external spheroid    ***************
+
+      dd2=1.d1*((6.0D0/pi)*plate_mass*(fract_mass_water/den_water+ &
+         (1.0d0-fract_mass_water)/den_bulk))**degree
+
+      dd_dry     = 1.d1*((6.0D0/pi)*plate_mass/den_bulk)**degree
+      tmp        = dd_dry**3/alfa
+      aa         = alfa*tmp**(beta/(2.0d0+beta))
+      bb         = tmp**(1.0d0/(2.0d0+beta))
+      aspect_dry = aa/bb
+
+      if(aspect_dry.gt.1.0d0) aspect_dry = 1.0d0
+
+      dd_melt = 1.d1*((6.0D0/pi)*plate_mass/den_water)**degree
+
+      if(dd_melt.lt.1.0d1) then
+         aspect_melt=0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                     0.005303*dd_melt**3-0.0002492*dd_melt**4
+      else
+         aspect_melt  = 0.4131d0
+      endif
+
+      aspect=aspect_dry+fract_mass_water*(aspect_melt-aspect_dry)
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      ff  = sqrt((1.0d0/aspect)**2-1.0d0)
+      ff2 = ff**2
+
+      shape2_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+
+      shape2_b = 0.5d0*(1.0d0-shape2_a)
+
+!     ************   inner spheroid   ********************
+
+      dd1= &
+      1.d1*((6.0D0/pi)*plate_mass*(1.0d0-fract_mass_water)/den_bulk)**degree
+
+      shape1_a =  shape2_a
+
+      shape1_b =  shape2_b
+
+      psi      = (dd1/dd2)**3
+
+!     ******   Scattering amplitudes    *********
+
+      tmp = pi**2*dd2**3/(6.0d2*wl**2)
+
+      num = (dc_water-1.0d0)*(dc_water+(dc_plate-dc_water)* &
+            (shape1_a-psi*shape2_a))+ &
+             psi*dc_water*(dc_plate-dc_water)
+
+      denum=(dc_water+(dc_plate-dc_water)*(shape1_a-psi*shape2_a))* &
+            (1.0d0+(dc_water-1.0d0)*shape2_a)+ &
+             psi*shape2_a*dc_water*(dc_plate-dc_water)
+
+      f_a0   = tmp*num/denum
+      f_a  = DCONJG(f_a0)
+
+      num = (dc_water-1.0d0)*(dc_water+(dc_plate-dc_water)* &
+            (shape1_b-psi*shape2_b))+ &
+             psi*dc_water*(dc_plate-dc_water)
+
+      denum=(dc_water+(dc_plate-dc_water)*(shape1_b-psi*shape2_b))* &
+            (1.0d0+(dc_water-1.0d0)*shape2_b)+ &
+             psi*shape2_b*dc_water*(dc_plate-dc_water)
+
+      f_b0   = tmp*num/denum
+      f_b  = DCONJG(f_b0)
+
+      return
+      end subroutine calc_rayleigh_plate
+
+! subroutine calc_rayleigh_plate &
+
+!**** *************************************************************** &
+!**** ***************************************************************
+
+      subroutine calc_rayleigh_dendr &
+      						(wl,dendr_mass,den_bulk, &
+       						 fract_mass_water,dd_dry,dc,f_a,f_b,f_a0,f_b0,ijk,kx,kz,kb)
+
+      !implicit double precision (a-h,o-z)
+	   implicit none
+
+	   intrinsic DCONJG
+! ### Interface
+	  integer :: ijk, kx, kz, kb
+	  double precision :: wl,dendr_mass,den_bulk, fract_mass_water,dd_dry
+      complex(8) :: dc, f_a, f_b, f_a0, f_b0
+! ### Interface
+      double precision,parameter :: pi = 3.14159265D0, den_water = 1.0d0
+      double precision,parameter :: alfa = 0.038d0, beta = 0.377d0
+	  double precision :: degree, dd, tmp, aa, bb, aspect_dry, dD_melt, aspect_melt, aspect, &
+	  					  rp, angle, ff, ff2, shpae_a, shape_b, c, shape_a
+
+      degree=1.0d0/3.0d0
+
+      dd = 1.d1*((6.0D0/pi)*dendr_mass*(fract_mass_water/den_water+ &
+          (1.0d0-fract_mass_water)/den_bulk))**degree
+
+      tmp         = dd_dry**3/alfa
+      aa          = alfa*tmp**(beta/(2.0d0+beta))
+      bb          = tmp**(1.0d0/(2.0d0+beta))
+      aspect_dry  = aa/bb
+
+      if(aspect_dry.gt.1.0d0) aspect_dry = 1.0d0
+
+      dd_melt = 1.d1*((6.0D0/pi)*dendr_mass/den_water)**degree
+
+      if(dd_melt.lt.1.0d1) then
+         aspect_melt=0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                     0.005303*dd_melt**3-0.0002492*dd_melt**4
+      else
+         aspect_melt  = 0.4131d0
+      end if
+
+      aspect  = aspect_dry+fract_mass_water*(aspect_melt-aspect_dry)
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      rp = dd*abs(sqrt(dc))/(1.d1*wl)
+
+      if(rp.gt.0.4d0) then
+
+         angle = 1.8d2
+
+        ! call t_matrix(dd, wl,dc,aspect,angle,f_a,f_b,7,'dendr') ! [KS] >> This is not linked as we use lookup tables
+
+         angle = 0.0d0
+
+         ! call t_matrix(dd,wl,dc,aspect,angle,f_a0,f_b0,7,'dendr') ! [KS] >> This is not linked as we use lookup tables
+         f_b0 = -DCONJG(f_b0)
+         f_a0 = DCONJG(f_a0)
+
+! in case rp.gt.0.4d0
+
+      else
+
+! in case rp.le.0.4d0
+
+         ff      = sqrt((1.0d0/aspect)**2-1.0d0)
+         ff2     = ff**2
+
+! new change 11.07.08                                         (start)
+	     c=atan(ff)/ff
+! new change 11.07.08                                           (end)
+
+         shape_a = ((1.0d0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+
+         shape_b = 0.5d0*(1.0d0-shape_a)
+
+         tmp     = pi**2*dd**3/(6.0d2*wl**2)
+
+         f_a0     = tmp/(shape_a+1.0d0/(dc-1.0d0))
+         f_a    = DCONJG(f_a0)
+         f_b0     = tmp/(shape_b+1.0d0/(dc-1.0d0))
+         f_b    = DCONJG(f_b0)
+
+      endif
+
+      return
+      end subroutine calc_rayleigh_dendr
+
+! subroutine calc_rayleigh_dendr &
+
+!**** ******************************************************************** &
+!**** ********************************************************************
+
+      subroutine calc_rayleigh_snow &
+      			(wl,snow_mass,den_bulk, &
+       			 fract_mass_water,dd_dry,dc,f_a,f_b,f_a0,f_b0)
+
+      !implicit double precision (a-h,o-z)
+	  implicit none
+
+	  intrinsic DCONJG
+! ### INterface
+      double precision :: wl,snow_mass,den_bulk, fract_mass_water,dd_dry
+      complex(8) :: 	  dc, f_a, f_b, f_a0, f_b0
+! ### INterface
+      double precision, parameter :: pi = 3.14159265D0, den_water = 1.0d0
+	  double precision :: degree, dd, aspect_dry, dD_melt, aspect_melt, aspect, rp, angle, ff, ff2, &
+	  					  shape_a, shape_b, tmp
+
+      degree=1.0d0/3.0d0
+
+      dd=1.d1*((6.0D0/pi)*snow_mass*(fract_mass_water/den_water+ &
+        (1.0d0-fract_mass_water)/den_bulk))**degree
+
+      if(dd_dry.lt.1.0d1) then
+         aspect_dry = 1.0d0-2.0d-2*dd_dry
+      else
+         aspect_dry = 0.8d0
+      end if
+
+      dd_melt = 1.d1*((6.0D0/pi)*snow_mass/den_water)**degree
+
+      if(dd_melt.lt.1.0d1) then
+         aspect_melt=0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                     0.005303*dd_melt**3-0.0002492*dd_melt**4
+      else
+         aspect_melt  = 0.4131d0
+      end if
+
+      aspect = aspect_dry+fract_mass_water*(aspect_melt-aspect_dry)
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      rp = dd*abs(sqrt(dc))/(1.d1*wl)
+
+      if(rp.gt.0.1d0) then
+
+         angle = 1.8d2
+
+        ! call t_matrix(dd,wl,dc,aspect,angle,f_a,f_b,6,'snow') ! [KS] >> This is not linked as we use lookup tables
+
+         angle = 0.0d0
+
+         ! call t_matrix(dd,wl,dc,aspect,angle,f_a0,f_b0,6,'snow') ! [KS] >> This is not linked as we use lookup tables
+         f_b0 = -DCONJG(f_b0)
+         f_a0 = DCONJG(f_a0)
+      else
+
+         ff      = sqrt((1.0d0/aspect)**2-1.0d0)
+         ff2     = ff**2
+
+         shape_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+
+         shape_b = 0.5d0*(1.0d0-shape_a)
+
+         tmp     = pi**2*dd**3/(6.0d2*wl**2)
+
+         f_a0     = tmp/(shape_a+1.0d0/(dc-1.0d0))
+         f_b0     = tmp/(shape_b+1.0d0/(dc-1.0d0))
+         f_a    = DCONJG(f_a0)
+         f_b    = DCONJG(f_b0)
+
+      endif
+
+      return
+      end subroutine calc_rayleigh_snow
+
+! subroutine calc_rayleigh_snow &
+
+!**** ******************************************************************** &
+!**** ********************************************************************
+
+      subroutine calc_rayleigh_colum &
+      			(wl,colum_mass,den_bulk, &
+       			fract_mass_water,dd_dry,dc_water,dc_colum, &
+       			f_a,f_b,f_a0,f_b0)
+
+      !implicit double precision (a-h,o-z)
+	   implicit none
+
+	   intrinsic DCONJG
+! ### Interface
+	  double precision :: wl,colum_mass,den_bulk, fract_mass_water,dd_dry
+      complex(8) :: dc_water, dc_colum, num, denum, f_a, f_b, f_a0, f_b0
+! ### Interface
+      double precision,parameter :: pi  = 3.14159265D0, den_water = 1.0d0
+      double precision, parameter :: alfa = 0.308d0, beta = 0.927d0
+	  double precision :: degree, dd2, tmp, aa, bb, aspect_dry, dd_melt, aspect_melt, ff, ff2, &
+	  					  shape2_a, shape2_b, psi, aspect, dd1, shape1_a, shape1_b
+
+
+      degree=1.0d0/3.0d0
+!     **************   external spheroid    ***************
+
+      dd2 = 1.d1*((6.0D0/pi)*colum_mass*(fract_mass_water/den_water+ &
+           (1.0d0-fract_mass_water)/den_bulk))**degree
+
+      tmp        = dd_dry**3/alfa**2
+
+      aa         = tmp**(1.0d0/(2.0d0*beta+1.0d0))
+
+      bb         = alfa*tmp**(beta/(2.0d0*beta+1.0d0))
+
+      aspect_dry = aa/bb
+
+      dd_melt = 1.d1*((6.0D0/pi)*colum_mass/den_water)**degree
+
+      if(dd_melt.lt.1.0d1) then
+         aspect_melt=0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                     0.005303*dd_melt**3-0.0002492*dd_melt**4
+      else
+         aspect_melt  = 0.4131d0
+      endif
+
+      aspect = aspect_dry+fract_mass_water*(aspect_melt-aspect_dry)
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      if(aspect.lt.1.0d0) then
+
+         ff       = sqrt((1.0d0/aspect)**2-1.0d0)
+         ff2      = ff**2
+         shape2_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+         shape2_b = 0.5d0*(1.0d0-shape2_a)
+
+      else
+
+         ff       = sqrt(1.0d0-(1.0d0/aspect)**2)
+         ff2      = ff**2
+         shape2_a = ((1.0-ff2)/ff2)*(0.5d0* &
+                    dlog((1.0d0+ff)/(1.0d0-ff))/ff-1.0d0)
+         shape2_b = 0.5d0*(1.0d0-shape2_a)
+
+      endif
+
+!     ************   inner spheroid   ********************
+
+      dd1=1.d1* &
+      ((6.0D0/pi)*colum_mass*(1.0d0-fract_mass_water)/den_bulk)**degree
+
+      shape1_a = shape2_a
+      shape1_b = shape2_b
+      psi      = (dd1/dd2)**3
+
+!     ******   Scattering amplitudes    *********
+
+      tmp   = pi**2*dd2**3/(6.0d2*wl**2)
+
+      num   = (dc_water-1.0d0)*(dc_water+(dc_colum-dc_water)* &
+              (shape1_a-psi*shape2_a))+ &
+              psi*dc_water*(dc_colum-dc_water)
+
+      denum = (dc_water+(dc_colum-dc_water)* &
+              (shape1_a-psi*shape2_a))* &
+              (1.0d0+(dc_water-1.0d0)*shape2_a)+ &
+               psi*shape2_a*dc_water*(dc_colum-dc_water)
+
+      f_a0   = tmp*num/denum
+      f_a  = DCONJG(f_a0)
+
+      num   = (dc_water-1.0d0)*(dc_water+(dc_colum-dc_water)* &
+              (shape1_b-psi*shape2_b))+ &
+              psi*dc_water*(dc_colum-dc_water)
+
+      denum = (dc_water+(dc_colum-dc_water)* &
+              (shape1_b-psi*shape2_b))* &
+              (1.0d0+(dc_water-1.0d0)*shape2_b)+ &
+              psi*shape2_b*dc_water*(dc_colum-dc_water)
+
+      f_b0   = tmp*num/denum
+      f_b  = DCONJG(f_b0)
+
+      return
+      end subroutine calc_rayleigh_colum
+
+! subroutine calc_rayleigh_colum &
+
+!**** ******************************************************************** &
+!**** ********************************************************************
+
+      subroutine calc_orient_colum(beta,a)
+
+      !implicit double precision (a-h,o-z)
+	   implicit none
+
+        double precision :: a(7), beta
+
+      a(1)=  0.5d0*sin(beta)**2
+      a(2)=  0.5d0
+      a(3)=  0.375d0*sin(beta)**2
+      a(4)=  0.375d0
+      a(5)=  0.125d0*sin(beta)**2
+      a(6)=  0.0d0
+      a(7)= -0.5d0*cos(beta)**2
+
+      return
+      end subroutine calc_orient_colum
+
+! subroutine calc_orient_colum &
+
+!**** ******************************************************************** &
+!**** ********************************************************************
+! JCS - fixed a(2) consistent with Rhzykov et al. (2011)
+      subroutine calc_orient_water(a)
+
+      !implicit double precision (a-h,o-z)
+	 implicit none
+! ### Interface
+	 double precision :: a(7)
+! ### Interface
+
+      !dimension a(7)
+      double precision,parameter :: sigma_r = 0.17453292d0
+	  double precision :: sigma, r
+
+
+      sigma   = sigma_r
+      r       = dexp(-2.0d0*sigma**2)
+
+      a(1)= 0.25d0*(1.0+r)**2
+      a(2)= 0.25d0*(1.0-r**2)
+      a(3)= (0.375d0+0.5d0*r+0.125d0*r**4)**2
+      a(4)= (0.375d0-0.5d0*r+0.125d0*r**4)* &
+            (0.375d0+0.5d0*r+0.125d0*r**4)
+      a(5)= 0.125d0*(0.375d0+0.5d0*r+0.125d0*r**4)*(1.0d0-r**4)
+      a(6)= 0.0d0
+      a(7)= 0.5d0*r*(1.0d0+r)
+
+      return
+      end subroutine calc_orient_water
+
+! subroutine calc_orient_water &
+
+!**** *************************************************************** &
+!**** ***************************************************************
+! new change 4.08.11                                          (start)
+! JCS - fixed a(2,kb) consistent with Rhzykov et al. (2011)
+      subroutine calc_orient(fract_mass_water,a,kb,number_bin) ! ### (KS)
+
+!use microprm
+
+      !implicit double precision (a-h,o-z)
+	  implicit none
+! ### Interface
+	  integer :: number_bin, kb
+      double precision :: a(7,number_bin), fract_mass_water
+
+! ### Interface
+
+      double precision,parameter :: sigma_r = 0.17453292d0, sigma_s  = 0.69813176d0
+	  double precision :: sigma, r
+
+
+      sigma   = sigma_s+fract_mass_water*(sigma_r-sigma_s)
+      r       = dexp(-2.0d0*sigma**2)
+
+      a(1,kb)= 0.25d0*(1.0+r)**2
+      a(2,kb)= 0.25d0*(1.0-r**2)
+      a(3,kb)=(0.375d0+0.5d0*r+0.125d0*r**4)**2
+      a(4,kb)=(0.375d0-0.5d0*r+0.125d0*r**4)* &
+              (0.375d0+0.5d0*r+0.125d0*r**4)
+      a(5,kb)= 0.125d0*(0.375d0+0.5d0*r+0.125d0*r**4)*(1.0d0-r**4)
+      a(6,kb)= 0.0d0
+      a(7,kb)= 0.5d0*r*(1.0d0+r)
+
+      return
+      end subroutine calc_orient
+
+! subroutine calc_orient
+
+! new change 4.08.11                                            (end) &
+!**** *************************************************************** &
+!**** ***************************************************************
+! Andrei's new change of 4.08.11                              (start)
+
+      subroutine integr &
+      				(a,bin_conc,f_a,f_b,f_a0,f_b0,zh,zv,ldr,kdp,rhv,cdr,ah,adp,ijk, &
+       				 kx,kz,ihydromet,number_bin)
+
+!use microprm
+
+      !implicit double precision (a-h,o-z)
+	  implicit none
+
+	  intrinsic dimag, dconjg
+! ### Interface
+		! parameter(number_bin = NKR_43Bins)
+		integer :: number_bin, ijk, kx, kz, ihydromet, kb
+		double precision :: ldr, kdp
+		complex(8) :: rhv
+		complex(8) :: f_a(number_bin),  f_b(number_bin), &
+					   f_a0(number_bin), f_b0(number_bin)
+		double precision :: a(7,number_bin)
+		double precision :: bin_conc(number_bin), zh, zv, cdr, ah, adp
+! ### Interface
+
+		double precision :: cdrn, cdrd, b
+		double precision :: aj1n, aj1d, aj1, aj2n, aj2d, aj2
+
+	  zh  = 0.0d0
+	  zv  = 0.0d0
+	  ldr = 0.0d0
+	  kdp = 0.0d0
+	  rhv = (0.0d0,0.0d0)
+	  ah = 0.0d0
+	  adp = 0.0d0
+	  cdr = 0.0d0
+	  cdrn = 0.0d0
+	  cdrd = 0.0d0
+	  aj1n = 0.0d0
+	  aj1d = 0.0d0
+	  aj1 = 0.0d0
+	  aj2n = 0.d0
+	  aj2d = 0.d0
+	  aj2 = 0.d0
+
+	  do kb=1,number_bin
+
+	 		zh = zh + bin_conc(kb)*(abs(f_b(kb))**2- &
+         		2.0d0*a(2,kb)*dble(dconjg(f_b(kb))*(f_b(kb)-f_a(kb)))+ &
+         		a(4,kb)*abs(f_b(kb)-f_a(kb))**2)
+
+         	zv = zv + bin_conc(kb)*(abs(f_b(kb))**2- &
+              	2.0d0*a(1,kb)*dble(dconjg(f_b(kb))*(f_b(kb)-f_a(kb)))+ &
+              	a(3,kb)*abs(f_b(kb)-f_a(kb))**2)
+
+         	ldr = ldr + bin_conc(kb)*a(5,kb)*abs(f_b(kb)-f_a(kb))**2
+
+	 		b = dble(f_b0(kb)-f_a0(kb))
+
+         	kdp = kdp + bin_conc(kb)*a(7,kb)*b
+
+         	rhv = rhv + bin_conc(kb)*(abs(f_b(kb))**2+ &
+             		a(5,kb)*abs(f_b(kb)-f_a(kb))**2- &
+             		a(1,kb)*dconjg(f_b(kb))*(f_b(kb)-f_a(kb))- &
+             		a(2,kb)*f_b(kb)*dconjg(f_b(kb)-f_a(kb)))
+
+! JCS - CDR is from Eqn (17) in Ryzhkov (2001)
+! THIS DOES NOT ACCOUNT FOR CANTING ANGLE VARIABILITY (ASSUMES VERY SMALL
+! DISTRIBUTION OF CANTING ANGLES)
+         	cdrn = cdrn + bin_conc(kb)*(abs(f_b(kb)-f_a(kb)))**2
+         	cdrd = cdrd + bin_conc(kb)*(abs(f_b(kb)+f_a(kb)))**2
+! JCS - Test -- CDR from Eqn (11) and (16) in Ryzhkov (2001) to account for
+! canting angle variability
+			!aj1n = aj1n + bin_conc(kb)*sqrt(a(3,kb))*(abs(f_b(kb)-f_a(kb)))**2
+			!aj1d = aj1d + bin_conc(kb)*(abs(f_b(kb)))**2
+			!if (aj1d>0.d0) then
+			!    aj1=aj1+(aj1n/aj1d)
+			!endif
+			!aj2n = aj2n + bin_conc(kb)*(conjg(f_b(kb))*(f_b(kb)-f_a(kb)))
+			!aj2d = aj2d + bin_conc(kb)*(abs(f_a(kb)))**2
+			!if (aj2d>0.d0) then
+			!    aj2=aj2+(aj2n/aj2d)
+			!endif
+! JCS - Equations for ah and adp are from Eqn 6 in Ryzhkov et al. (2013a)
+         ah = ah + bin_conc(kb)*(dimag(f_b0(kb))-a(2,kb)*dimag(f_b0(kb)-f_a0(kb)))
+
+! JCS - Note that A5 in their paper is really a(7,kb) as defined in this program
+         adp = adp + bin_conc(kb)*dimag(f_b0(kb)-f_a0(kb))*a(7,kb)
+      enddo
+
+		! cdrn = (1.d0/4.d0)*aj1
+		! cdrd = 1-dble(aj2)+1.d0/4.d0*(aj1)
+      	if (abs(cdrd)>0.d0) cdr = cdrn/cdrd
+
+	  return
+      end subroutine integr
+
+! subroutine integr
+! Andrei's new change of 4.08.11                                (end)
+!**** ***************************************************************
+
+      subroutine output(sum_zh,sum_zv,sum_ldr,sum_kdp,sum_rhv,&
+           				sum_cdr,sum_ah,sum_adp,out)
+
+!use microprm
+
+      !implicit double precision (a-h,o-z)
+	  implicit none
+
+	  intrinsic dimag, datan2, dreal
+! ### Interface
+      double precision :: out(10), sum_zh, sum_zv, sum_ldr, sum_kdp, &
+	  					  sum_cdr, sum_ah, sum_adp
+      complex(8) :: sum_rhv
+      double precision,parameter :: pi = 3.14159265D0
+! ### Interface
+
+!**** ************
+! ZH output &
+!**** ************
+
+      if(sum_zh.gt.1.0d-2) then
+        out(1) = 1.0d1*dlog10(sum_zh)
+      else
+        out(1) = -35.0d0
+      endif
+
+!**** ************
+! ZV output &
+!**** ************
+
+      if(sum_zh.gt.1.0d-2) then
+        out(2) = 1.0d1*dlog10(sum_zv)
+      else
+        out(2) = -10.0d0
+      endif
+
+!**** ************
+! ZDR output &
+!**** ************
+
+      if(sum_zh.gt.1.0d-2) then
+        out(3) = 1.0d1*dlog10(sum_zh/sum_zv)
+      else
+! Andrei's new change of 27.07.11                             (start)
+        out(3) = -10.0d0
+!        out(3) = 0.0d0
+! Andrei's new change of 27.07.11                               (end)
+      endif
+
+!**** ************
+! LDR output &
+!**** ************
+
+      if(sum_zh.gt.1.0d-2) then
+        !test_sum_zh = abs(sum_zh)
+        if ( sum_zh.lt.(sum_ldr*10.0D10) ) then
+          out(4) = 1.0d1*dlog10(sum_ldr/sum_zh)
+        else
+          out(4) = -99.9d9
+        endif
+      else
+        out(4) = -100.0d0
+      endif
+
+!**** ************
+! KDP output &
+!**** ************
+
+      if(sum_zh.gt.1.0d-2) then
+!        out(5) = max(-100.0D0,min(100.0D0,sum_kdp))
+        out(5) = sum_kdp
+      else
+       out(5) = 0.0D0
+      endif
+
+
+!**** ************
+! RHV output &
+!**** ************
+
+      if(sum_zh.gt.1.0d-2) then
+        out(6) = abs(sum_rhv)/sqrt(sum_zh*sum_zv)
+      else
+        out(6) = 0.0d0
+      endif
+
+!**** ***********
+! DELTA output &
+!**** ***********
+
+      if(sum_zh.gt.1.0d-2) then
+          out(7) = datan2(dimag(sum_rhv),dreal(sum_rhv))*180.0d0/pi
+      else
+        out(7) = 0.0d0
+      endif
+
+!**** ***********
+! Simulated CDR output &
+!**** ***********
+
+      if(sum_cdr.gt.1.0d-8) then
+        out(8) = 1.0d1*dlog10(sum_cdr)
+      else
+        out(8) = 0.0d0
+      endif
+
+!**** ***********
+! AH output &
+!**** ***********
+
+      if(sum_zh.gt.1.0d-2) then
+        out(9) = sum_ah
+      else
+        out(9) = 0.0d0
+      endif
+
+
+!**** ***********
+! ADP output &
+!**** ***********
+
+      if(sum_zh.gt.1.0d-2) then
+        out(10) = sum_adp
+      else
+        out(10) = 0.0d0
+      endif
+
+
+      return
+      end subroutine output
+! subroutine output &
+! ********************************************************************
+	  subroutine calc_scattering_snow (wl,snow_mass,den_dry,den_wet, &
+        							   fract_mass_water,dc_water,dc_snow,dc_wet,f_a,f_b,f_a0,f_b0)
+
+      USE scatt_tables,ONLY:twolayer_snow,rpquada,usequad
+      !USE t_matrix2_quad_mod 			  ! ### [KS] : this is not linked since we use look-up-tables
+      !USE t_matrix2_double_mod 		  ! ### [KS] : this is not linked since we use look-up-tables
+
+      implicit none
+
+	  intrinsic DCONJG
+	  ! ### Interface
+	  double precision :: wl, snow_mass, den_dry, den_wet, fract_mass_water
+	  complex(8) :: dc_water,dc_snow,dc_wet,f_a, f_b, f_a0, f_b0
+	  ! ### Interface
+
+	  ! ### Local
+	  double precision :: pi, den_water
+      double precision :: degree, dd_dry, dd_melt, dd, fvw, aspect_dry, aspect_melt, aspect
+      double precision :: rp, rpquad, aspect2, dcore, angle, dd2, ff, ff2, shape2_a, shape2_b
+      double precision :: shape1_a, shape1_b, psi, dd1, tmp, shape_a, shape_b
+      complex(8) :: num, denum
+      integer, parameter :: twolayer_snow_rayleigh = 1  ! ### [KS] : Always equal to 1 ?
+	  ! ### Local
+
+      data pi, den_water /3.14159265D0, 1.0d0/
+
+      degree = 1.0d0/3.0d0
+
+      dd_dry = 1.d1*(snow_mass/den_dry)**degree
+
+      dd = 1.d1*((6.0D0/pi)*snow_mass*(fract_mass_water/den_water+ &
+           (1.0d0-fract_mass_water)/den_dry))**degree
+
+      fvw = den_dry*fract_mass_water/((1-fract_mass_water)*den_water+fract_mass_water*den_dry)
+
+      if(dd_dry.lt.1.0d1) then
+         aspect_dry = 1.0d0-2.0d-2*dd_dry
+      else
+         aspect_dry = 0.8d0
+      end if
+
+      dd_melt = 1.d1*((6.0D0/pi)*snow_mass/den_water)**degree
+
+      if(dd_melt.lt.1.0d1) then
+         aspect_melt=0.9951d0+0.0251d0*dd_melt-0.03644*dd_melt**2+ &
+                     0.005303*dd_melt**3-0.0002492*dd_melt**4
+      else
+         aspect_melt  = 0.4131d0
+      end if
+
+      aspect = aspect_dry+fract_mass_water*(aspect_melt-aspect_dry)
+
+      if(aspect.eq.1.0d0) aspect=0.9999d0
+
+      rp = dd*abs(sqrt(dc_wet))/(1.d1*wl)
+
+      if(rp.gt.0.1d0) then
+         if (twolayer_snow == 1) then
+             aspect2 = aspect
+             dcore=(1.d0-fvw)**(1.d0/3.d0)*dd
+             rpquad = rpquada(3)
+             if ((rp.lt.rpquad) .OR. (usequad .EQV. .FALSE.)) then
+                 !call t_matrix2_dp(wl,dd,dcore,aspect,aspect2,dc_water,dc_snow,f_a,f_b,f_a0,f_b0)
+				         ! [KS] >> look-up-tables, this part is not reached
+             else
+                 !call t_matrix2_qp(wl,dd,dcore,aspect,aspect2,dc_water,dc_snow,f_a,f_b,f_a0,f_b0)
+				         ! [KS] >> look-up-tables, this part is not reached
+             endif
+
+         else
+             angle = 1.8d2
+             ! call t_matrix(dd,wl,dc_wet,aspect,angle,f_a,f_b,6,'Snow') ! [KS] >> This is not linked as we use lookup tables
+             angle = 0.0d0
+             ! call t_matrix(dd,wl,dc_wet,aspect,angle,f_a0,f_b0,6,'Snow') ! [KS] >> This is not linked as we use lookup tables
+             f_b0 = -DCONJG(f_b0)
+             f_a0 = DCONJG(f_a0)
+         endif
+      else
+         if (twolayer_snow_rayleigh == 1) then
+!     **************   external spheroid    ***************
+
+            dd2=1.d1*((6.0D0/pi)*snow_mass*(fract_mass_water/den_water+(1-fract_mass_water)/den_dry))**degree
+            ff       = sqrt((1.0d0/aspect)**2-1.0d0)
+            ff2      = ff**2
+            shape2_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+            shape2_b = 0.5d0*(1.0d0-shape2_a)
+
+!     ************   inner spheroid   ********************
+            dd1=1.d1*((6.0D0/pi)*snow_mass*(1.0d0-fract_mass_water)/den_dry)**degree
+            shape1_a = shape2_a
+            shape1_b = shape2_b
+            psi      = (dd1/dd2)**3
+
+!     ******   Scattering amplitudes    *********
+            tmp   =  pi**2*dd2**3/(6.0d2*wl**2)
+            num   = (dc_water-1.0d0)*(dc_water+(dc_snow-dc_water)* &
+                    (shape1_a-psi*shape2_a))+ &
+                    psi*dc_water*(dc_snow-dc_water)
+
+            denum = (dc_water+(dc_snow-dc_water)*(shape1_a-psi*shape2_a))* &
+                    (1.0d0+(dc_water-1.0d0)*shape2_a)+ &
+                    psi*shape2_a*dc_water*(dc_snow-dc_water)
+
+            f_a0   = tmp*num/denum
+            f_a  = DCONJG(f_a0)
+
+            num   = (dc_water-1.0d0)*(dc_water+(dc_snow-dc_water)* &
+                    (shape1_b-psi*shape2_b))+ &
+                     psi*dc_water*(dc_snow-dc_water)
+
+            denum=(dc_water+(dc_snow-dc_water)*(shape1_b-psi*shape2_b))* &
+                  (1.0d0+(dc_water-1.0d0)*shape2_b)+ &
+                   psi*shape2_b*dc_water*(dc_snow-dc_water)
+            f_b0  = tmp*num/denum
+            f_b = DCONJG(f_b0)
+         else
+            ff      = sqrt((1.0d0/aspect)**2-1.0d0)
+            ff2     = ff**2
+
+            shape_a = ((1.0+ff2)/ff2)*(1.0d0-atan(ff)/ff)
+
+            shape_b = 0.5d0*(1.0d0-shape_a)
+
+            tmp     = pi**2*dd**3/(6.0d2*wl**2)
+
+            f_a0     = tmp/(shape_a+1.0d0/(dc_wet-1.0d0))
+            f_b0     = tmp/(shape_b+1.0d0/(dc_wet-1.0d0))
+            f_a    = dconjg(f_a0)
+            f_b    = dconjg(f_b0)
+         endif
+      endif
+
+      return
+      end subroutine calc_scattering_snow
+! subroutine calc_scattering_snow &
+! ****************************************
+
+END MODULE module_mp_SBM_polar_radar
+!**** **************************************************************** &
diff --git a/phys/module_mp_fast_sbm.F b/phys/module_mp_fast_sbm.F
index 264ca13b34..adca3dfd38 100644
--- a/phys/module_mp_fast_sbm.F
+++ b/phys/module_mp_fast_sbm.F
@@ -1,9014 +1,9093 @@
-!WRF:MODEL_MP:PHYSICS
-! The fast version calculates hydrometeor distributions for qc,qr,qs,qg, and their number concentrations
-! (including aerosol concentrations).
-! To use the FAST version of SBM, please do the following.
-! Set DX_BOUND to some value larger than the first inner nest, but smaller than the outer domain in meters
-! Set the aerosol concentration with the variables FCCNR_MAR, and FCCNR_CON, FCCNR_MIX.  
-! Each of the aerosol distributions are set with ACCN (concentration of ccn particles at 1% saturation), and
-! BCCN (the "k" coefficient; for example: FCCNR(KR)=1.5*ACCN*BCCN*S_KR**BCCN). 
-! Questions: contact barry.h.lynn@gmail.com (Barry Lynn)
-!
-MODULE module_mp_fast_sbm
-USE module_mp_radar
-!      USE module_state_description
-!
-!-----------------------------------------------------------------------
-! BARRY
-      INTEGER,PRIVATE,PARAMETER :: REMSAT = 0
-      INTEGER, PRIVATE,PARAMETER :: IBREAKUP=1
-      INTEGER, PRIVATE,PARAMETER :: p_ff1i01=2, p_ff1i33=34,p_ff5i01=35,p_ff5i33=67,p_ff6i01=68,&
-     & p_ff6i33=100,p_ff8i01=101,p_ff8i33=133
-
-      LOGICAL, PRIVATE,PARAMETER :: CONSERV=.TRUE.
-! SET ONE = TRUE
-!     LOGICAL, PRIVATE,PARAMETER :: ORIGINAL_MELT=.FALSE.
-!     LOGICAL, PRIVATE,PARAMETER :: JIWEN_FAN_MELT=.TRUE.
-      LOGICAL, PRIVATE,PARAMETER :: ORIGINAL_MELT=.TRUE.
-      LOGICAL, PRIVATE,PARAMETER :: JIWEN_FAN_MELT=.FALSE.
-      REAL, PRIVATE,PARAMETER :: PI_MORR = 3.1415926535897932384626434
-      REAL, PRIVATE,PARAMETER ::  R_MORR = 287.15
-
-
-
-      REAL,PRIVATE,PARAMETER :: DX_BOUND=7500.
-      REAL ACCN,BCCN
-      REAL,PRIVATE,PARAMETER :: ACCN_MAR=1.0000E02, BCCN_MAR=0.900E00,ROCCN0=0.1000E01
-      REAL,PRIVATE,PARAMETER :: ACCN_CON=4.00000E03, BCCN_CON=0.400E00,ROCCN03=0.1000E01
-      REAL,PRIVATE,PARAMETER :: I3POINT=1
-      INTEGER,PRIVATE,PARAMETER :: ICCN = 1
-       DOUBLE PRECISION, PRIVATE, PARAMETER ::  SCAL=1.d0
-       INTEGER, PRIVATE,PARAMETER :: ICEPROCS=1,BULKNUC=0 
-       INTEGER, PRIVATE,PARAMETER :: ICETURB=0,LIQTURB=0
-!      INTEGER, PRIVATE,PARAMETER :: RAIN_INIT=1,GRAUPEL_INIT=1
-!      INTEGER, PRIVATE,PARAMETER :: ICE_INIT=0,SNOW_INIT=1
-
-       INTEGER, PRIVATE,PARAMETER :: ICEMAX=3,NCD=33,NHYDR=5,NHYDRO=7  &
-     &        ,ifreez_down1=0,ifreez_down2=1,ifreez_top=1              &
-     &        ,K0_LL=8,KRMIN_LL=1,KRMAX_LL=19,L0_LL=6                  &
-     &        , IEPS_400=1,IEPS_800=0,IEPS_1600=0                      &
-     &        ,K0L_GL=16,K0G_GL=16                                     &
-     &        ,KRMINL_GL=1,KRMAXL_GL=24                                &
-     &        ,KRMING_GL=1,KRMAXG_GL=33                                &
-     &        ,KRDROP=18,KRBREAK=17,KRICE=18                           &
-     &        ,NKR=33,JMAX=33,NRG=2,JBREAK = 18 
-       REAL dt_coll
-       REAL, PRIVATE,PARAMETER ::C1_MEY=0.00033,C2_MEY=0.              &
-! New CONTINENTAL
-!      REAL, PRIVATE,PARAMETER ::C1_MEY=0.0033,C2_MEY=0.              &
-     &        ,an0_freez=10.,COL=0.23105                                
-       REAL, PRIVATE,PARAMETER :: p1=1000000.0,p2=750000.0,p3=500000.0                     
-!      INTEGER, PRIVATE,PARAMETER :: NCOND=3
-!      INTEGER, PRIVATE,PARAMETER :: NCOND=6
-       INTEGER, PRIVATE :: NCOND
-       INTEGER, PRIVATE,PARAMETER :: kr_icempl=9
-!      REAL, PRIVATE, PARAMETER :: ALCR = 1.0
-!      REAL, PRIVATE, PARAMETER :: ALCR = 2.0
-!      REAL, PRIVATE, PARAMETER :: ALCR = 1.5
-       REAL, PRIVATE, PARAMETER :: ALCR = 2.25
-!      REAL, PRIVATE, PARAMETER :: ALCR = 3.0
-       REAL, PRIVATE, PARAMETER :: ALCR_G = 3.0
-!      REAL, PRIVATE, PARAMETER :: ALCR_G = 1.0
-       INTEGER,PRIVATE,PARAMETER :: icempl=1
-       REAL, PRIVATE, PARAMETER :: COEFREFLL=1.E6*36.E6*COL/3.1453/3.1453 
-       REAL, PRIVATE, PARAMETER :: COEFREFLI=1.E9*36.E3*COL/3.1453/3.1453/5.
-       REAL, PRIVATE, PARAMETER :: COEFREF00=1.E9*36.E3*COL/3.1453/3.1453       
-       REAL, PRIVATE,DIMENSION(NKR) ::COLREFLL,COLREFLI,COLREFLS,COLREFLG,COLREFLH
-
-
-! YWLL_1000MB(nkr,nkr) - input array of kernels for pressure 1000mb
-! YWLL_750MB(nkr,nkr) - input array of kernels for pressure 750mb
-! YWLL_500MB(nkr,nkr) - input array of kernels for pressure 500mb
-       REAL, PRIVATE, SAVE :: &
-! CRYSTALS 
-     &YWLI(NKR,NKR,ICEMAX) &
-! MIXTURES
-     &,YWIL(NKR,NKR,ICEMAX),YWII(NKR,NKR,ICEMAX,ICEMAX) &
-     &,YWIS(NKR,NKR,ICEMAX),YWIG(NKR,NKR,ICEMAX) &
-     &,YWIH(NKR,NKR,ICEMAX),YWSI(NKR,NKR,ICEMAX) &
-     &,YWGI(NKR,NKR,ICEMAX),YWHI(NKR,NKR,ICEMAX)
+! +-----------------------------------------------------------------------------+
+! +-----------------------------------------------------------------------------+
+! This is the spectral-bin microphysics scheme based on the Hebrew University
+! Cloud Model (HUCM), originally formulated and coded by Alexander Khain
+! (email: Alexander.Khain@mail.huji.ac.il);
+! The WRF bin microphysics scheme (Fast SBM or FSBM) solves equations for four
+! size distribution functions: aerosols, drop (including rain drops), snow and
+! graupel/hail (from which mass mixing ratio qna, qc, qr, qs, qg/qh and
+! their number concentrations are calculated).
+
+! The scheme is generally written in CGS units. In the updated scheme (FSBM-2)
+! the users can choose either graupel or hail to describe dense particles
+! (see the 'hail_opt' switch). By default, the 'hail_opt = 1' is used.
+! Hail particles have larger terminal velocity than graupel per mass bin.
+! 'hail_opt' is recommended to be used in simulations of continental cloud
+! systems. The Graupel option may lead to better results in simulations of
+! maritime convection.
+
+! The aerosol spectrum in FSBM-2 is approximated by 3-lognormal size distribution
+! representing smallest aerosols (nucleation mode), intermediate-size
+! (accumulation mode) and largest aerosols (coarse mode). The BC/IC for aerosols
+! ,as well as aerosols vertical distribution profile -- are set from within the
+! FSBM scheme (see the 'DX_BOUND' parameter). The flag to enable the lognormal
+! aerosols is (ILogNormal_modes_Aerosol = 1, manadatory flag). The modes parameters
+! (concentration, mean radius and model width) are defined inside the routine
+! "LogNormal_modes_Aerosol".
+
+! The user can set the liquid water content threshold (LWC) in which rimed snow
+! is being transferred to hail/graupel (see 'ALCR' parameter).
+! The default value is ALCR = 0.5 [g/m3]. Increasing this value will result
+! in an increase of snow mass content, and a decrease in hail/graupel mass
+! contents.
+
+! We thank and acknowledge contribution from Jiwen Fan (PNNL), Alexander Rhyzkov
+! (CIMMS/NSSL), Jeffery Snyder (CIMMS/NSSL), Jimy Dudhia (NCAR) and Dave Gill
+! (NCAR).
+
+! The previous WRF FSBM version  (FSBM-1) was coded by Barry Lynn (email:
+! Barry.H.Lynn@gmail.com) ; This updated WRF SBM version (FSBM-2) was coded and
+! is maintained by Jacob Shpund (email: kobby.shpund@mail.huji.ac.il).
+
+
+! Usefull references:
+!     Khain, A. P., and I. Sednev, 1996: Simulation of precipitation formation in
+! the Eastern Mediterranean coastal zone using a spectral microphysics cloud
+! ensemble model. Atmospheric Research, 43: 77-110;
+!     Khain, A. P., A. Pokrovsky and M. Pinsky, A. Seifert, and V. Phillips, 2004:
+! Effects of atmospheric aerosols on deep convective clouds as seen from
+! simulations using a spectral microphysics mixed-phase cumulus cloud model
+! Part 1: Model description. J. Atmos. Sci 61, 2963-2982);
+!     Khain A. P. and M. Pinsky, 2018: Physical Processes in Clouds and Cloud
+! modeling. Cambridge University Press. 642 pp
+!    Shpund, J., A. Khain, and D. Rosenfeld, 2019: Effects of Sea Spray on the
+! Dynamics and Microphysics of an Idealized Tropical Cyclone. J. Atmos. Sci., 0,
+! https://doi.org/10.1175/JAS-D-18-0270.1 (A preliminary description of the
+! updated FSBM-2 scheme)
+! +---------------------------------------------------------------------------- +
+! +-----------------------------------------------------------------------------+
+module module_mp_SBM_BreakUp
+
+private
+public Spont_Rain_BreakUp,Spontanous_Init,BreakUp_Snow,KR_SNOW_MIN,KR_SNOW_MAX
+
+! Kind paramater
+INTEGER, PARAMETER, PRIVATE:: R8SIZE = 8
+INTEGER, PARAMETER, PRIVATE:: R4SIZE = 4
+
+! ... Spontanous Rain BreakUp
+INTEGER,PARAMETER :: 		JBreak_Spontanous = 28, &
+              					I_Break_Method = 1
+DOUBLE PRECISION,PARAMETER :: COL = 0.23105
+! ... Snow-BreakUp
+INTEGER,PARAMETER :: KR_SNOW_MAX = 33 !34 	!30
+INTEGER,PARAMETER :: KR_SNOW_MIN = 30 !31 	!27
+! ... Snow breakup probability
+DOUBLE PRECISION,PARAMETER :: BREAK_SNOW_KRMAX_0 = 0.32D0
+DOUBLE PRECISION,PARAMETER :: BREAK_SNOW_KRMAX_1 = 0.16D0
+DOUBLE PRECISION,PARAMETER :: BREAK_SNOW_KRMAX_2 = 0.08D0
+DOUBLE PRECISION,PARAMETER :: BREAK_SNOW_KRMAX_3 = 0.04D0
+
+contains
+	! +--------------------------------------------------------------------------+
+  subroutine Spontanous_Init(DTwrf, XL, DROPRADII, Prob, Gain_Var_New, NND, NKR, &
+                           ikr_spon_break)
+
+  implicit none
+
+  integer,intent(in):: NKR
+  real(kind=r4size),intent(in) :: 	DTwrf,XL(:),DROPRADII(:)
+  real(kind=r8size),intent(out) :: Prob(:), Gain_Var_New(:,:), NND(:,:)
+
+! ... Locals
+  real(kind=r8size) :: diameter(nkr), ratio_new, q_m, gain_var(nkr,nkr), dtime_spon_break, &
+                  		 DROPRADII_dp(nkr),XL_dp(nkr)
+  integer :: kr,i,j, ikr_spon_break
+  real(kind=r8size),parameter :: gamma = 0.453d0
+  character*256 :: wrf_err_message
+! ... Locals
+
+!dtime_spon_break = DTwrf
+DROPRADII_dp = DROPRADII
+XL_dp = XL
+! diameter in nm
+diameter(:) = DROPRADII_dp(:)*2.0d0*10.0d0
+
+DO KR=1,NKR
+	ikr_spon_break=kr
+	IF (DROPRADII(kr)>=0.3) exit
+END DO
+
+WRITE( wrf_err_message , * ) 'IKR_Spon_Break=',ikr_spon_break
+CALL wrf_message ( TRIM ( wrf_err_message ) )
+
+if (i_break_method==1) then
+ 	DO KR=1,NKR
+		 prob(kr)=2.94d-7*dexp(34.0d0*DROPRADII(kr))
+	ENDDO
+else if  (i_break_method==2) then
+ 	DO KR=1,NKR
+		 prob(kr)=0.155d-3*dexp(1.466d0*10.0d0*DROPRADII(kr))
+ 	ENDDO
+endif
+
+!DO KR=1,NKR
+!  prob(kr)=2.94d-7*dexp(34.0d0*DROPRADII_dp(kr))*dtime_spon_break
+!  IF (prob(kr)>=1.0d0) exit
+!END DO
+
+DO j=ikr_spon_break,nkr
+	DO i=1,j-1
+		gain_var(j,i)=(145.37d0/xl_dp(i))*(dropradii_dp(i)/dropradii_dp(j))*dexp(-7.0d0*dropradii_dp(i)/dropradii_dp(j))
+		!gain_var_new(j,i)=gain_var(j,i)*xl(j)/(gain_var(j,i)*xl(i)**2.0d0)
+		nnd(j,i)=gamma*dexp(-gamma*diameter(i))/(1-dexp(-gamma*diameter(j)))
+	END DO
+END DO
+! Calculation the ratio that leads to mass conservation
+q_m = 0.0
+DO i=1,ikr_spon_break-1
+  !nnd_m = nnd_m+nnd(ikr_spon_break,i)*m(i);
+   q_m = q_m + gain_var(ikr_spon_break,i)*xl_dp(i)**2;
+END DO
+ratio_new = q_m/xl_dp(ikr_spon_break)
+ ! print*, 'ikr_spon_break,q_m,xl(ikr_spon_break),ratio_new'
+ ! print*,  ikr_spon_break,q_m,xl(ikr_spon_break),ratio_new
+ DO j=ikr_spon_break,nkr
+ 	DO i=1,j-1
+  	gain_var_new(j,i) = gain_var(j,i)/ratio_new
+ 	END DO
+ END DO
+
+ RETURN
+ End Subroutine Spontanous_Init
+! +-----------------------------------------------------------------------------+
+! i_break_method=1: Spontaneous breakup according to Srivastava1971_JAS -
+! Size distribution od raindrops generated by their breakup and coalescence
+! i_break_method=2: Spontaneous breakup according to Kamra et al 1991 JGR -
+! SPONTANEOUS BREAKUP OF CHARGED AND UNCHARGED WATER DROPS FREELY SUSPENDED IN A WIND TUNNEL
+! Eyal's new changes (29/3/15)    (start)
+! Description of variables       (start)
+! FF1R(KR), 1/g/cm3 - non conservative drop size distribution
+! XL(kr), g - Mass of liquid drops
+! prob, dimensionless - probability for breakup
+! dropconc_bf(kr), cm^-3 - drops concentration before breakup
+! dropconc_af(kr), cm^-3 - drops concentration before breakup
+! drops_break(kr), cm^-3 - concentration of breaking drops
+! Description of variables       (end)
+
+  SUBROUTINE Spont_Rain_BreakUp (DTwrf, FF1R, XL, Prob, Gain_Var_New, NND, NKR, ikr_spon_break)
+
+  implicit none
+
+  integer,intent(in) :: NKR, IKR_Spon_Break
+  real(kind=r8size),intent(INOUT) :: FF1R(:)
+  real(kind=r8size),intent(IN) ::XL(:),Prob(:),Gain_Var_New(:,:),NND(:,:)
+  real(kind=r4size),intent(in) :: DTwrf
+
+! ... Local
+  real(kind=r8size) :: dm, deg01, tmp_1, tmp_2, tmp_3
+  real(kind=r8size),dimension(nkr) :: dropconc_bf, dropconc_af, drops_break, psi1, dropradii
+  integer :: kr,i,imax,j
+  real(kind=r4size) :: start_time, end_time, dtime_spon_break
+! ... Local
+
+ dtime_spon_break = DTwrf
+
+  DEG01 = 1.0/3.0
+  DO KR=1,NKR
+     DROPRADII(KR)=(3.*XL(KR)/4./3.141593/1.)**DEG01
+  ENDDO
+
+  if(SUM(FF1R) <= nkr*1.D-30) return
+
+  imax=nkr
+  do i=nkr,1,-1
+     imax=i
+     if (FF1R(i) > 0.0D0) exit
+  enddo
+
+  if (imax> the time was added here and not in the initialization
+		tmp_2 = dexp(-tmp_1)
+		tmp_3 = dropconc_bf(kr)
+		dropconc_af(kr) = tmp_2*tmp_3
+		!dropconc_af(kr) = dexp(-dtime_spon_break*prob(kr))*dropconc_bf(kr)
+    drops_break(kr) = dropconc_bf(kr)-dropconc_af(kr)
+    !if (dropconc_af(kr)<0.0d0) stop 'Spontaneous breakup'
+  enddo
+
+! e) Recalculation of DSD in bin j using new concentration
+!        do kr=ikr_spon_break,imax
+!           dm=3.0D0*col*xl(kr)
+!           psi1(kr)=psi1(kr)-drops_break(kr)/dm
+!        enddo
+
+! f+g) Redistributing and calculations drops concentration over smaller (iDIV2), model stop")
-           DIFFU=0
-          END IF
-          IF (DIFFU.NE.0)THEN
-          DEL1NR=A1_MYN*(100.*DIV1)
-          DEL2NR=A2_MYN*(100.*DIV2)
- !         IF (DEL2NR.EQ.0) PRINT*,'DEL2NR = 0'
-          IF (DEL2NR.EQ.0)call wrf_error_fatal("fatal error in module_mp_fast_sbm (DEL2NR.EQ.0), model stop")
-          DEL12R=DEL1NR/DEL2NR
-          DEL12RD=DEL12R**DEL_BBR
-          EW1PN=AA1_MY*100.*DIV1*DEL12RD/100.
-!          IF (DEL12R.EQ.0)PRINT*,'DEL12R = 0'
-          IF (DEL12R.EQ.0)call wrf_error_fatal("fatal error in module_mp_fast_sbm (DEL12R.EQ.0), model stop")
-          TT=-DEL_BB/DLOG(DEL12R)
-          QQ=0.622*EW1PN/(PP-0.378*EW1PN)
-          DO KR=1,NKR
-            FF1IN(KR)=FF1R(KR)
-            DO ICE=1,ICEMAX
-             FF2IN(KR,ICE)=FF2R(KR,ICE)
-            ENDDO
-          ENDDO
-          IF (BULKNUC.eq.1)THEN
-            IF (DEL1IN.GT.0)THEN
-              IF (zcgs(I,K,J).LE.500.E2)THEN
-                FACTZ=0.
-              ELSE
-                FACTZ=1
-!               FACTZ=EXP(-(zcgs(I,K,J)-2.E5)/Z0IN)
-              END IF
-             CONCCCN_XZ=FACTZ*ACCN*(100.*DEL1IN)**BCCN
+	KMAX=KR_SNOW_MAX
+	KMIN=KR_SNOW_MIN
 
-             CONCDROP=0.D0
+	A=X(KMAX)*X(KMAX)
 
-             DO KR=1,NKR
-               CONCDROP=CONCDROP+FF1IN(KR)*XL(KR)
-             ENDDO
+	GLW_MAX=0.0D0
 
-             CONCDROP=CONCDROP*3.D0*COL
-             IF(CONCCCN_XZ.GT.CONCDROP) &
-     &       FF1IN(1)=FF1IN(1)+(CONCCCN_XZ-CONCDROP)/(3.D0*COL*XL(1))
-            END IF
-          ELSE
-            IF(DEL1IN.GT.0.OR.DEL2IN.GT.0)THEN
-             CALL JERNUCL01(FF1IN,FF2IN,FCCN &
-     &       ,XL,XI,TT,QQ &
-     &       ,rhocgs(I,K,J),pcgs(I,K,J) &
-     &       ,DEL1IN,DEL2IN &
-     &       ,COL,AA1_MY, BB1_MY, AA2_MY,BB2_MY &
-     &       ,C1_MEY,C2_MEY,SUP2_OLD,DSUPICE_XYZ(I,K,J) &
-     &       ,RCCN,DROPRADII,NKR,ICEMAX,ICEPROCS)
-            END IF
-          END IF
-          DO KR=1,NKR
-            DO ICE=1,ICEMAX
-             FF3R(KR)=FF3R(KR)+FF2IN(KR,ICE)
-             FF2IN(KR,ICE)=0.
-             FF2R(KR,ICE)=0.
-            END DO
-          END DO
-          DO KR=1,NKR
-            FF1R(KR)=FF1IN(KR)
-!           DO ICE=1,ICEMAX
-!            FF2R(KR,ICE)=FF2IN(KR,ICE)
-!           ENDDO
-          ENDDO
-          FMAX1=0.
-          FMAX2=0.
-          FMAX3=0.
-          FMAX4=0.
-          FMAX5=0.
-          DO KR=1,NKR
-            FF1IN(KR)=FF1R(KR)
-            FMAX1=AMAX1(FF1R(KR),FMAX1)
-            FF3IN(KR)=FF3R(KR)
-            FMAX3=AMAX1(FF3R(KR),FMAX3)
-            FF4IN(KR)=FF4R(KR)
-            FMAX4=AMAX1(FF4R(KR),FMAX4)
-            FF5IN(KR)=FF5R(KR)
-            FMAX5=AMAX1(FF5R(KR),FMAX5)
-            DO ICE=1,ICEMAX
-             FF2IN(KR,ICE)=FF2R(KR,ICE)
-             FMAX2=AMAX1(FF2R(KR,ICE),FMAX2)
-            END DO
-          END DO
-          ISYM1=0
-          ISYM2=0
-          ISYM3=0
-          ISYM4=0
-          ISYM5=0
-          IF(FMAX1.GT.0)ISYM1=1
-          IF (ICEPROCS.EQ.1)THEN
-           IF(FMAX2.GT.1.E-4)ISYM2=1
-           IF(FMAX3.GT.1.E-4)ISYM3=1
-           IF(FMAX4.GT.1.E-4)ISYM4=1
-           IF(FMAX5.GT.1.E-4)ISYM5=1
-          END IF
-! Avoid Diffusional Growth
-!         IF (T_OLD(I,K,J).GE.237)THEN     
-! Same temperature range as above.
-          IF (T_OLD(I,K,J).GT.233)THEN     
-          IF(ISYM1.EQ.1.AND.((TT-273.15).GT.-0.187.OR. &
-     &     (ISYM2.EQ.0.AND. &
-     &     ISYM3.EQ.0.AND.ISYM4.EQ.0.AND.ISYM5.EQ.0)))THEN
-           CALL ONECOND1(TT,QQ,PP,rhocgs(I,K,J) &
-     &      ,VR1,pcgs(I,K,J) &
-     &      ,DEL1IN,DEL2IN,DIV1,DIV2 &
-     &      ,FF1R,FF1IN,XL,RLEC,RO1BL &
-     &      ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
-     &      ,C1_MEY,C2_MEY &
-     &      ,COL,DTCOND,ICEMAX,NKR)
-          ELSE IF(ISYM1.EQ.0.AND.(TT-273.15).LE.-0.187.AND. &
-     &     (ISYM2.EQ.1.OR.ISYM3.EQ.1.OR.ISYM4.EQ.1.OR.ISYM5.EQ.1))THEN
-           CALL ONECOND2(TT,QQ,PP,rhocgs(I,K,J) &
-     &      ,VR2,VR3,VR4,VR5,pcgs(I,K,J) &
-     &      ,DEL1IN,DEL2IN,DIV1,DIV2 &
-     &      ,FF2R,FF2IN,XI,RIEC,RO2BL &
-     &      ,FF3R,FF3IN,XS,RSEC,RO3BL &
-     &      ,FF4R,FF4IN,XG,RGEC,RO4BL &
-     &      ,FF5R,FF5IN,XH,RHEC,RO5BL &
-     &      ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
-     &      ,C1_MEY,C2_MEY &
-     &      ,COL,DTCOND,ICEMAX,NKR &
-     &      ,ISYM2,ISYM3,ISYM4,ISYM5)
-          ELSE IF(ISYM1.EQ.1.AND.(TT-273.15).LE.-0.187.AND. &
-     &     (ISYM2.EQ.1.OR.ISYM3.EQ.1.OR.ISYM4.EQ.1 &
-     &     .OR.ISYM5.EQ.1))THEN
-           CALL ONECOND3(TT,QQ,PP,rhocgs(I,K,J) &
-     &      ,VR1,VR2,VR3,VR4,VR5,pcgs(I,K,J) &
-     &      ,DEL1IN,DEL2IN,DIV1,DIV2 &
-     &      ,FF1R,FF1IN,XL,RLEC,RO1BL &
-     &      ,FF2R,FF2IN,XI,RIEC,RO2BL &
-     &      ,FF3R,FF3IN,XS,RSEC,RO3BL &
-     &      ,FF4R,FF4IN,XG,RGEC,RO4BL &
-     &      ,FF5R,FF5IN,XH,RHEC,RO5BL &
-     &      ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
-     &      ,C1_MEY,C2_MEY &
-     &      ,COL,DTCOND,ICEMAX,NKR &
-     &      ,ISYM1,ISYM2,ISYM3,ISYM4,ISYM5)
-          END IF
-          DO KR=1,NKR
-            DO ICE=1,ICEMAX
-             FF3R(KR)=FF3R(KR)+FF2R(KR,ICE)
-             FF2R(KR,ICE)=0
-            END DO
-            FF4R(KR)=FF4R(KR)+FF5R(KR)
-            FF5R(KR)=0
-          END DO
-          END IF
-          END IF
-             IF (IKL.EQ.NCOND)CALL COAL_BOTT_NEW(FF1R,FF2R,FF3R, &
-     &       FF4R,FF5R,TT,QQ,PP,rhocgs(I,K,J),dt_coll,TCRIT,TTCOAL)
-         END DO
-         IF (DIFFU.EQ.0)THEN
-         th_phy(i,k,j) = tt_old/pi_phy(i,k,j)
-         qv(i,k,j)=qq_old
-    !     print*,'tt_old = ',tt_old
-    !     print*,'qq_old = ',qq_old
-         ELSE
-         th_phy(i,k,j) = tt/pi_phy(i,k,j)
-         qv(i,k,j)=qq
-         END IF
-        END IF
-! LIQIUD
-        IF (REMSAT.EQ.1)THEN
-        DO KR=1,NKR
-         FF1R(KR)=0.
-         FCCN(KR)=0
-         IF (ICEPROCS.EQ.1)THEN
-          FF2R(KR,1)=0.
-          FF2R(KR,2)=0.
-          FF2R(KR,3)=0.
-          FF3R(KR)=0.
-          FF4R(KR)=0.
-          FF5R(KR)=0.
-         END IF
-        END DO
-        END IF
-        KRR=0
-        DO KR=p_ff1i01,p_ff1i33
-          KRR=KRR+1
-          chem_new(I,K,J,KR)=FF1R(KRR)
-        END DO   
-! CCN
-        KRR=0
-        DO KR=p_ff8i01,p_ff8i33
-          KRR=KRR+1
-!         chem_new(I,K,J,KR)=FCCN(KRR)
-!         chem_new(I,K,J,KR)=FCCN(KRR)/RHOCGS(I,K,J)*XCCN(KRR)
-          chem_new(I,K,J,KR)=FCCN(KRR)
-        END DO
-        IF (ICEPROCS.EQ.1)THEN
-         KRR=0
-         DO KR=p_ff5i01,p_ff5i33
-          KRR=KRR+1
-!         chem_new(I,K,J,KR)=FF3R(KRR)
-!         chem_new(I,K,J,KR)=FF3R(KRR)*(1./RHOCGS(I,K,J))*COL*XS(KRR)*XS(KRR)*3
-          chem_new(I,K,J,KR)=FF3R(KRR)
-         END DO
-! Graupel
-         KRR=0
-         DO KR=p_ff6i01,p_ff6i33
-          KRR=KRR+1
-!         chem_new(I,K,J,KR)=FF4R(KRR)
-!         chem_new(I,K,J,KR)=FF4R(KRR)*(1./RHOCGS(I,K,J))*COL*XG(KRR)*XG(KRR)*3
-          chem_new(I,K,J,KR)=FF4R(KRR)
-         END DO
-        END IF
-      END DO
-      END DO
-      END DO
-      NKRO=1
-      NKRE=NKR
-      DO j = jts,jte
-      DO i = its,ite
-      DO k = kts,kte
-      rhocgs_z(k)=rhocgs(i,k,j)
-      pcgs_z(k)=pcgs(i,k,j)
-      zcgs_z(k)=zcgs(i,k,j)
-      krr=0
-      do kr=p_ff1i01,p_ff1i33
-       krr=krr+1
-       ffx_z(k,krr)=chem_new(i,k,j,kr)/rhocgs(i,k,j)
-      end do
-      end do
-      CALL FALFLUXHUCM(ffx_z,VR1,RHOCGS_z,PCGS_z,ZCGS_z,DT,kts,kte,nkr)
-      DO k = kts,kte
-      krr=0
-      do kr=p_ff1i01,p_ff1i33
-       krr=krr+1
-       chem_new(i,k,j,kr)=ffx_z(k,krr)*rhocgs(i,k,j)
-      end do
-      end do
-      if (iceprocs.eq.1)then
-      DO k = kts,kte
-      rhocgs_z(k)=rhocgs(i,k,j)
-      pcgs_z(k)=pcgs(i,k,j)
-      zcgs_z(k)=zcgs(i,k,j)
-      krr=0
-      do kr=p_ff5i01,p_ff5i33
-       krr=krr+1
-       ffx_z(k,krr)=chem_new(i,k,j,kr)/rhocgs(i,k,j)
-      end do
-      end do
-      CALL FALFLUXHUCM(ffx_z,VR3,RHOCGS_z,PCGS_z,ZCGS_z,DT,kts,kte,nkr)
-      DO k = kts,kte
-      krr=0
-      do kr=p_ff5i01,p_ff5i33
-       krr=krr+1
-       chem_new(i,k,j,kr)=ffx_z(k,krr)*rhocgs(i,k,j)
-      end do
-      end do
-      DO k = kts,kte
-      rhocgs_z(k)=rhocgs(i,k,j)
-      pcgs_z(k)=pcgs(i,k,j)
-      zcgs_z(k)=zcgs(i,k,j)
-      krr=0
-      do kr=p_ff6i01,p_ff6i33
-       krr=krr+1
-       ffx_z(k,krr)=chem_new(i,k,j,kr)/rhocgs(i,k,j)
-      end do
-      end do
-      CALL FALFLUXHUCM(ffx_z,VR4,RHOCGS_z,PCGS_z,ZCGS_z,DT,kts,kte,nkr)
-      DO k = kts,kte
-      krr=0
-      do kr=p_ff6i01,p_ff6i33
-       krr=krr+1
-       chem_new(i,k,j,kr)=ffx_z(k,krr)*rhocgs(i,k,j)
-      end do
-      end do
-!    &     ims,ime,jms,jme,kms,kme)
-      end if
-     end do 
-     end do 
-
-      gmax=0
-      qmax=0
-      imax=0
-      kmax=0
-      qnmax=0
-      inmax=0
-      knmax=0
-      DO j = jts,jte
-      DO i = its,ite
-      DO k = kts,kte
-      QC(I,K,J)=0
-      QR(I,K,J)=0
-!     QI(I,K,J)=0
-!     QIC(I,K,J)=0
-!     QIP(I,K,J)=0
-!     QID(I,K,J)=0
-      QI(I,K,J)=0
-      QS(I,K,J)=0
-      QG(I,K,J)=0
-      QNC(I,K,J)=0
-      QNR(I,K,J)=0
-      QNS(I,K,J)=0
-      QNG(I,K,J)=0
-      QNA(I,K,J)=0
-!     EFFR(I,K,J)=0
-!     if (mod(itimestep,t_print).eq.0)then
-      tt= th_phy(i,k,j)*pi_phy(i,k,j)
-      DO KR=1,NKR
-      COLREFLL(KR)=COEFREFLL
-      COLREFLI(KR)=COEFREFLI
-        IF(TT.GE.271.15.AND.TT.LE.273.15) THEN
-               COLREFLS(KR)=COEFREF00/0.09
-               COLREFLG(KR)=COEFREF00/RO4BL(KR)/RO4BL(KR)
-               COLREFLH(KR)=COEFREF00/RO5BL(KR)/RO5BL(KR)
-        ELSE
-               COLREFLS(KR)=COEFREFLI
-               COLREFLG(KR)=COEFREFLI
-               COLREFLH(KR)=COEFREFLI
-        ENDIF
-      END DO
-!     END IF
-      EFF_N=0.
-      EFF_D=0.
-      krr=0
-      DO kr= p_ff1i01,p_ff1i33
-          KRR=KRR+1
-        IF (KRR.LT.KRDROP)THEN
-          EFF_N=DROPRADII(KRR)**3*chem_new(i,k,j,KR)*XL(KRR)+EFF_N
-          EFF_D=DROPRADII(KRR)**2*chem_new(i,k,j,KR)*XL(KRR)+EFF_D
-          QC(I,K,J)=QC(I,K,J) &
-     &      +(1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XL(KRR)*XL(KRR)*3
-!          QNC(I,K,J)=QNC(I,K,J) &
-! J. Fan
-!     &      +COL*chem_new(I,K,J,KR)*XL(KR)*3
-           QNC(I,K,J)=QNC(I,K,J) &
-    &       +COL*chem_new(I,K,J,KR)*XL(KRR)*3/rhocgs(I,K,J)*1000. ! #/kg
-        ELSE
-          QR(I,K,J)=QR(I,K,J) &
-     &      +(1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XL(KRR)*XL(KRR)*3
-          QNR(I,K,J)=QNR(I,K,J) &
-     &      +COL*chem_new(I,K,J,KR)*XL(KRR)*3/rhocgs(I,K,J)*1000. ! #/kg by Fan
-        END IF
-      END DO
-!     IF(QC(I,K,J).GT.1.E-6.and.EFF_D.GT.0)THEN
-!         EFFR(I,K,J)=EFF_N/EFF_D
-!     END IF
-      KRR=0
-      IF (ICEPROCS.EQ.1)THEN
-       KRR=0
-       DO  KR=p_ff5i01,p_ff5i33
-        KRR=KRR+1
-        if (KRR.LE.KRICE)THEN
-        QI(I,K,J)=QI(I,K,J) &
-     &   +(1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XS(KRR)*XS(KRR)*3
-        ELSE
-        QS(I,K,J)=QS(I,K,J) &
-     &   +(1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XS(KRR)*XS(KRR)*3
-        END IF
-        QNS(I,K,J)=QNS(I,K,J) &
-!     &   +1000*COL*chem_new(I,K,J,KR)*XS(KRR)*3
-     &   +COL*chem_new(I,K,J,KR)*XS(KRR)*3/rhocgs(I,K,J)*1000. ! #/kg by Fan
-       END DO
-       KRR=0
-       DO  KR=p_ff6i01,p_ff6i33
-        KRR=KRR+1
-        QG(I,K,J)=QG(I,K,J) &
-     &   +(1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XG(KRR)*XG(KRR)*3
-        QNG(I,K,J)=QNG(I,K,J) &
-!     &   +1000*COL*chem_new(I,K,J,KR)*XG(KRR)*3
-     &   +COL*chem_new(I,K,J,KR)*XG(KRR)*3/rhocgs(I,K,J)*1000. ! #/kg by Fan
-       END DO
-      END IF
-       KRR=0
-       DO  KR=p_ff8i01,p_ff8i33
-        KRR=KRR+1
-        QNA(I,K,J)=QNA(I,K,J) &
-!     &   +COL*chem_new(I,K,J,KR)*3
-!  change by J.Fan
-     &   +COL*chem_new(I,K,J,KR)/rhocgs(I,K,J)*1000.   ! #/kg
-       END DO
+	DO K=KMAX+1,NKR
+   		GLW_MAX=GLW_MAX+X(K)*X(K)*F(K)*FL(K)
+	ENDDO
 
-      END DO
-      END DO
-      END DO
+	GLW_MAX=GLW_MAX+A*F(KMAX)*FL(KMAX)
 
+	FLW_MAX=GLW_MAX/A
 
+	GRM_MAX=0.0D0
 
-998   format(' ',10(f10.1,1x))
-      DO j = jts,jte
-      DO i = its,ite
-       krr=0
-       RAINNCV(I,J)=0.
-       SNOWNCV(I,J)=0.
-       GRAUPELNCV(I,J)=0.
-       DO KR=p_ff1i01,p_ff1i33
-        krr=krr+1
-        DELTAW=VR1(KRR)
-        RAINNC(I,J)=RAINNC(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XL(KRR)*XL(KRR)
-        RAINNCV(I,J)= RAINNCV(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XL(KRR)*XL(KRR)
-       END DO
-       KRR=0
-       DO KR= p_ff5i01,p_ff5i33
-        KRR=KRR+1
-        DELTAW=VR3(KRR)
-        RAINNC(I,J)=RAINNC(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XS(KRR)*XS(KRR)
-        RAINNCV(I,J)=RAINNCV(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XS(KRR)*XS(KRR)
-        SNOWNC(I,J)=SNOWNC(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XS(KRR)*XS(KRR)
-        SNOWNCV(I,J)= SNOWNCV(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XS(KRR)*XS(KRR)
-       END DO
-       KRR=0
-       DO KR=p_ff6i01,p_ff6i33
-        KRR=KRR+1
-        DELTAW=VR4(KRR)
-        RAINNC(I,J)=RAINNC(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XG(KRR)*XG(KRR)
-        RAINNCV(I,J)=RAINNCV(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XG(KRR)*XG(KRR)
-        GRAUPELNC(I,J)=GRAUPELNC(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XG(KRR)*XG(KRR)
-        GRAUPELNCV(I,J)= GRAUPELNCV(I,J) &
-     &  +10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
-     &           chem_new(I,1,J,KR)*XG(KRR)*XG(KRR)
-       END DO
-      do k=kts,kte
+	DO K=KMAX+1,NKR
+   		GRM_MAX=GRM_MAX+X(K)*X(K)*F(K)*(1.0D0-FL(K))*RF(K)
+	ENDDO
 
+	GRM_MAX=GRM_MAX+A*F(KMAX)*(1.0D0-FL(KMAX))*RF(KMAX)
 
-          qv1d(k)=qv(i,k,j)
-          qr1d(k)=qr(i,k,j)
-          nr1d(k)=qnr(i,k,j)
-          qs1d(k)=qs(i,k,j)
-          ns1d(k)=qns(i,k,j)
-          qg1d(k)=qg(i,k,j)
-          ng1d(k)=qng(i,k,j)
-          t1d(k)=th_phy(i,k,j)*pi_phy(i,k,j)
-          p1d(k)=P_PHY(I,K,J)
-       end do
-! wrf-chem
-
-!+---+-----------------------------------------------------------------+
-         IF ( PRESENT (diagflag) ) THEN
-         if (diagflag .and. do_radar_ref == 1) then
-          call refl10cm_hm (qv1d, qr1d, nr1d, qs1d, ns1d, qg1d, ng1d,   &
-                      t1d, p1d, dBZ, kts, kte, i, j)
-          do k = kts, kte
-             refl_10cm(i,k,j) = MAX(-35., dBZ(k))
-          enddo
-         endif
-         ENDIF
-         SR(I,J) = (SNOWNCV(I,J)+GRAUPELNCV(I,J))/(RAINNCV(I,J)+1.e-12)
+	FRM_MAX=GRM_MAX/A
 
-!     print*, i,j,rainnc(i,j)
-      END DO
-      END DO
+	GMAX=0.0D0
 
+	DO K=KMAX+1,NKR
+   		GMAX=GMAX+X(K)*X(K)*F(K)
+	ENDDO
 
-      do j=jts,jte
-      do k=kts,kte
-      do i=its,ite
-         th_old(i,k,j)=th_phy(i,k,j)
-         qv_old(i,k,j)=qv(i,k,j)
-      end do
-      end do
-      end do
-      if (conserv)then
-      DO j = jts,jte
-      DO i = its,ite
-      DO k = kts,kte
-      rhocgs(I,K,J)=rho_phy(I,K,J)*0.001
-      krr=0
-      DO KR=p_ff1i01,p_ff1i33
-        krr=krr+1
-       chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*COL*XL(KRR)*XL(KRR)*3.0
-      END DO
-      KRR=0
-      DO KR=p_ff5i01,p_ff5i33
-       KRR=KRR+1
-       chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*COL*XS(KRR)*XS(KRR)*3.0
-      END DO
-      KRR=0
-      DO KR=p_ff6i01,p_ff6i33
-       KRR=KRR+1
-       chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*COL*XG(KRR)*XG(KRR)*3.0
-      END DO
-      KRR=0
-      DO KR=p_ff8i01,p_ff8i33
-       KRR=KRR+1
-! change by Fan
-!       chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*XCCN(KRR)
-       chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*1000.          ! #/kg; remember chem_new for CCN is #/cm3, not #/(gcm-3)
-      END DO
-      END DO
-      END DO
-      END DO
-      END IF
-     
-      RETURN
-  END SUBROUTINE FAST_SBM
-      SUBROUTINE FALFLUXHUCM(chem_new,VR1,RHOCGS,PCGS,ZCGS,DT, &
-     &     kts,kte,nkr)
-      IMPLICIT NONE
-      INTEGER I,J,K,KR
-      INTEGER    kts,kte,nkr
-      REAL TFALL,DTFALL,VFALL(KTE),DWFLUX(KTE)
-      REAL DT
-      INTEGER IFALL,N,NSUB
-      REAL, DIMENSION( kts:kte,nkr ) :: chem_new 
-      REAL,  DIMENSION(kts:kte) :: rhocgs,pcgs,zcgs
-      REAL VR1(NKR)
-
-! FALLING FLUXES FOR EACH KIND OF CLOUD PARTICLES: C.G.S. UNIT
-! ADAPTED FROM GSFC CODE FOR HUCM
-!  The flux at k=1 is assumed to be the ground so FLUX(1) is the
-! flux into the ground. DWFLUX(1) is at the lowest half level where
-! Q(1) etc are defined. The formula for FLUX(1) uses Q(1) etc which
-! is actually half a grid level above it. This is what is meant by
-! an upstream method. Upstream in this case is above because the
-! velocity is downwards.      
-! USE UPSTREAM METHOD (VFALL IS POSITIVE)                 
-!        print*,'pcgs(i,k,j) = ',pcgs(100,10,1)
-!        print*,'pcgs(i,k,j) = ',pcgs(100,1,1)
-!      read(5,*)
-!        print*,'pcgs(i,k,j) = ',zcgs(100,10,1)
-!        print*,'pcgs(i,k,j) = ',zcgs(100,1,1)
-!      read(5,*)
-      DO KR=1,NKR
-       IFALL=0
-       DO k = kts,kte
-          IF(chem_new(K,KR).GE.1.E-10)IFALL=1
-       END DO 
-       IF (IFALL.EQ.1)THEN
-        TFALL=1.E10                
-        DO K=kts,kte
-         VFALL(K) = VR1(KR)*SQRT(1.E6/PCGS(K))
-!        if (krr.eq.20.or.krr.eq.33)then
-!        if (k.eq.5.or.k.eq.10.or.k.eq.20)then
-!        print*,'vr1(krr) = ',krr,vr1(krr)
-!        print*, 'SQRT(1.E6/PCGS(I,K,J)) = ',i,k,SQRT(1.E6/PCGS(I,K,J))
-!        print*,'vfall(k) = ',i,k,vfall(k)
-!        print*,'zcgs(k) = ',i,k,zcgs(i,k,j)
-!        read(5,*)
-!        end if
-!        end if
-         TFALL=AMIN1(TFALL,ZCGS(K)/(VFALL(K)+1.E-20))    
-!        print*,'tfall = ',i,k,tfall
-!        if (krr.eq.5.or.krr.eq.10.or.krr.eq.20.or.krr.eq.33)read(5,*)
-        END DO                                                 
-        IF(TFALL.GE.1.E10)call wrf_error_fatal("fatal error in module_mp_fast_sbm (TFALL.GE.1.E10), model stop")
-        NSUB=(INT(2.0*DT/TFALL)+1)                           
-        DTFALL=DT/NSUB                                      
-
-        DO N=1,NSUB                                    
-          DO K=KTS,KTE-1                               
-           DWFLUX(K)=-(RHOCGS(K)*VFALL(K)*chem_new(k,kr)- &
-     &     RHOCGS(K+1)* &
-     &     VFALL(K+1)*chem_new(K+1,KR))/(RHOCGS(K)*(ZCGS(K+1)- &
-     &      ZCGS(K)))    
-          END DO    
-! NO Z ABOVE TOP, SO USE THE SAME DELTAZ
-          DWFLUX(KTE)=-(RHOCGS(KTE)*VFALL(KTE)* & 
-     &       chem_new(kte,kr))/(RHOCGS(KTE)*(ZCGS(KTE)-ZCGS(KTE-1)))         
-          DO K=kts,kte                                         
-           chem_new(k,kr)=chem_new(k,kr)+DWFLUX(K)*DTFALL
-          END DO  
-        END DO  
-       END IF
-      END DO  
-      RETURN                                                                  
-      END SUBROUTINE FALFLUXHUCM                                                                    
-      SUBROUTINE FAST_HUCMINIT(DT)
-      IMPLICIT NONE
-      INTEGER IKERN_0,IKERN_Z,L0_REAL,L0_INTEGER,INEWMEY,INEST
-      INTEGER I,J,K,KR
-      REAL DT
-      INTEGER :: hujisbm_unit1
-      LOGICAL, PARAMETER :: PRINT_diag=.FALSE.
-      LOGICAL :: opened 
-      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
-      CHARACTER*80 errmess
-      REAL PI
-      double precision ax
-      data pi/3.141592654/
-! dtime - timestep of integration (calculated in main program) :
-! ax - coefficient used for masses calculation 
-! ima(i,j) - k-category number, c(i,j) - courant number 
-
-        REAL C1(NKR,NKR)
-! DON'T NEED ALL THESE VARIABLES: STILL NEED EDITING
-       INTEGER ICE,KGRAN,IPRINT01
-       REAL TWSIN,TWCIN,TWNUC,XF5,XF4,XF3,CONCHIN,CONCGIN,CONCSIN, &
-     & CONCCLIN,TWHIN,RADH,RADS,RADG,RADL,CONCLIN,A1_MY,A2,A2_MY,XLK, &
-     & A1N,A3_MY,A3,A1_MYN,R0CCN,X0DROP,DEG01,CONTCCNIN,CONCCCNIN, &
-     & A,B,X0CCN,S_KR,RCCNKR,R0,X0,TWCALLIN,A1,RCCNKR_CM,SUMIIN,TWGIN, &
-     & XF1N,XF1,WC1N,RF1N,WNUC,RNUC,WC5,RF5, &
-     & WC4,RF4,WC3,RF3,WC1,RF1,SMAX
-       REAL TWIIN(ICEMAX)
-       REAL RO_SOLUTE      
-       REAL A_FALL,B_FALL
-       real graupel_fall(nkr)
-       data graupel_fall/0.36840E-01,0.57471E-01,0.88417E-01,0.13999E+00,&
-     &  0.22841E+00,0.36104E+00,0.56734E+00, 0.88417E+00, 0.13999E+01,&
-     &  0.22104E+01, 0.35367E+01, 0.54524E+01, 0.81049E+01,0.12526E+02,&
-     &  0.19157E+02, 0.27262E+02, 0.34627E+02, 0.39776E+02,0.45690E+02,& 
-     &  0.52485E+02, 0.60289E+02, 0.69254E+02, 0.10000E+03, 0.15429E+03,&
-     &  0.18561E+03, 0.22329E+03, 0.26863E+03,  0.32316E+03,0.38877E+03,& 
-     &  0.46770E+03, 0.56266E+03, 0.67690E+03,  0.81432E+03/
-
-       PARAMETER (RO_SOLUTE=2.16)
-       INTEGER KR_MIN,KR_MIN1,KR_MAX
-       REAL RADCCN_MIN,RADCCN_MIN1,RADCCN_MAX
-     REAL  ::      RHOSU       ! STANDARD AIR DENSITY AT 850 MB
-     REAL ::      RHOW        ! DENSITY OF LIQUID WATER
-     REAL ::      RHOI        ! BULK DENSITY OF CLOUD ICE
-     REAL ::      RHOSN       ! BULK DENSITY OF SNOW
-     REAL ::      RHOG        ! BULK DENSITY OF GRAUPEL
-     REAL ::      CI,DI,CS,DS,CG,DG ! SIZE DISTRIBUTION PARAMETERS FOR CLOUD ICE, SNOW, GRAUPE
-
-       REAL FR_CON,FR_MAR
-       FR_MAR=1.0
-!      FR_CON=1-FR_MAR
-       FR_CON=1.0
- !       PRINT*, 'INITIALIZING HUCM'  
-!	print *, ' ****** HUCM *******'
-       call wrf_message("SBM FAST: INITIALIZING HUCM")
-
-! INPUT :
-        dlnr=dlog(2.d0)/(3.d0*scal)
-!     print*,'here in hucmint 1'
-!
-!--- Read in various lookup tables
-!
-    !    print*,'wrf_dm_on_monitor() =',wrf_dm_on_monitor() 
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2061
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2061     CONTINUE
-        ENDIF
-!
-!     print*,'here in hucmint 2',hujisbm_unit1
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!     print*,'here in hucmint 3',hujisbm_unit1
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-!       print*,'here at 1'
-!      print*,'here in hucmint 4'
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="capacity.asc",                  &
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
-
-  900	FORMAT(6E13.5)
-	READ(hujisbm_unit1,900) RLEC,RIEC,RSEC,RGEC,RHEC
-	CLOSE(hujisbm_unit1)
-!     print*,'here in hucmint 5'
-        END IF
-        CALL wrf_dm_bcast_bytes ( RLEC , size ( RLEC ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( RIEC , size ( RIEC ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( RSEC , size ( RSEC ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( RGEC , size ( RGEC ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( RHEC , size ( RHEC ) * RWORDSIZE )
-! MASSES :
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2062
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2062     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="masses.asc",                  &
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
-	READ(hujisbm_unit1,900) XL,XI,XS,XG,XH          
-	CLOSE(hujisbm_unit1)
-!	print *, ' ***** file2: succesfull *******'
-        call wrf_message("SBM FAST: file2: succesfull")
-        ENDIF
-        CALL wrf_dm_bcast_bytes ( XL , size ( XL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( XI , size ( XI ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( XS , size ( XS ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( XG , size ( XG ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( XH , size ( XH ) * RWORDSIZE )
-! TERMINAL VELOSITY :
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2063
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2063     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="termvels.asc",                  &
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
-	READ(hujisbm_unit1,900) VR1,VR2,VR3,VR4,VR5     
-	CLOSE(hujisbm_unit1)
-!	print *, ' ***** file3: succesfull *******'
-        call wrf_message("SBM FAST: file3: succesfull")
-        ENDIF
-        CALL wrf_dm_bcast_bytes ( VR1 , size ( VR1 ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( VR2 , size ( VR2 ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( VR3 , size ( VR3 ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( VR4 , size ( VR4 ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( VR5 , size ( VR5 ) * RWORDSIZE )
-! CHANGE FALL VELOCITY OF GRAUPEL
-        DO KR=1,NKR
-!        A=RADXXO(KR,6)
-!        B=RADXXO(KR,7)
-         if (kr.le.17)then
-          A_FALL=1
-          B_FALL=0
-         else
-          B_FALL=1
-          A_FALL=0
-         end if
-  
-!        VR4(KR)=A_FALL*VR4(KR)+B_FALL*VR5(KR)
-!        print*,'vr4,vr5,graupel_fall=',vr3(kr),vr5(kr),graupel_fall(kr)
-         VR4(KR)=graupel_fall(kr)
-        END DO
- 
-! CONSTANTS :
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2065
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2065     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="constants.asc",                  &
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
-	READ(hujisbm_unit1,900) SLIC,TLIC,COEFIN,C2,C3,C4
-	CLOSE(hujisbm_unit1)
-!	print *, ' ***** file4: succesfull *******'
-        call wrf_message("SBM FAST: file4: succesfull")
-        END IF
-        CALL wrf_dm_bcast_bytes ( SLIC , size ( SLIC ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( TLIC , size ( TLIC ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( COEFIN , size ( COEFIN ) * RWORDSIZE )
-!       CALL wrf_dm_bcast_bytes ( C2 , size ( C2 ) * RWORDSIZE )
-!       CALL wrf_dm_bcast_bytes ( C3 , size ( C3 ) * RWORDSIZE )
-!       CALL wrf_dm_bcast_bytes ( C4 , size ( C4 ) * RWORDSIZE )
-! CONSTANTS :
-! KERNELS DEPENDING ON PRESSURE :
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2066
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2066     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="kernels_z.asc",                  &
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
-        READ(hujisbm_unit1,900)  &
-     &  YWLL_1000MB,YWLL_750MB,YWLL_500MB
-	CLOSE(hujisbm_unit1)
-        END IF
-        CALL wrf_dm_bcast_bytes ( YWLL_1000MB , size ( YWLL_1000MB ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWLL_750MB , size ( YWLL_750MB ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWLL_500MB , size ( YWLL_500MB ) * RWORDSIZE )
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2067
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2067     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="kernels.asc_s_0_03_0_9",                  &
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
-! KERNELS NOT DEPENDING ON PRESSURE :
-	READ(hujisbm_unit1,900) &
-     &  YWLL,YWLI,YWLS,YWLG,YWLH, &
-     &  YWIL,YWII,YWIS,YWIG,YWIH, &
-     &  YWSL,YWSI,YWSS,YWSG,YWSH, &
-     &  YWGL,YWGI,YWGS,YWGG,YWGH, &
-     &  YWHL,YWHI,YWHS,YWHG,YWHH
-       close (hujisbm_unit1)
-        END IF
-        CALL wrf_dm_bcast_bytes ( YWLL , size ( YWLL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWLI , size ( YWLI ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWLS , size ( YWLS ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWLG , size ( YWLG ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWLH , size ( YWLH ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWIL , size ( YWIL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWII , size ( YWII ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWIS , size ( YWIS ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWIG , size ( YWIG ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWIH , size ( YWIH ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWSL , size ( YWSL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWSI , size ( YWSI ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWSS , size ( YWSS ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWSG , size ( YWSG ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWSH , size ( YWSH ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWGL , size ( YWGL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWGI , size ( YWGI ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWGS , size ( YWGS ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWGG , size ( YWGG ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWGH , size ( YWGH ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWHL , size ( YWHL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWHI , size ( YWHI ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWHS , size ( YWHS ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWHG , size ( YWHG ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes ( YWHH , size ( YWHH ) * RWORDSIZE )
-! BULKDENSITY :
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2068
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2068     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="bulkdens.asc_s_0_03_0_9",         & 
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
-	READ(hujisbm_unit1,900) RO1BL,RO2BL,RO3BL,RO4BL,RO5BL
-	CLOSE(hujisbm_unit1)
-!	print *, ' ***** file6: succesfull *******'
-        call wrf_message("SBM FAST: file6: succesfull")
-        END IF
-        CALL wrf_dm_bcast_bytes (RO1BL  , size ( RO1BL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes (RO2BL  , size ( RO2BL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes (RO3BL  , size ( RO3BL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes (RO4BL  , size ( RO4BL ) * RWORDSIZE )
-        CALL wrf_dm_bcast_bytes (RO5BL  , size ( RO5BL ) * RWORDSIZE )
-! BULKRADIUS
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2069
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2069     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="bulkradii.asc_s_0_03_0_9",         & 
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
-	READ(hujisbm_unit1,*) RADXXO
-	CLOSE(hujisbm_unit1)
-!	print *, ' ***** file7: succesfull *******'
-        call wrf_message("SBM FAST: file7: succesfull")
-!	PRINT *, '******* Hebrew Univ Cloud model-HUCM *******'
-        call wrf_message("SBM FAST: Hebrew Univ Cloud model-HUCM")
+	GMAX=GMAX+A*F(KMAX)
+
+	F(KMAX) = GMAX/A
+
+	!FL(KMAX)=FLW_MAX/F(KMAX)
+
+	IF (F(KMAX) .lt. 1.0E-20)then
+	   if(TIN > 273.15)then
+        FL(kmax) = 1.0d0
+        RF(kmax) = 0.0d0
+	   else
+        FL(kmax) = 0.0d0
+        RF(kmax) = 1.0d0
+	   endif
+	ELSE
+	   if(TIN > 273.15)then
+		   RF(KMAX) = 0.0
+       FL(KMAX) = FLW_MAX/F(KMAX)
+	  else
+       FL(KMAX) = 0.0
+       RF(KMAX) = FRM_MAX/F(KMAX)/(1.0D0-FL(KMAX))
+	   endif
+	END IF
+
+	DO K=KMAX+1,NKR
+		F(K)=0.0D0
+		if(TIN > 273.15)then
+		  RF(K) = 0.0D0
+		  FL(K) = 1.0D0
+		else
+		  RF(K) = 1.0D0
+		  FL(K) = 0.0D0
+		endif
+	ENDDO
 
-        END IF
-        CALL wrf_dm_bcast_bytes (RADXXO  , size ( RADXXO ) * RWORDSIZE )
-! calculation of the mass(in mg) for categories boundaries :
-        ax=2.d0**(1.0/scal)
-        xl_mg(1)=0.3351d-7
-	do i=2,nkr
-           xl_mg(i)=ax*xl_mg(i-1)
-!        if (i.eq.22)print*,'printing xl_mg = ',xl_mg(22)
-        enddo
-	do i=1,nkr
-           xs_mg(i)=xs(i)*1.e3
-           xg_mg(i)=xg(i)*1.e3
-           xh_mg(i)=xh(i)*1.e3
-           xi1_mg(i)=xi(i,1)*1.e3
-           xi2_mg(i)=xi(i,2)*1.e3
-           xi3_mg(i)=xi(i,3)*1.e3
-        enddo
-! calculation of c(i,j) and ima(i,j) :
-! ima(i,j) - k-category number, c(i,j) - courant number 
-!       print*, 'calling courant_bott'
-        call courant_bott
-!       print*, 'called courant_bott'
- 
-
-	DEG01=1./3.
-
-!------------------------------------------------------------------
-
-!       print*,'XL(ICCN) = ',ICCN,XL
-	X0DROP=XL(ICCN)
-!       print*,'X0DROP = ',X0DROP
-	X0CCN =X0DROP/(2.**(NKR-1))
-	R0CCN =(3.*X0CCN/4./3.141593/ROCCN0)**DEG01
-!------------------------------------------------------------------
-! THIS TEXT FROM TWOINITM.F_203
-!------------------------------------------------------------------
-! TEMPERATURA IN SURFACE LAYER EQUAL 15 Celsius(288.15 K)  
-        A=3.3E-05/288.15
-        B=2.*4.3/(22.9+35.5)
-        B=B*(4./3.)*3.14*RO_SOLUTE
-        A1=2.*(A/3.)**1.5/SQRT(B)
-        A2=A1*100.
-!------------------------------------------------------------------
-	CONCCCNIN=0.
-	CONTCCNIN=0.
-	DO KR=1,NKR
-           DROPRADII(KR)=(3.*XL(KR)/4./3.141593/1.)**DEG01
-        ENDDO
-	DO KR=1,NKR
-!          print*,'ROCCN0 = ',ROCCN0
-!          print*, 'X0CCN = ',X0CCN 
-!          print*, 'DEG01 = ',DEG01
-	   ROCCN(KR)=ROCCN0
-	   X0=X0CCN*2.**(KR-1)
-	   R0=(3.*X0/4./3.141593/ROCCN(KR))**DEG01
-	   XCCN(KR)=X0
-	   RCCN(KR)=R0
-!          print*,'RCCN(KR)= ', KR,RCCN(KR)
-           RCCNKR_CM=R0
-! CCN SPECTRUM 
-
-           S_KR=A2/RCCNKR_CM**1.5
-           ACCN=ACCN_CON
-           BCCN=BCCN_CON
-!          print*,'accn, bccn,S_KR = ',accn,bccn,S_KR
-!  CONTINENTAL
-           FCCNR(KR)=1.5*ACCN*BCCN*S_KR**BCCN
-           FCCNR_CON(KR)=FCCNR(KR)
-!  MARITIME
-           ACCN=ACCN_MAR
-           BCCN=BCCN_MAR
-           FCCNR(KR)=1.5*ACCN*BCCN*S_KR**BCCN
-           FCCNR_MAR(KR)=FCCNR(KR)
-
-	     CONTCCNIN=CONTCCNIN+COL*FCCNR(KR)*R0*R0*R0
-             CONCCCNIN=CONCCCNIN+COL*FCCNR(KR)
+	G(KMAX)=3.0D0*F(KMAX)*A
+	DO K=KMAX-1,KMIN-1,-1
+	   G(K)=F(K)*3.0D0*X(K)*X(K)
+	   GLW(K)=G(K)*FL(K)
+	   GRM(K)=G(K)*(1.0D0-FL(K))*RF(K)
 	ENDDO
-!PRINT *, '********* MAR CCN CONCENTRATION & MASS *******'
-!	PRINT 200, CONCCCNIN,CONTCCNIN
-! CALCULATION OF FINAL MARITIME
-!RCCN(KR)=            1  1.2303877E-07
-!RCCN(KR)=            2  1.5501914E-07
-!RCCN(KR)=            3  1.9531187E-07
-!RCCN(KR)=           16  3.9372408E-06
-!RCCN(KR)=           21  1.2499960E-05
-!RCCN(KR)=           33  1.9999935E-04
-        RADCCN_MAX=RCCN(NKR)
-        RADCCN_MIN=0.005E-4         
-        RADCCN_MIN1=0.02E-4         
-!       print*,'ALOG(RADCCN_MIN) = ',ALOG(RADCCN_MIN)
-!       print*,'ALOG(RCCN(1) = ',ALOG(RCCN(1))
-!       print*,'ALOG(RADCCN_MAX) = ',ALOG(RADCCN_MAX)
-!       KR_MIN=(ALOG(RADCCN_MIN)-ALOG(RCCN(1)))/(3.*ALOG(2.))+1.
-!       KR_MIN1=(ALOG(RADCCN_MIN1)-ALOG(RCCN(1)))/(3.*ALOG(2.))+1.
-        KR_MIN=1.+ 3*(ALOG(RADCCN_MIN)- ALOG(R0CCN))/ALOG(2.)
-        KR_MIN1=1.+3*(ALOG(RADCCN_MIN1)- ALOG(R0CCN))/ALOG(2.)
-!       KR_MAX=(ALOG(RADCCN_MAX)-ALOG(RCCN(1)))/(3.*ALOG(2.))+1.
-        KR_MAX=1.+3.*(ALOG(RADCCN_MAX)- ALOG(R0CCN))/ALOG(2.)
-        KR_MIN=MAX(KR_MIN,1)
-        KR_MIN1=MAX(KR_MIN,KR_MIN1)
-        KR_MAX=MIN(NKR,KR_MAX)
-!       print*,'kr_min,kr_min1 = ',kr_min,kr_min1
-!       print*,'kr_max = ',kr_max
-! Interpolation
-        DO KR=1,NKR
-        IF (kr.ge.kr_min.and.kr.lt.kr_min1)then
-           FCCNR_MAR(KR)=FCCNR_MAR(KR_MIN1)* &
-     &      (ALOG(RCCN(KR))-ALOG(RCCN(KR_MIN)))/ &
-     &      (ALOG(RCCN(KR_MIN1))-ALOG(RCCN(KR_MIN)))
 
-        END IF
-        IF (KR.GT.KR_MAX.OR.KR.LT.KR_MIN)FCCNR_MAR(KR)=0
-!          print*,'FCCNR_MAR(KR) = ',KR,FCCNR_MAR(KR)
-        END DO
-! CALCULATION OF FINAL CONTINENTAL
-        RADCCN_MAX=0.6E-4
-        RADCCN_MIN=0.005E-4         
-        RADCCN_MIN1=0.02E-4         
-!       KR_MIN=(ALOG(RADCCN_MIN)-ALOG(RCCN(1)))/(3.*ALOG(2.))+1.
-!       KR_MIN1=(ALOG(RADCCN_MIN1)-ALOG(RCCN(1)))/(3.*ALOG(2.))+1.
-        KR_MIN=1.+ 3*(ALOG(RADCCN_MIN)- ALOG(R0CCN))/ALOG(2.)
-        KR_MIN1=1.+3*(ALOG(RADCCN_MIN1)- ALOG(R0CCN))/ALOG(2.)
-!       KR_MAX=(ALOG(RADCCN_MAX)-ALOG(RCCN(1)))/(3.*ALOG(2.))+1.
-        KR_MAX=1.+3.*(ALOG(RADCCN_MAX)- ALOG(R0CCN))/ALOG(2.)
-        KR_MIN=MAX(KR_MIN,1)
-        KR_MIN1=MAX(KR_MIN,KR_MIN1)
-        KR_MAX=MIN(NKR,KR_MAX)
-!       print*,'contin kr_min,kr_min1 = ',kr_min,kr_min1
-!       print*,'kr_max = ',kr_max
-! Interpolation
-        DO KR=1,NKR
-        IF (kr.ge.kr_min.and.kr.lt.kr_min1)then
-           FCCNR_CON(KR)=FCCNR_CON(KR_MIN1)* &
-     &      (ALOG(RCCN(KR))-ALOG(RCCN(KR_MIN)))/ &
-     &      (ALOG(RCCN(KR_MIN1))-ALOG(RCCN(KR_MIN)))
-        END IF
-        IF (KR.GT.KR_MAX.OR.KR.LT.KR_MIN)FCCNR_CON(KR)=0
-!          print*,'FCCNR_CON(KR) = ',KR,FCCNR_CON(KR)
-        END DO
-! CALCULATION OF MIXTURE
-        DO KR=1,NKR
-         FCCNR_MIX(KR)=FR_CON*FCCNR_CON(KR)+FR_MAR*FCCNR_MAR(KR)
-!        print*,'FCCNR_MIX(KR) = ',FCCNR_MIX(KR)
-        END DO
+	DO K=KMAX,KMIN,-1
+	   DEL_GLW(K) = G(K)*BREAK_SNOW(K)*FL(K)
+	   GLW(K-1) = GLW(K-1)+DEL_GLW(K)
+	   DEL_GRM(K) = G(K)*(1.0D0-FL(K))*RF(K)*BREAK_SNOW(K)
+	   GRM(K-1) = GRM(K-1)+DEL_GRM(K)
+	   G(K-1) = G(K-1)+G(K)*BREAK_SNOW(K)
+	   F(K-1) = G(K-1)/3.0D0/X(K-1)/X(K-1)
+
+   		if (G(k-1) < 1.0d-20) then
+			if(TIN > 273.15)then
+			   	FL(k-1) = 1.0d0
+			   	RF(k-1) = 0.0d0
+			else
+	   			FL(k-1) = 0.0d0
+			   	RF(k-1) = 1.0d0
+			endif
+	   else
+			if(TIN > 273.15)then
+				FL(k-1) = GLW(k-1)/G(k-1)
+				RF(K-1) = 0.0
+			else
+				FL(K-1) = 0.0
+				!print*,'SnowBr',GRM(k-1),G(k-1),FL(k-1)
+				RF(k-1) = GRM(k-1)/G(k-1)/(1.0D0-FL(k-1))
+			endif
+		endif
+
+		 ! FL(K-1)=GLW(K-1)/G(K-1)
+	   ! RF(K-1)=GRM(K-1)/G(K-1)/(1.0D0-FL(K-1))
+
+	   G(K) = G(K)*(1.0D0-BREAK_SNOW(K))
+	   F(K) = G(K)/3.0D0/X(K)/X(K)
+	END DO
 
+	RETURN
+	END SUBROUTINE BreakUp_Snow
+! +------------------------------+
+end module module_mp_SBM_BreakUp
+! +-----------------------------------------------------------------------------+
+! +-----------------------------------------------------------------------------+
+ module module_mp_SBM_Collision
+
+ private
+ public coll_xyy_lwf, coll_xyx_lwf, coll_xxx_lwf, &
+        coll_xyz_lwf, coll_xxy_lwf, &
+        modkrn_KS, coll_breakup_KS, courant_bott_KS
+
+  ! Kind paramater
+  INTEGER, PARAMETER, PRIVATE:: R8SIZE = 8
+  INTEGER, PARAMETER, PRIVATE:: R4SIZE = 4
+  integer,parameter :: kp_flux_max = 44
+  real(kind=r8size), parameter :: G_LIM = 1.0D-16 ! [g/cm^3]
+  integer,parameter :: kr_sgs_max = 20 ! rg(20)=218.88 mkm
+
+ contains
+! +------------------------------------------------+
+subroutine coll_xyy_lwf (gx,gy,flx,fly,ckxy,x,y, &
+						            c,ima,prdkrn,nkr,indc)
+	implicit none
+
+	integer,intent(in) :: nkr
+	real(kind=r8size),intent(inout) :: gy(:),gx(:),fly(:),flx(:)
+	real(kind=r8size),intent(in) :: ckxy(:,:),x(:),y(:),c(:,:)
+	integer,intent(in) :: ima(:,:)
+	real(kind=r8size),intent(in) :: prdkrn
+
+! ... Locals
+ real(kind=r8size) :: gmin,ckxy_ji,x01,x02,x03,gsi,gsj,gsk,gsi_w,gsj_w,gsk_w,gk,gk_w,&
+                      fl_gk,fl_gsk,flux,x1,flux_w,gy_k_w,gy_kp_old,gy_kp_w
+ integer :: j,jx0,jx1,i,iy0,iy1,jmin,indc,k,kp
+! ... Locals
+
+	  gmin = 1.0d-60
+
+! jx0 - lower limit of integration by j
+do j=1,nkr-1
+   jx0=j
+   if(gx(j).gt.gmin) goto 2000
+enddo
+2000   continue
+if(jx0.eq.nkr-1) return
+
+! jx1 - upper limit of integration by j
+do j=nkr-1,jx0,-1
+   jx1=j
+   if(gx(j).gt.gmin) goto 2010
+enddo
+2010   continue
+
+! iy0 - lower limit of integration by i
+do i=1,nkr-1
+   iy0=i
+   if(gy(i).gt.gmin) goto 2001
+enddo
+2001   continue
+if(iy0.eq.nkr-1) return
+
+! iy1 - upper limit of integration by i
+do i=nkr-1,iy0,-1
+   iy1=i
+   if(gy(i).gt.gmin) goto 2011
+enddo
+2011   continue
 
-         CALL BREAKINIT
-!        CALL TWOINITMXVAR
-
-!	PRINT *, '**** MIN CCN RADIUS,MASS & DENSITY ***'
-!	PRINT 200, R0CCN,X0CCN,ROCCN0
-!	PRINT *, '*********  CONT CCN CONCENTRATION & MASS *******'
-!	PRINT 200, CONCCCNIN,CONTCCNIN
-!	PRINT *, '*********  DROP RADII *******'
-!	PRINT 200, DROPRADII
-!	PRINT *, '*********  CCN RADII *******'
-!	PRINT 200, RCCN
-!	PRINT *, '********* CCN MASSES *******'
-!	PRINT 200, XCCN
-!	PRINT *, '********* INITIAL CCN DISTRIBUTION *******'
-        
-     
-
-!	IF(IPRINT01.NE.0) THEN
-
-!  PRINT *, '******** INITIAL: TWC,TWI(ICEMAX),TWS ********'
-!  PRINT 300, TWCIN,TWIIN,TWSIN
-!  PRINT *, '******** INITIAL: CONCLIN ********'
-!  PRINT 300, CONCLIN
-
-! IN CASE : IPRINT01.NE.0
-
-!	ENDIF
-
-  100	FORMAT(10I4)
-  101   FORMAT(3X,F7.5,E13.5)
-  102	FORMAT(4E12.4)
-  105	FORMAT(A48)
-  106	FORMAT(A80)
-  123	FORMAT(3E12.4,3I4)
-  200	FORMAT(6E13.5)
-  201   FORMAT(6D13.5)
-  300	FORMAT(8E14.6) 
-  301   FORMAT(3X,F8.3,3X,E13.5)
-  302   FORMAT(5E13.5)
-!       if (IFREST)THEN
-!       dtime=dt*0.5
-!       else
-!       END IF
-        call kernals(dt)
-! from morr_two_moment
-!..Set these variables needed for computing radar reflectivity.  These
-!.. get used within radar_init to create other variables used in the
-!.. radar module.
-! SIZE DISTRIBUTION PARAMETERS
-         RHOW = 997.
-         RHOI = 500.
-         RHOSN = 100.
-!        IF (IHAIL.EQ.0) THEN
-!        RHOG = 400.
-!        ELSE
-!        RHOG = 900.
-!        END IF
-         RHOG=450
-
-
-         CI = RHOI*PI_MORR/6.
-         DI = 3.
-         CS = RHOSN*PI_MORR/6.
-         DS = 3.
-         CG = RHOG*PI_MORR/6.
-         DG = 3.
-
-
-         xam_r = PI_MORR*RHOW/6.
-         xbm_r = 3.
-         xmu_r = 0.
-         xam_s = CS
-         xbm_s = DS
-         xmu_s = 0.
-         xam_g = CG
-         xbm_g = DG
-         xmu_g = 0.
-
-         call radar_init
-
-        return
-2070  continue
-      WRITE( errmess , '(A,I4)' )                                        &
-       'module_mp_fast_sbm: error opening hujisbm_DATA on unit '          &
-     &, hujisbm_unit1
-      CALL wrf_error_fatal(errmess)
-        end  subroutine fast_hucminit
-      SUBROUTINE BREAKINIT
-      IMPLICIT NONE
-      INTEGER :: hujisbm_unit1
-      LOGICAL, PARAMETER :: PRINT_diag=.FALSE.
-      LOGICAL :: opened 
-      LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
-      CHARACTER*80 errmess
-!.....INPUT VARIABLES
-!
-!     GT    : MASS DISTRIBUTION FUNCTION
-!     XT_MG : MASS OF BIN IN MG
-!     JMAX  : NUMBER OF BINS
+! collisions :
+        do i = iy0,iy1
+           if(gy(i).le.gmin) goto 2020
+           jmin = i
+           if(jmin.eq.nkr-1) return
+           if(i.lt.jx0) jmin=jx0-indc
+            do j=jmin+indc,jx1
+              if(gx(j).le.gmin) goto 2021
+              k=ima(i,j)
+              kp=k+1
+              ckxy_ji=ckxy(j,i)
+              x01=ckxy_ji*gy(i)*gx(j)*prdkrn
+              x02=dmin1(x01,gy(i)*x(j))
+              x03=dmin1(x02,gx(j)*y(i))
+              gsi=x03/x(j)
+              gsj=x03/y(i)
+              gsk=gsi+gsj
+              if(gsk.le.gmin) goto 2021
+              gsi_w=gsi*fly(i)
+              gsj_w=gsj*flx(j)
+              gsk_w=gsi_w+gsj_w
+              gsk_w=dmin1(gsk_w,gsk)
+              gy(i)=gy(i)-gsi
+              gy(i)=dmax1(gy(i),0.0d0)
+              gx(j)=gx(j)-gsj
+              gx(j)=dmax1(gx(j),0.0d0)
+              gk=gy(k)+gsk
+              if(gk.le.gmin) goto 2021
+              gk_w=gy(k)*fly(k)+gsk_w
+              gk_w=dmin1(gk_w,gk)
 
+	            fl_gk=gk_w/gk
 
-!.....LOCAL VARIABLES
+              fl_gsk=gsk_w/gsk
 
-      INTEGER AP,IE,JE,KE
+              flux=0.d0
+              x1=dlog(gy(kp)/gk+1.d-15)
+              flux=gsk/x1*(dexp(0.5d0*x1)-dexp(x1*(0.5d0-c(i,j))))
+              flux=dmin1(flux,gsk)
+              flux=dmin1(flux,gk)
 
-      PARAMETER (AP = 1)
+              if(kp.gt.kp_flux_max) flux=0.5d0*flux
+              flux_w=flux*fl_gsk
+              flux_w=dmin1(flux_w,gsk_w)
+              flux_w=dmin1(flux_w,gk_w)
 
-      INTEGER I,J,K,JDIFF
-      REAL  RPKIJ(JBREAK,JBREAK,JBREAK),RQKJ(JBREAK,JBREAK)
+                gy(k)=gk-flux
+                gy(k)=dmax1(gy(k),gmin)
+                gy_k_w=gk*fl_gk-flux_w
+                gy_k_w=dmin1(gy_k_w,gy(k))
+                gy_k_w=dmax1(gy_k_w,0.0d0)
+                fly(k)=gy_k_w/gy(k)
+                gy_kp_old=gy(kp)
+                gy(kp)=gy(kp)+flux
+                gy(kp)=dmax1(gy(kp),gmin)
+                gy_kp_w=gy_kp_old*fly(kp)+flux_w
+                gy_kp_w=dmin1(gy_kp_w,gy(kp))
+                fly(kp)=gy_kp_w/gy(kp)
 
+                if(fly(k).gt.1.0d0.and.fly(k).le.1.0001d0) &
+                   fly(k)=1.0d0
+                if(fly(kp).gt.1.0d0.and.fly(kp).le.1.0001d0) &
+                   fly(kp)=1.0d0
+                if(fly(k).gt.1.0001d0.or.fly(kp).gt.1.0001d0 &
+                   .or.fly(k).lt.0.0d0.or.fly(kp).lt.0.0d0) then
 
-      REAL PI,D0,HLP
-      DOUBLE PRECISION M(0:JBREAK),ALM
-      REAL DBREAK(JBREAK),GAIN,LOSS
-!     REAL ECOALMASS
-!     REAL XL(JMAX)
+                print*,    'in subroutine coll_xyy_lwf'
 
+                if(fly(k).gt.1.0001d0)  print*, 'fly(k).gt.1.0001d0'
+                if(fly(kp).gt.1.0001d0) print*, 'fly(kp).gt.1.0001d0'
 
-!.....DECLARATIONS FOR INIT
+                if(fly(k).lt.0.0d0)  print*, 'fly(k).lt.0.0d0'
+                if(fly(kp).lt.0.0d0) print*, 'fly(kp).lt.0.0d0'
 
-      INTEGER IP,KP,JP,KQ,JQ
-      REAL XTJ
+                print*,    'i,j,k,kp'
+                print*,     i,j,k,kp
 
-      CHARACTER*20 FILENAME_P,FILENAME_Q
+                print*,    'jx0,jx1,iy0,iy1'
+                print*,     jx0,jx1,iy0,iy1
 
-      FILENAME_P = 'coeff_p.asc'
-      FILENAME_Q = 'coeff_q.asc'
+                print*,   'ckxy(j,i),x01,x02,x03'
+                print 204, ckxy(j,i),x01,x02,x03
 
-      IE = JBREAK
-      JE = JBREAK
-      KE = JBREAK
-      PI    = 3.1415927
-      D0    = 0.0101593
-      M(1)  = PI/6.0 * D0**3
+                print*,   'gsi,gsj,gsk'
+                print 203, gsi,gsj,gsk
 
-!.....IN CGS
+                print*,   'gsi_w,gsj_w,gsk_w'
+                print 203, gsi_w,gsj_w,gsk_w
 
+                print*,   'gk,gk_w'
+                print 202, gk,gk_w
 
-!.....SHIFT BETWEEN COAGULATION AND BREAKUP GRID
+                print*,   'fl_gk,fl_gsk'
+                print 202, fl_gk,fl_gsk
 
-      JDIFF = JMAX - JBREAK
+                print*,   'x1,c(i,j)'
+                print 202, x1,c(i,j)
 
-!.....INITIALIZATION
+                print*,   'flux'
+                print 201, flux
 
-!     IF (FIRSTCALL.NE.1) THEN
+                print*,   'flux_w'
+                print 201, flux_w
 
-!........CALCULATING THE BREAKUP GRID
-!        ALM  = 2.**(1./FLOAT(AP))
-         ALM  = 2.d0
-         M(0)  = M(1)/ALM
-         DO K=1,KE-1
-            M(K+1) = M(K)*ALM
-         ENDDO
-         DO K=1,KE
-            BRKWEIGHT(K) = 2./(M(K)**2 - M(K-1)**2)
-!           print*,'m(k) = ',m(k)
-!           print*,'m(k-1) = ',m(k-1)
-!           print*, 'MWEIGHT = ',BRKWEIGHT(K)
-         ENDDO
+                print*,   'gy_k_w'
+                print 201, gy_k_w
 
-!........OUTPUT
+                print*,   'gy_kp_w'
+                print 201, gy_kp_w
 
-         WRITE (*,*) 'COLL_BREAKUP_INI: COAGULATION AND BREAKUP GRID'
-         WRITE (*,'(2A5,5A15)') 'ICOAG','IBREAK', &
-     &        'XCOAG','DCOAG', &
-     &        'XBREAK','DBREAK','MWEIGHT'
+		            if(fly(k).lt.0.0d0) print*, &
+				            'stop 2022: in subroutine coll_xyy_lwf, fly(k) < 0'
 
-!........READ DER BREAKUP COEFFICIENTS FROM INPUT FILE
+                if(fly(kp).lt.0.0d0) print*, &
+					           'stop 2022: in subroutine coll_xyy_lwf, fly(kp) < 0'
 
-         WRITE (*,*) 'COLL_BREAKUP: READ THE BREAKUP COEFFS'
-         WRITE (*,*) '              FILE PKIJ: ', FILENAME_P
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2061
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2061     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="coeff_p.asc",                  &
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
+                if(fly(k).gt.1.0001d0) print*, &
+					           'stop 2022: in sub. coll_xyy_lwf, fly(k) > 1.0001'
 
-!         print*,'here at 3'
-         DO K=1,KE
-            DO I=1,IE
-               DO J=1,I
-                  READ(hujisbm_unit1,'(3I6,1E16.8)') KP,IP,JP,PKIJ(KP,IP,JP)
-!                 WRITE(6,*)'PKIJ(KP,IP,JP) =', &
-!    &               KP,IP,JP,PKIJ(KP,IP,JP)
-!                 IF(RPKIJ(KP,IP,JP).EQ.0) THEN
-!    *             PKIJ(KP,IP,JP)=INT(RPKIJ(KP,IP,JP))
-!                 ELSE
-!                  PKIJ(KP,IP,JP)=RPKIJ(KP,IP,JP)
-!                 END IF
-!                 WRITE(6,*)'RPKIJ(KP,IP,JP) =',
-!    *               KP,IP,JP,RPKIJ(KP,IP,JP),
-!    *               PKIJ(KP,IP,JP)
-               ENDDO
-            ENDDO
-!           READ(6,*)
-         ENDDO
-	CLOSE(hujisbm_unit1)
-         WRITE (*,*) '              FILE QKJ:  ', FILENAME_Q
-        END IF
-        CALL wrf_dm_bcast_bytes (PKIJ  , size ( PKIJ ) * DWORDSIZE )
-        IF ( wrf_dm_on_monitor() ) THEN
-          DO i = 31,99
-            INQUIRE ( i , OPENED = opened )
-            IF ( .NOT. opened ) THEN
-              hujisbm_unit1 = i
-              GOTO 2062
-            ENDIF
-          ENDDO
-          hujisbm_unit1 = -1
- 2062     CONTINUE
-        ENDIF
-!
-        CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
-!
-        IF ( hujisbm_unit1 < 0 ) THEN
-          CALL wrf_error_fatal ( 'module_mp_fast: etanewinit: Can not find unused fortran unit to read in lookup table.' )
-        ENDIF
-!
-        IF ( wrf_dm_on_monitor() ) THEN
-          OPEN(UNIT=hujisbm_unit1,FILE="coeff_q.asc",                  &
-     &        FORM="FORMATTED",STATUS="OLD",ERR=2070)
+				        if(fly(kp).gt.1.0001d0) print*, &
+					           'stop 2022: in sub. coll_xyy_lwf, fly(kp) > 1.0001'
 
-         DO K=1,KE
-            DO J=1,JE
-               READ(hujisbm_unit1,'(2I6,1E16.8)') KQ,JQ,QKJ(KQ,JQ)
-!              WRITE(6,*) KQ,JQ,QKJ(KQ,JQ)
-!              QKJ(KQ,JQ) = RQKJ(KQ,JQ)
-!              IF(QKJ(KQ,JQ).LE.1E-35)QKJ(KQ,JQ)=0.D0
-            ENDDO
-         ENDDO
-         CLOSE(hujisbm_unit1)
+                     call wrf_error_fatal("in coal_bott coll_xyy_lwf, model stop")
+! in case fly(k).gt.1.0001d0.or.fly(kp).gt.1.0001d0
+!        .or.fly(k).lt.0.0d0.or.fly(kp).lt.0.0d0
+          endif
+ 2021   continue
+       enddo
+! cycle by j
+ 2020   continue
+    enddo
+! cycle by i
+
+ 201    format(1x,d13.5)
+ 202    format(1x,2d13.5)
+ 203    format(1x,3d13.5)
+ 204    format(1x,4d13.5)
+
+  return
+  end subroutine coll_xyy_lwf
+! +-----------------------------------------------------+
+  subroutine coll_xxx_lwf(g,fl,ckxx,x,c,ima,prdkrn,nkr)
+
+    implicit none
+
+    integer,intent(in) :: nkr
+    real(kind=r8size),intent(inout) :: g(:),fl(:)
+    real(kind=r8size),intent(in) ::	ckxx(:,:),x(:), c(:,:)
+    integer,intent(in) :: ima(:,:)
+    real(kind=r8size),intent(in) :: prdkrn
+
+! ... Locals
+   real(kind=r8size):: gmin,x01,x02,x03,gsi,gsj,gsk,gsi_w,gsj_w,gsk_w,gk, &
+                       gk_w,fl_gk,fl_gsk,flux,x1,flux_w,g_k_w,g_kp_old,g_kp_w
+   integer :: i,ix0,ix1,j,k,kp
+! ... Locals
+
+  gmin=g_lim*1.0d3
+
+! ix0 - lower limit of integration by i
+
+  do i=1,nkr-1
+   ix0=i
+   if(g(i).gt.gmin) goto 2000
+  enddo
+  2000   continue
+  if(ix0.eq.nkr-1) return
+
+! ix1 - upper limit of integration by i
+  do i=nkr-1,1,-1
+   ix1=i
+   if(g(i).gt.gmin) goto 2010
+  enddo
+  2010   continue
+
+! ... collisions
+      do i=ix0,ix1
+         if(g(i).le.gmin) goto 2020
+         do j=i,ix1
+            if(g(j).le.gmin) goto 2021
+            k=ima(i,j)
+            kp=k+1
+            x01=ckxx(i,j)*g(i)*g(j)*prdkrn
+            x02=dmin1(x01,g(i)*x(j))
+            if(j.ne.k) x03=dmin1(x02,g(j)*x(i))
+            if(j.eq.k) x03=x02
+            gsi=x03/x(j)
+            gsj=x03/x(i)
+            gsk=gsi+gsj
+            if(gsk.le.gmin) goto 2021
+            gsi_w=gsi*fl(i)
+            gsj_w=gsj*fl(j)
+            gsk_w=gsi_w+gsj_w
+            gsk_w=dmin1(gsk_w,gsk)
+            g(i)=g(i)-gsi
+            g(i)=dmax1(g(i),0.0d0)
+            g(j)=g(j)-gsj
+  ! new change of 23.01.11                                      (start)
+            if(j.ne.k) g(j)=dmax1(g(j),0.0d0)
+  ! new change of 23.01.11                                        (end)
+            gk=g(k)+gsk
+
+            if(g(j).lt.0.d0.and.gk.le.gmin) then
+              g(j)=0.d0
+              g(k)=g(k)+gsi
+              goto 2021
+          endif
 
-         WRITE (*,*) 'COLL_BREAKUP READ: ... OK'
-         END IF
-        CALL wrf_dm_bcast_bytes (QKJ  , size ( QKJ ) * DWORDSIZE )
-!     ENDIF
-!        DO K=1,KE
-!           DO J=1,JE
-!              WRITE(6,*) 'After Broadcast, QKJ = ',K,J,QKJ(K,J)
-!           ENDDO
-!        ENDDO
-!        DO K=1,KE
-!           DO I=1,IE
-!              DO J=1,I
-!                 WRITE(6,*)'After Broadcast PKIJ(K,I,J) =', &
-!    &               K,I,J,PKIJ(K,I,J)
-!              ENDDO
-!           ENDDO
-!        ENDDO
-      DO I=1,JMAX
-         DO J=1,JMAX
-              ECOALMASSM(I,J)=1.0D0
-         ENDDO
-      ENDDO
+            if(gk.le.gmin) goto 2021
+
+            gk_w=g(k)*fl(k)+gsk_w
+            gk_w=dmin1(gk_w,gk)
+
+            fl_gk=gk_w/gk
+            fl_gsk=gsk_w/gsk
+            flux=0.d0
+            x1=dlog(g(kp)/gk+1.d-15)
+            flux=gsk/x1*(dexp(0.5d0*x1)-dexp(x1*(0.5d0-c(i,j))))
+            flux=dmin1(flux,gsk)
+            flux=dmin1(flux,gk)
+            if(kp.gt.kp_flux_max) flux=0.5d0*flux
+            flux_w=flux*fl_gsk
+            flux_w=dmin1(flux_w,gsk_w)
+            flux_w=dmin1(flux_w,gk_w)
+            g(k)=gk-flux
+            g(k)=dmax1(g(k),gmin)
+            g_k_w=gk_w-flux_w
+            g_k_w=dmin1(g_k_w,g(k))
+            g_k_w=dmax1(g_k_w,0.0d0)
+            fl(k)=g_k_w/g(k)
+            g_kp_old=g(kp)
+            g(kp)=g(kp)+flux
+            g(kp)=dmax1(g(kp),gmin)
+            g_kp_w=g_kp_old*fl(kp)+flux_w
+            g_kp_w=dmin1(g_kp_w,g(kp))
+            fl(kp)=g_kp_w/g(kp)
+
+            if(fl(k).gt.1.0d0.and.fl(k).le.1.0001d0) &
+                fl(k)=1.0d0
+
+            if(fl(kp).gt.1.0d0.and.fl(kp).le.1.0001d0) &
+                fl(kp)=1.0d0
+
+            if(fl(k).gt.1.0001d0.or.fl(kp).gt.1.0001d0 &
+               .or.fl(k).lt.0.0d0.or.fl(kp).lt.0.0d0) then
+
+              print*,    'in subroutine coll_xxx_lwf'
+              print*,    'snow - snow = snow'
+
+              if(fl(k).gt.1.0001d0)  print*, 'fl(k).gt.1.0001d0'
+              if(fl(kp).gt.1.0001d0) print*, 'fl(kp).gt.1.0001d0'
+
+              if(fl(k).lt.0.0d0)  print*, 'fl(k).lt.0.0d0'
+              if(fl(kp).lt.0.0d0) print*, 'fl(kp).lt.0.0d0'
+
+              print*,    'i,j,k,kp'
+              print*,     i,j,k,kp
+              print*,    'ix0,ix1'
+              print*,     ix0,ix1
+
+              print*,   'ckxx(i,j),x01,x02,x03'
+                print 204, ckxx(i,j),x01,x02,x03
+
+              print*,   'gsi,gsj,gsk'
+                print 203, gsi,gsj,gsk
+
+              print*,   'gsi_w,gsj_w,gsk_w'
+                print 203, gsi_w,gsj_w,gsk_w
+
+              print*,   'gk,gk_w'
+                print 202, gk,gk_w
+
+              print*,   'fl_gk,fl_gsk'
+                print 202, fl_gk,fl_gsk
+
+              print*,   'x1,c(i,j)'
+                print 202, x1,c(i,j)
+
+              print*,   'flux'
+                print 201, flux
+
+              print*,   'flux_w'
+                print 201, flux_w
+
+              print*,   'g_k_w'
+                print 201, g_k_w
+
+                print *,  'g_kp_w'
+                print 201, g_kp_w
+
+              if(fl(k).lt.0.0d0) print*, &
+                 'stop 2022: in subroutine coll_xxx_lwf, fl(k) < 0'
+
+              if(fl(kp).lt.0.0d0) print*, &
+                 'stop 2022: in subroutine coll_xxx_lwf, fl(kp) < 0'
+
+              if(fl(k).gt.1.0001d0) print*, &
+                 'stop 2022: in sub. coll_xxx_lwf, fl(k) > 1.0001'
+
+              if(fl(kp).gt.1.0001d0) print*, &
+                 'stop 2022: in sub. coll_xxx_lwf, fl(kp) > 1.0001'
+                    call wrf_error_fatal("in coal_bott sub. coll_xxx_lwf, model stop")
+              endif
+2021     continue
+       enddo
+! cycle by j
+2020    continue
+   enddo
+! cycle by i
+
+201    format(1x,d13.5)
+202    format(1x,2d13.5)
+203    format(1x,3d13.5)
+204    format(1x,4d13.5)
+
+ return
+ end subroutine coll_xxx_lwf
+! +----------------------------------------------------+
+ subroutine coll_xyx_lwf (gx,gy,flx,fly,ckxy,x,y, &
+					               c,ima,prdkrn,nkr,indc,dm_rime)
+	implicit none
+
+	integer,intent(in) :: nkr
+	real(kind=r8size),intent(inout) :: gy(:),gx(:),fly(:),flx(:),dm_rime(:)
+	real(kind=r8size),intent(in) :: ckxy(:,:),x(:),y(:),c(:,:),prdkrn
+	integer,intent(in) :: ima(:,:)
+
+! ... Locals
+	real(kind=r8size) :: gmin,x01,x02,x03,gsi,gsj,gsk,gk,flux,x1,gsi_w,gsj_w,gsk_w, &
+    	                gk_w,fl_gk,fl_gsk,flux_w,gx_k_w,gx_kp_old,gx_kp_w,frac_split
+	integer :: j, jx0, jx1, i, iy0, iy1, jmin, indc, k, kp
+! ... Locals
+
+	gmin=g_lim*1.0d3
+
+! jx0 - lower limit of integration by j
+        do j=1,nkr-1
+           jx0=j
+           if(gx(j).gt.gmin) goto 2000
+        end do
+ 2000   continue
+        if(jx0.eq.nkr-1) return
+! jx1 - upper limit of integration by j
+        do j=nkr-1,jx0,-1
+           jx1=j
+           if(gx(j).gt.gmin) goto 2010
+        end do
+ 2010   continue
+! iy0 - lower limit of integration by i
+        do i=1,nkr-1
+           iy0=i
+           if(gy(i).gt.gmin) goto 2001
+        end do
+ 2001   continue
+        if(iy0.eq.nkr-1) return
+! iy1 - upper limit of integration by i
+        do i=nkr-1,iy0,-1
+           iy1=i
+           if(gy(i).gt.gmin) goto 2011
+        end do
+ 2011   continue
+
+	 do i = 1,nkr
+	   dm_rime(i)=0.0
+	 end do
+
+! ... collisions :
+        do i=iy0,iy1
+           if(gy(i).le.gmin) goto 2020
+           jmin=i
+           if(jmin.eq.nkr-1) return
+           if(i.lt.jx0) jmin=jx0-indc
+	   		do j=jmin+indc,jx1
+              if(gx(j).le.gmin) goto 2021
+              k=ima(i,j)
+              kp=k+1
+              x01=ckxy(j,i)*gy(i)*gx(j)*prdkrn
+              x02=dmin1(x01,gy(i)*x(j))
+			! new change of 20.01.11                                      (start)
+              if(j.ne.k) x03=dmin1(x02,gx(j)*y(i))
+              if(j.eq.k) x03=x02
+			! new change of 20.01.11                                        (end)
+              gsi=x03/x(j)
+              gsj=x03/y(i)
+              gsk=gsi+gsj
+			        if(gsk.le.gmin) goto 2021
+              gsi_w=gsi*fly(i)
+              gsj_w=gsj*flx(j)
+              gsk_w=gsi_w+gsj_w
+			        gsk_w=dmin1(gsk_w,gsk)
+              gy(i)=gy(i)-gsi
+              gy(i)=dmax1(gy(i),0.0d0)
+              gx(j)=gx(j)-gsj
+			! new change of 20.01.11                                      (start)
+              if(j.ne.k) gx(j)=dmax1(gx(j),0.0d0)
+			! new change of 20.01.11                                        (end)
+              gk=gx(k)+gsk
+              if(gk.le.gmin) goto 2021
+              gk_w=gx(k)*flx(k)+gsk_w
+			        gk_w=dmin1(gk_w,gk)
+	            fl_gk=gk_w/gk
+              fl_gsk=gsk_w/gsk
+              flux=0.d0
+              x1=dlog(gx(kp)/gk+1.d-15)
+              flux=gsk/x1*(dexp(0.5d0*x1)-dexp(x1*(0.5d0-c(i,j))))
+              flux=dmin1(flux,gsk)
+              flux=dmin1(flux,gk)
 
-      DO I=1,JMAX
-         DO J=1,JMAX
-           ECOALMASSM(I,J)=ECOALMASS(XL(I),XL(J))
-         ENDDO
-      ENDDO
-      RETURN
-2070  continue
-      WRITE( errmess , '(A,I4)' )                                        &
-       'module_mp_fast: error opening hujisbm_DATA on unit '          &
-     &, hujisbm_unit1
-      CALL wrf_error_fatal(errmess)
-      END SUBROUTINE BREAKINIT
+              if(kp.gt.kp_flux_max) flux=0.5d0*flux
+              flux_w=flux*fl_gsk
+              flux_w=dmin1(flux_w,gsk_w)
+              flux_w=dmin1(flux_w,gk_w)
+			        frac_split = flux/gsk
+              if(frac_split < 0.) frac_split = 0.
+	            if(frac_split > 1.) frac_split = 1.
+              dm_rime(k)=dm_rime(k)+gsi*(1.-frac_split)
+              dm_rime(kp)=dm_rime(kp)+gsi*frac_split
+              gx(k)=gk-flux
+	            gx(k)=dmax1(gx(k),gmin)
 
-      REAL FUNCTION ECOALMASS(ETA,KSI)
-      IMPLICIT NONE
-!     REAL ECOALMASS
-      REAL PI
-      PARAMETER (PI = 3.1415927)
+              gx_k_w=gk_w-flux_w
+              gx_k_w=dmin1(gx_k_w,gx(k))
+              gx_k_w=dmax1(gx_k_w,0.0d0)
+              flx(k)=gx_k_w/gx(k)
+              gx_kp_old=gx(kp)
+              gx(kp)=gx(kp)+flux
+              gx(kp)=dmax1(gx(kp),gmin)
 
-      REAL ETA,KSI
-      REAL KPI,RHO
-      REAL DETA,DKSI
+              gx_kp_w=gx_kp_old*flx(kp)+flux_w
+              gx_kp_w=dmin1(gx_kp_w,gx(kp))
 
-      PARAMETER (RHO  = 1.0)
+              flx(kp)=gx_kp_w/gx(kp)
 
-!     REAL ECOALDIAM
-!     EXTERNAL ECOALDIAM
+              if(flx(k).gt.1.0d0.and.flx(k).le.1.0001d0) &
+              flx(k)=1.0d0
 
-      KPI = 6./PI
+              if(flx(kp).gt.1.0d0.and.flx(kp).le.1.0001d0) &
+              	flx(kp)=1.0d0
 
-      DETA = (KPI*ETA/RHO)**(1./3.)
-      DKSI = (KPI*KSI/RHO)**(1./3.)
+              if(flx(k).gt.1.0001d0.or.flx(kp).gt.1.0001d0 &
+              .or.flx(k).lt.0.0d0.or.flx(kp).lt.0.0d0) then
 
-      ECOALMASS = ECOALDIAM(DETA,DKSI)
+              print*, 'in subroutine coll_xyx_lwf'
 
-      RETURN
-      END FUNCTION ECOALMASS
+              if(flx(k).gt.1.0001d0) &
+              print*, 'flx(k).gt.1.0001d0'
 
+              if(flx(kp).gt.1.0001d0) &
+              print*, 'flx(kp).gt.1.0001d0'
 
-!------------------------------------------------
-!     COALESCENCE EFFICIENCY AS FUNC OF DIAMETERS
-!------------------------------------------------
+              if(flx(k).lt.0.0d0)  print*, 'flx(k).lt.0.0d0'
+              if(flx(kp).lt.0.0d0) print*, 'flx(kp).lt.0.0d0'
 
-      REAL FUNCTION ECOALDIAM(DETA,DKSI)
-!     IMPLICIT NONE
+                print*,   'i,j,k,kp'
+                print*,    i,j,k,kp
 
-      INTEGER N
-      REAL DETA,DKSI
-      REAL DGR,DKL,RGR,RKL,P,Q,E,X,Y,QMIN,QMAX
-      REAL ZERO,ONE,EPS,PI
+                print*,   'jx0,jx1,iy0,iy1'
+                print*,    jx0,jx1,iy0,iy1
 
-      PARAMETER (ZERO = 0.0)
-      PARAMETER (ONE  = 1.0)
-      PARAMETER (EPS  = 1.0E-30)
-      PARAMETER (PI   = 3.1415927)
+                print*,   'gx_kp_old'
+                	print 201, gx_kp_old
 
-!     REAL   ECOALLOWLIST,ECOALOCHS
-!     EXTERNAL ECOALLOWLIST,ECOALOCHS
+                print*,   'ckxy(j,i),x01,x02,x03'
+                	print 204, ckxy(j,i),x01,x02,x03
 
-      DGR = MAX(DETA,DKSI)
-      DKL = MIN(DETA,DKSI)
+                print*,   'gsi,gsj,gsk'
+                	print 203, gsi,gsj,gsk
 
-      RGR = 0.5*DGR
-      RKL = 0.5*DKL
+                print*,   'gsi_w,gsj_w,gsk_w'
+                	print 203, gsi_w,gsj_w,gsk_w
 
-      P = (RKL / RGR)
-      Q = (RKL * RGR)**0.5
-      Q = 0.5 * (RKL + RGR)
+                print*,   'gk,gk_w'
+                	print 202, gk,gk_w
 
-      qmin = 250e-4
-      qmax = 400e-4        
-      if (q.lt.qmin) then
-         e = max(ecoalOchs(Dgr,Dkl),ecoalBeard(Dgr,Dkl)) 
-      elseif (q.ge.qmin.and.q.lt.qmax) then
-         x = (q - qmin) / (qmax - qmin)
-         e = sin(pi/2.0*x)**2 * ecoalLowList(Dgr,Dkl) &
-     &     + sin(pi/2.0*(1 - x))**2 * ecoalOchs(Dgr,Dkl)
-      elseif (q.ge.qmax) then
-         e = ecoalLowList(Dgr,Dkl)
-      else
-         e  = 1.0
-      endif
+                print*,   'fl_gk,fl_gsk'
+                	print 202, fl_gk,fl_gsk
 
-      ECOALDIAM  = MAX(MIN(ONE,E),EPS)
+                print*,   'x1,c(i,j)'
+                	print 202, x1,c(i,j)
 
-      RETURN
-      END FUNCTION  ECOALDIAM
+                print*,   'flux'
+                	print 201, flux
 
-!--------------------------------------------------
-!     COALESCENCE EFFICIENCY (LOW&LIST)
-!--------------------------------------------------
+                print*,   'flux_w'
+                	print 201, flux_w
 
-      REAL FUNCTION ECOALLOWLIST(DGR,DKL)
-      IMPLICIT NONE
-!     REAL ecoallowlist
-      REAL PI,SIGMA,KA,KB,EPSI
-      REAL DGR,DKL,RGR,RKL,X
-      REAL ST,SC,ET,DSTSC,CKE,W1,W2,DC,ECL
-      REAL QQ0,QQ1,QQ2
-
-      PARAMETER (EPSI=1.E-20)
-
-      PI = 3.1415927
-      SIGMA = 72.8
-      KA = 0.778
-      KB = 2.61E-4
-
-      RGR = 0.5*DGR
-      RKL = 0.5*DKL
-
-      CALL COLLENERGY(DGR,DKL,CKE,ST,SC,W1,W2,DC)
-
-      DSTSC = ST-SC
-      ET = CKE+DSTSC
-      IF (ET .LT. 50.0) THEN
-         QQ0=1.0+(DKL/DGR)
-         QQ1=KA/QQ0**2
-         QQ2=KB*SIGMA*(ET**2)/(SC+EPSI)
-         ECL=QQ1*EXP(-QQ2)
-      ELSE
-         ECL=0.0
-      ENDIF
+                print*,   'gx_k_w'
+                	print 201, gx_k_w
 
-      ECOALLOWLIST = ECL
+                print*,   'gx_kp_w'
+                	print 201, gx_kp_w
 
-      RETURN
-      END FUNCTION ECOALLOWLIST
+        				if(flx(k).lt.0.0d0) print*, &
+        					   'stop 2022: in subroutine coll_xyx_lwf, flx(k) < 0'
 
-!--------------------------------------------------
-!     COALESCENCE EFFICIENCY (BEARD AND OCHS)
-!--------------------------------------------------
+        				if(flx(kp).lt.0.0d0) print*, &
+        					   'stop 2022: in subroutine coll_xyx_lwf, flx(kp) < 0'
 
-      REAL FUNCTION ECOALOCHS(D_L,D_S)
-      IMPLICIT NONE
-!     real ecoalochs
-      REAL D_L,D_S
-      REAL PI,SIGMA,N_W,R_S,R_L,DV,P,G,X,E
-!      REAL VTBEARD,EPSF,FPMIN
-      REAL EPSF,FPMIN
+        				if(flx(k).gt.1.0001d0) print*, &
+        					   'stop 2022: in sub. coll_xyx_lwf, flx(k) > 1.0001'
 
-!     EXTERNAL VTBEARD
-      PARAMETER (EPSF  = 1.E-30)
-      PARAMETER (FPMIN = 1.E-30)
+        				if(flx(kp).gt.1.0001d0) print*, &
+        					   'stop 2022: in sub. coll_xyx_lwf, flx(kp) > 1.0001'
+                  call wrf_error_fatal("fatal error in module_mp_fast_sbm in coll_xyx_lwf (stop 2022), model stop")
+                  stop 2022
+               endif
+ 2021         continue
+           enddo
+! cycle by j
+ 2020      continue
+        enddo
+! cycle by i
+
+ 201    format(1x,d13.5)
+ 202    format(1x,2d13.5)
+ 203    format(1x,3d13.5)
+ 204    format(1x,4d13.5)
+
+ return
+ end subroutine coll_xyx_lwf
+! -------------------------------------------------------+
+ subroutine coll_xyz_lwf(gx,gy,gz,flx,fly,flz,ckxy,x,y, &
+                        c,ima,prdkrn,nkr,indc)
+
+ implicit none
+
+ integer,intent(in) :: nkr
+ real(kind=r8size),intent(inout) :: gx(:),gy(:),gz(:),flx(:),fly(:),flz(:)
+ real(kind=r8size),intent(in) :: ckxy(:,:),x(:),y(:),c(:,:)
+ integer,intent(in) :: ima(:,:)
+ real(kind=r8size),intent(in) :: prdkrn
+
+! ... Locals
+ real(kind=r8size) :: gmin,ckxy_ji,x01,x02,x03,gsi,gsj,gsk,gsi_w,gsj_w,gsk_w,gk, &
+                      gk_w,fl_gk,fl_gsk,flux,x1,flux_w,gz_k_w,gz_kp_old,gz_kp_w
+integer :: j,jx0,jx1,i,iy0,iy1,jmin,indc,k,kp
+! ... Locals
+
+gmin = 1.0d-60
+
+! jx0 - lower limit of integration by j
+do j=1,nkr-1
+ jx0=j
+ if(gx(j).gt.gmin) goto 2000
+enddo
+2000   continue
+if(jx0.eq.nkr-1) return
+
+! jx1 - upper limit of integration by j
+do j=nkr-1,jx0,-1
+ jx1=j
+ if(gx(j).gt.gmin) goto 2010
+enddo
+2010   continue
+
+! iy0 - lower limit of integration by i
+do i=1,nkr-1
+ iy0=i
+ if(gy(i).gt.gmin) goto 2001
+enddo
+2001   continue
+if(iy0.eq.nkr-1) return
 
-      PI = 3.1415927
-      SIGMA = 72.8
+! iy1 - upper limit of integration by i
+do i=nkr-1,iy0,-1
+ iy1=i
+ if(gy(i).gt.gmin) goto 2011
+enddo
+2011   continue
 
-      R_S = 0.5 * D_S
-      R_L = 0.5 * D_L
-      P   = R_S / R_L
+! ... collisions
 
-      DV  = ABS(VTBEARD(D_L) - VTBEARD(D_S))
-      IF (DV.LT.FPMIN) DV = FPMIN
-      N_W = R_S * DV**2 / SIGMA
-      G   = 2**(3./2.)/(6.*PI) * P**4 * (1.+ P) / ((1.+P**2)*(1.+P**3))
-      X   = N_W**(0.5) * G
-      E   = 0.767 - 10.14 * X
+      do i=iy0,iy1
+         if(gy(i).le.gmin) goto 2020
+         jmin=i
+         if(jmin.eq.nkr-1) return
+         if(i.lt.jx0) jmin=jx0-indc
+         do j=jmin+indc,jx1
+            if(gx(j).le.gmin) goto 2021
+            k=ima(i,j)
+            kp=k+1
+            ckxy_ji=ckxy(j,i)
+            x01=ckxy_ji*gy(i)*gx(j)*prdkrn
+            x02=dmin1(x01,gy(i)*x(j))
+            x03=dmin1(x02,gx(j)*y(i))
+            gsi=x03/x(j)
+            gsj=x03/y(i)
+            gsk=gsi+gsj
+            if(gsk.le.gmin) goto 2021
+            gsi_w=gsi*fly(i)
+            gsj_w=gsj*flx(j)
+            gsk_w=gsi_w+gsj_w
+            gsk_w=dmin1(gsk_w,gsk)
+            gy(i)=gy(i)-gsi
+            gy(i)=dmax1(gy(i),0.0d0)
 
-      ECOALOCHS = E
+            gx(j)=gx(j)-gsj
+            gx(j)=dmax1(gx(j),0.0d0)
 
-      RETURN
-      END FUNCTION ECOALOCHS
+            gk=gz(k)+gsk
 
-!-----------------------------------------
-!     CALCULATING THE COLLISION ENERGY
-!-----------------------------------------
+            if(gk.le.gmin) goto 2021
 
-      SUBROUTINE COLLENERGY(DGR,DKL,CKE,ST,SC,W1,W2,DC)
-!     IMPLICIT NONE
+            gk_w=gz(k)*flz(k)+gsk_w
+            gk_w=dmin1(gk_w,gk)
 
-      REAL DGR,DKL,DC
-      REAL K10,PI,SIGMA,RHO
-      REAL CKE,W1,W2,ST,SC
-      REAL DGKA3,DGKB3,DGKA2
-      REAL V1,V2,DV
-!     REAL VTBEARD,EPSF,FPMIN
-      REAL EPSF,FPMIN
+            fl_gk=gk_w/gk
 
-!     EXTERNAL VTBEARD
-      PARAMETER (EPSF  = 1.E-30)
-      PARAMETER (FPMIN = 1.E-30)
+            fl_gsk=gsk_w/gsk
 
-      PI    = 3.1415927
-      RHO   = 1.0
-      SIGMA = 72.8
+            flux=0.d0
 
-      K10=RHO*PI/12.0D0
+            x1=dlog(gz(kp)/gk+1.d-15)
 
-      DGR = MAX(DGR,EPSF)
-      DKL = MAX(DKL,EPSF)
+            flux=gsk/x1*(dexp(0.5d0*x1)-dexp(x1*(0.5d0-c(i,j))))
+            flux=dmin1(flux,gsk)
+            flux=dmin1(flux,gk)
 
-      DGKA2=(DGR**2)+(DKL**2)
+            if(kp.gt.kp_flux_max) flux=0.5d0*flux
 
-      DGKA3=(DGR**3)+(DKL**3)
+            flux_w=flux*fl_gsk
+            flux_w=dmin1(flux_w,gsk_w)
+            flux_w=dmin1(flux_w,gk_w)
 
-      IF (DGR.NE.DKL) THEN
-         V1 = VTBEARD(DGR)
-         V2 = VTBEARD(DKL)
-         DV = (V1-V2)
-         IF (DV.LT.FPMIN) DV = FPMIN
-         DV = DV**2
-         IF (DV.LT.FPMIN) DV = FPMIN
-         DGKB3=(DGR**3)*(DKL**3)
-         CKE = K10 * DV * DGKB3/DGKA3
-      ELSE
-         CKE = 0.0D0
-      ENDIF
-      ST = PI*SIGMA*DGKA2
-      SC = PI*SIGMA*DGKA3**(2./3.)
+            gz(k)=gk-flux
+            gz(k)=dmax1(gz(k),gmin)
 
-      W1=CKE/(SC+EPSF)
-      W2=CKE/(ST+EPSF)
+            gz_k_w=gk*fl_gk-flux_w
+            gz_k_w=dmin1(gz_k_w,gz(k))
+            gz_k_w=dmax1(gz_k_w,0.0d0)
 
-      DC=DGKA3**(1./3.)
+            flz(k)=gz_k_w/gz(k)
 
-      RETURN
-      END SUBROUTINE COLLENERGY
+            gz_kp_old=gz(kp)
 
-!--------------------------------------------------
-!     CALCULATING TERMINAL VELOCITY (BEARD-FORMULA)
-!--------------------------------------------------
+            gz(kp)=gz(kp)+flux
+            gz(kp)=dmax1(gz(kp),gmin)
 
-      REAL FUNCTION VTBEARD(DIAM)
-      IMPLICIT NONE
-!     REAL VTBEARD
-
-      REAL DIAM,AA
-      REAL ROP,RU,AMT,PP,RL,TT,ETA,DENS,CD,D,A
-      REAL ALA,GR,SI,BOND,PART,XX,YY,RE,VT
-      REAL B00,B11,B22,B33,B44,B55,B0,B1,B2,B3,B4,B5,B6
-      INTEGER ID
-
-      DATA B00,B11,B22,B33,B44,B55,B0,B1,B2,B3,B4,B5,B6/-5.00015, &
-     &5.23778,-2.04914,.475294,-.0542819,.00238449,-3.18657,.992696, &
-     &-.153193E-2,-.987059E-3,-.578878E-3,.855176E-4,-.327815E-5/
-
-      AA   = DIAM/2.0
-      ROP  = 1.0
-      RU   = 8.3144E+7
-      AMT  = 28.9644
-      ID   = 10000
-      PP   = FLOAT(ID)*100.
-      RL   = RU/AMT
-      TT   = 283.15
-      ETA  = (1.718+.0049*(TT-273.15))*1.E-4
-      DENS = PP/TT/RL
-      ALA  = 6.6E-6*1.01325E+6/PP*TT/293.15
-      GR   = 979.69
-      SI   = 76.1-.155*(TT-273.15)
-
-      IF (AA.GT.500.E-4) THEN
-         BOND = GR*(ROP-DENS)*AA*AA/SI
-         PART = (SI**3*DENS*DENS/(ETA**4*GR*(ROP-DENS)))**(1./6.)
-         XX = LOG(16./3.*BOND*PART)
-         YY = B00+B11*XX+B22*XX*XX+B33*XX**3+B44*XX**4+B55*XX**5
-         RE = PART*EXP(YY)
-         VT = ETA*RE/2./DENS/AA
-      ELSEIF (AA.GT.1.E-3) THEN
-         CD = 32.*AA*AA*AA*(ROP-DENS)*DENS*GR/3./ETA/ETA
-         XX = LOG(CD)
-         RE = EXP(B0+B1*XX+B2*XX*XX+B3*XX**3+B4*XX**4+B5*XX**5+B6*XX**6)
-         D  = CD/RE/24.-1.
-         VT = ETA*RE/2./DENS/AA
-      ELSE
-         A  = 1.+1.26*ALA/AA
-         A  = A*2.*AA*AA*GR*(ROP-DENS)/9./ETA
-         CD = 12*ETA/A/AA/DENS
-         VT = A
-      ENDIF
+            gz_kp_w=gz_kp_old*flz(kp)+flux_w
+            gz_kp_w=dmin1(gz_kp_w,gz(kp))
 
-      VTBEARD = VT
+            flz(kp)=gz_kp_w/gz(kp)
 
-      RETURN
-      END FUNCTION VTBEARD
-
-
-      
-!-------------------------------------------------- 
-!     Function f. Coalescence-Efficiency 
-!     Eq. (7) of Beard and Ochs (1995)
-!--------------------------------------------------      
- 
-      REAL FUNCTION ecoalBeard(D_l,D_s) 
-       
-      IMPLICIT NONE 
-!     REAL ecoalBeard
-!     REAL ECOALMASS
-      REAL            D_l,D_s
-      REAL            R_s,R_l
-      REAL            rcoeff
-      REAL epsf
-      PARAMETER (epsf  = 1.e-30) 
-
-      INTEGER its
-      COMPLEX acoeff(4),x
-
-      R_s = 0.5 * D_s
-      R_l = 0.5 * D_l      
-
-      rcoeff = 5.07 - log(R_s*1e4) - log(R_l*1e4/200.0)
-
-      acoeff(1) = CMPLX(rcoeff)
-      acoeff(2) = CMPLX(-5.94)
-      acoeff(3) = CMPLX(+7.27)
-      acoeff(4) = CMPLX(-5.29)
-
-      x = (0.50,0)
-
-      CALL LAGUER(acoeff,3,x,its)
-
-      EcoalBeard = REAL(x)
-
-      RETURN 
-      END FUNCTION ecoalBeard 
-
-!--------------------------------------------------       
-
-      SUBROUTINE laguer(a,m,x,its)
-      INTEGER m,its,MAXIT,MR,MT
-      REAL EPSS
-      COMPLEX a(m+1),x
-      PARAMETER (EPSS=2.e-7,MR=8,MT=10,MAXIT=MT*MR)
-      INTEGER iter,j
-      REAL abx,abp,abm,err,frac(MR)
-      COMPLEX dx,x1,b,d,f,g,h,sq,gp,gm,g2
-      SAVE frac
-      DATA frac /.5,.25,.75,.13,.38,.62,.88,1./
-      do 12 iter=1,MAXIT
-        its=iter
-        b=a(m+1)
-        err=abs(b)
-        d=cmplx(0.,0.)
-        f=cmplx(0.,0.)
-        abx=abs(x)
-        do 11 j=m,1,-1
-          f=x*f+d
-          d=x*d+b
-          b=x*b+a(j)
-          err=abs(b)+abx*err
-11      continue
-        err=EPSS*err
-        if(abs(b).le.err) then
-          return
-        else
-          g=d/b
-          g2=g*g
-          h=g2-2.*f/b
-          sq=sqrt((m-1)*(m*h-g2))
-          gp=g+sq
-          gm=g-sq
-          abp=abs(gp)
-          abm=abs(gm)
-          if(abp.lt.abm) gp=gm
-          if (max(abp,abm).gt.0.) then
-            dx=m/gp
-          else
-            dx=exp(cmplx(log(1.+abx),float(iter)))
-          endif
-        endif
-        x1=x-dx
-        if(x.eq.x1)return
-        if (mod(iter,MT).ne.0) then
-          x=x1
-        else
-          x=x-dx*frac(iter/MT)
-        endif
-12    continue
-      pause 'too many iterations in laguer'
-      return
-      END SUBROUTINE laguer
-
-
-
-
-      subroutine courant_bott
-      implicit none
-      integer k,kk,j,i
-      double precision x0
-! ima(i,j) - k-category number,
-! chucm(i,j)   - courant number :
-! logarithmic grid distance(dlnr) :
-
-
-!================================================================
-! BARRY     
-!     print*,'dlnr in courant_bott = ',dlnr
-      xl_mg(0)=xl_mg(1)/2
-! BARRY
-      do i=1,nkr
-         do j=i,nkr
-            x0=xl_mg(i)+xl_mg(j)
-            do k=j,nkr
-               kk=k
-               if (k.eq.1)then
-!                  print*,'xl_mg(k) = ',xl_mg(k)
-!                  print*,'x0 = ',x0
-! xl_mg(k) =   3.351000000000000E-008
-!  x0 =   6.702000000000000E-008
-!		   read (6,*)
-               end if
-               if(xl_mg(k).ge.x0.and.xl_mg(k-1).lt.x0) then
-                 chucm(i,j)=dlog(x0/xl_mg(k-1))/(3.d0*dlnr)
- 102             continue
-                 if(chucm(i,j).gt.1.-1.d-08) then
-                   chucm(i,j)=0.
-                   kk=kk+1
-                 endif
-                 ima(i,j)=min(nkr-1,kk-1)
+            if(flz(k).gt.1.0d0.and.flz(k).le.1.0001d0) &
+            flz(k)=1.0d0
 
-                 goto 2000
-               endif
-            enddo
- 2000       continue
-!            if(i.eq.nkr.or.j.eq.nkr) ima(i,j)=nkr
-            chucm(j,i)=chucm(i,j)
-            ima(j,i)=ima(i,j)
-         enddo
-      enddo
-      return
-      end subroutine courant_bott
+            if(flz(kp).gt.1.0d0.and.flz(kp).le.1.0001d0) &
+            flz(kp)=1.0d0
 
+            if(flz(k).gt.1.0001d0.or.flz(kp).gt.1.0001d0 &
+            .or.flz(k).lt.0.0d0.or.flz(kp).lt.0.0d0) then
 
-      SUBROUTINE KERNALS(DTIME)
-! KHAIN30/07/99
-      IMPLICIT NONE
-      INTEGER I,J
-      REAL PI
-!******************************************************************
-      data pi/3.141592654/
-! dtime - timestep of integration (calculated in main program) :
-! dlnr - logarithmic grid distance
-! ima(i,j) - k-category number, c(i,j) - courant number 
-! cw*(i,j) (in cm**3) - multiply help kernel with constant 
-! timestep(dt) and logarithmic grid distance(dlnr) :
-        REAL DTIME
-! logarithmic grid distance(dlnr) :
-!       dlnr=dlog(2.d0)/(3.d0*scal)
-! scal is micro.prm file parameter(scal=1.d0 for x(k+1)=x(k)*2)
-! calculation of cw*(i,j) (in cm**3) - multiply help kernel 
-! with constant timestep(dtime) and logarithmic grid distance(dlnr) :
-!     print*,'dlnr in kernal = ',dlnr,dtime
-        DO I=1,NKR
-           DO J=1,NKR
-              CWLL_1000MB(I,J)=DTIME*DLNR*YWLL_1000MB(I,J)
-              CWLL_750MB(I,J)=DTIME*DLNR*YWLL_750MB(I,J)
-              CWLL_500MB(I,J)=DTIME*DLNR*YWLL_500MB(I,J)
-
-              CWLL(I,J)=DTIME*DLNR*YWLL(I,J)
-              CWLG(I,J)=DTIME*DLNR*YWLG(I,J)
-              CWLH(I,J)=DTIME*DLNR*YWLH(I,J)
-
-! barry
-              if (i.le.16.and.j.le.16)then
-              CWSL(I,J)=0.d0
-!             CWIL_2(I,J)=DTIME*DLNR*YWIL(I,J,2)
-              CWSL(i,j)=DTIME*DLNR*YWIL(I,J,2)
-              CWLS(I,J)=0.d0
-!             CWLI_2(I,J)=DTIME*DLNR*YWLI(I,J,2)
-              CWLS(I,J)=DTIME*DLNR*YWLI(I,J,2)
-              else
-              CWSL(I,J)=DTIME*DLNR*YWSL(I,J)
-              CWLS(I,J)=DTIME*DLNR*YWLS(I,J)
-              end if
-              CWSS(I,J)=DTIME*DLNR*YWSS(I,J)
-              CWSG(I,J)=DTIME*DLNR*YWSG(I,J)
-              CWSH(I,J)=DTIME*DLNR*YWSH(I,J)
-
-              CWGL(I,J)=0.8*DTIME*DLNR*YWGL(I,J)
-              IF(RADXXO(I,6).LT.2.0D-2) THEN
-                IF(RADXXO(J,1).LT.1.0D-3) THEN
-                  IF(RADXXO(J,1).GE.7.0D-4) THEN
-                    CWGL(I,J)=DTIME*DLNR*YWGL(I,J)/1.5D0
-                  ELSE
-                    CWGL(I,J)=DTIME*DLNR*YWGL(I,J)/3.0D0
-                  ENDIF
-                ENDIF
-              ENDIF
-              IF(I.LE.14.AND.J.LE.7) CWGL(I,J)=0.0D0
-!             IF(I.LE.17.AND.J.LE.7) CWGL(I,J)=0.0D0
-!             IF(I.LE.14.AND.J.LE.14) CWGL(I,J)=0.0D0
-              CWGS(I,J)=DTIME*DLNR*YWGS(I,J)
-              CWGG(I,J)=DTIME*DLNR*YWGG(I,J)
-              CWGH(I,J)=DTIME*DLNR*YWGH(I,J)
-
-              CWHL(I,J)=DTIME*DLNR*YWHL(I,J)
-              CWHS(I,J)=DTIME*DLNR*YWHS(I,J)
-              CWHG(I,J)=DTIME*DLNR*YWHG(I,J)
-              CWHH(I,J)=DTIME*DLNR*YWHH(I,J)
-
-              CWLI_1(I,J)=DTIME*DLNR*YWLI(I,J,1)
-              CWLI_2(I,J)=DTIME*DLNR*YWLI(I,J,2)
-              CWLI_3(I,J)=DTIME*DLNR*YWLI(I,J,3)
-              
-              CWIL_1(I,J)=DTIME*DLNR*YWIL(I,J,1)
-              CWIL_2(I,J)=DTIME*DLNR*YWIL(I,J,2)
-              CWIL_3(I,J)=DTIME*DLNR*YWIL(I,J,3)
-
-              CWIS_1(I,J)=DTIME*DLNR*YWIS(I,J,1)
-              CWIS_2(I,J)=DTIME*DLNR*YWIS(I,J,2)
-              CWIS_3(I,J)=DTIME*DLNR*YWIS(I,J,3)
-
-              CWSI_1(I,J)=DTIME*DLNR*YWSI(I,J,1)
-              CWSI_2(I,J)=DTIME*DLNR*YWSI(I,J,2)
-              CWSI_3(I,J)=DTIME*DLNR*YWSI(I,J,3)
-
-              CWIG_1(I,J)=DTIME*DLNR*YWIG(I,J,1)
-              CWIG_2(I,J)=DTIME*DLNR*YWIG(I,J,2)
-              CWIG_3(I,J)=DTIME*DLNR*YWIG(I,J,3)
-
-              CWGI_1(I,J)=DTIME*DLNR*YWGI(I,J,1)
-              CWGI_2(I,J)=DTIME*DLNR*YWGI(I,J,2)
-              CWGI_3(I,J)=DTIME*DLNR*YWGI(I,J,3)
-
-              CWIH_1(I,J)=DTIME*DLNR*YWIH(I,J,1)
-              CWIH_2(I,J)=DTIME*DLNR*YWIH(I,J,2)
-              CWIH_3(I,J)=DTIME*DLNR*YWIH(I,J,3)
-
-              CWHI_1(I,J)=DTIME*DLNR*YWHI(I,J,1)
-              CWHI_2(I,J)=DTIME*DLNR*YWHI(I,J,2)
-              CWHI_3(I,J)=DTIME*DLNR*YWHI(I,J,3)
-! barry
-              if (i.lt.12.and.j.lt.12)then
-
-               CWII_1_1(I,J)=0.D0
-               CWII_1_2(I,J)=0.D0
-               CWII_1_3(I,J)=0.D0
-
-               CWII_2_1(I,J)=0.D0
-               CWII_2_2(I,J)=0.D0
-               CWII_2_3(I,J)=0.D0
-
-               CWII_3_1(I,J)=0.D0
-               CWII_3_2(I,J)=0.D0
-               CWII_3_3(I,J)=0.D0
-!barry
-              else
-               CWII_1_1(I,J)=DTIME*DLNR*YWII(I,J,1,1)
-               CWII_1_2(I,J)=DTIME*DLNR*YWII(I,J,1,2)
-               CWII_1_3(I,J)=DTIME*DLNR*YWII(I,J,1,3)
-
-               CWII_2_1(I,J)=DTIME*DLNR*YWII(I,J,2,1)
-               CWII_2_2(I,J)=DTIME*DLNR*YWII(I,J,2,2)
-               CWII_2_3(I,J)=DTIME*DLNR*YWII(I,J,2,3)
-
-               CWII_3_1(I,J)=DTIME*DLNR*YWII(I,J,3,1)
-               CWII_3_2(I,J)=DTIME*DLNR*YWII(I,J,3,2)
-               CWII_3_3(I,J)=DTIME*DLNR*YWII(I,J,3,3)
-              end if
-           ENDDO
-        ENDDO
-!       GO TO 88
-! NEW CHANGES 2.06.01 (BEGIN)
-        CALL TURBCOEF
-        DO J=1,7
-           DO I=15,24-J
-              CWGL(I,J)=0.0D0
-           ENDDO
-        ENDDO
-! NEW CHANGES 2.06.01 (END)
-! NEW CHANGES 3.02.01 (BEGIN)
-        DO I=1,NKR
-           DO J=1,NKR
-              CWLG(J,I)=CWGL(I,J)
-           ENDDO
-        ENDDO
-!       print*, 'ICETURB = ',ICETURB
-          DO I=KRMING_GL,KRMAXG_GL
-             DO J=KRMINL_GL,KRMAXL_GL
-               IF (ICETURB.EQ.1)THEN
-                CWGL(I,J)=CTURBGL(I,J)*CWGL(I,J)
-               ELSE
-                CWGL(I,J)=CWGL(I,J)
-               END IF
-             ENDDO
-          ENDDO
-          DO I=KRMING_GL,KRMAXG_GL
-             DO J=KRMINL_GL,KRMAXL_GL
-                CWLG(J,I)=CWGL(I,J)
-             ENDDO
-          ENDDO
+            print*,    'in subroutine coll_xyz_lwf'
 
-88     CONTINUE
-	RETURN
-	END SUBROUTINE KERNALS
+            if(flz(k).gt.1.0001d0)  print*, 'flz(k).gt.1.0001d0'
+            if(flz(kp).gt.1.0001d0) print*, 'flz(kp).gt.1.0001d0'
 
-      SUBROUTINE KERNALS_IN(DTIME)
-! KHAIN30/07/99
-      IMPLICIT NONE
-      INTEGER I,J
-      REAL PI
-!******************************************************************
-      data pi/3.141592654/
-! dtime - timestep of integration (calculated in main program) :
-! dlnr - logarithmic grid distance
-! ima(i,j) - k-category number, c(i,j) - courant number 
-! cw*(i,j) (in cm**3) - multiply help kernel with constant 
-! timestep(dt) and logarithmic grid distance(dlnr) :
-        REAL DTIME
-! logarithmic grid distance(dlnr) :
-!       dlnr=dlog(2.d0)/(3.d0*scal)
-! scal is micro.prm file parameter(scal=1.d0 for x(k+1)=x(k)*2)
-! calculation of cw*(i,j) (in cm**3) - multiply help kernel 
-! with constant timestep(dtime) and logarithmic grid distance(dlnr) :
-!     print*,'dlnr in kernal = ',dlnr,dtime
-        DO I=1,NKR
-           DO J=1,NKR
-              CWLL_1000MB(I,J)=DTIME*DLNR*YWLL_1000MB(I,J)
-              CWLL_750MB(I,J)=DTIME*DLNR*YWLL_750MB(I,J)
-              CWLL_500MB(I,J)=DTIME*DLNR*YWLL_500MB(I,J)
-
-              CWLL(I,J)=DTIME*DLNR*YWLL(I,J)
-              CWLG(I,J)=DTIME*DLNR*YWLG(I,J)
-!             CWLH(I,J)=DTIME*DLNR*YWLH(I,J)
-
-! barry
-              if (i.le.16.and.j.le.16)then
-              CWSL(I,J)=0.d0
-!             CWIL_2(I,J)=DTIME*DLNR*YWIL(I,J,2)
-              CWSL(i,j)=DTIME*DLNR*YWIL(I,J,2)
-              CWLS(I,J)=0.d0
-!             CWLI_2(I,J)=DTIME*DLNR*YWLI(I,J,2)
-              CWLS(I,J)=DTIME*DLNR*YWLI(I,J,2)
-              else
-              CWSL(I,J)=DTIME*DLNR*YWSL(I,J)
-              CWLS(I,J)=DTIME*DLNR*YWLS(I,J)
-              end if
-              CWSS(I,J)=DTIME*DLNR*YWSS(I,J)
-              CWSG(I,J)=DTIME*DLNR*YWSG(I,J)
-!             CWSH(I,J)=DTIME*DLNR*YWSH(I,J)
-
-              CWGL(I,J)=0.8*DTIME*DLNR*YWGL(I,J)
-              IF(RADXXO(I,6).LT.2.0D-2) THEN
-                IF(RADXXO(J,1).LT.1.0D-3) THEN
-                  IF(RADXXO(J,1).GE.7.0D-4) THEN
-                    CWGL(I,J)=DTIME*DLNR*YWGL(I,J)/1.5D0
-                  ELSE
-                    CWGL(I,J)=DTIME*DLNR*YWGL(I,J)/3.0D0
-                  ENDIF
-                ENDIF
-              ENDIF
-              IF(I.LE.14.AND.J.LE.7) CWGL(I,J)=0.0D0
-!             IF(I.LE.17.AND.J.LE.7) CWGL(I,J)=0.0D0
-!             IF(I.LE.14.AND.J.LE.14) CWGL(I,J)=0.0D0
-              CWGS(I,J)=DTIME*DLNR*YWGS(I,J)
-              CWGG(I,J)=DTIME*DLNR*YWGG(I,J)
-!             CWGH(I,J)=DTIME*DLNR*YWGH(I,J)
-
-!             CWHL(I,J)=DTIME*DLNR*YWHL(I,J)
-!             CWHS(I,J)=DTIME*DLNR*YWHS(I,J)
-!             CWHG(I,J)=DTIME*DLNR*YWHG(I,J)
-!             CWHH(I,J)=DTIME*DLNR*YWHH(I,J)
-
-!             CWLI_1(I,J)=DTIME*DLNR*YWLI(I,J,1)
-!             CWLI_2(I,J)=DTIME*DLNR*YWLI(I,J,2)
-!             CWLI_3(I,J)=DTIME*DLNR*YWLI(I,J,3)
-              
-!             CWIL_1(I,J)=DTIME*DLNR*YWIL(I,J,1)
-!             CWIL_2(I,J)=DTIME*DLNR*YWIL(I,J,2)
-!             CWIL_3(I,J)=DTIME*DLNR*YWIL(I,J,3)
-
-!             CWIS_1(I,J)=DTIME*DLNR*YWIS(I,J,1)
-!             CWIS_2(I,J)=DTIME*DLNR*YWIS(I,J,2)
-!             CWIS_3(I,J)=DTIME*DLNR*YWIS(I,J,3)
-
-!             CWSI_1(I,J)=DTIME*DLNR*YWSI(I,J,1)
-!             CWSI_2(I,J)=DTIME*DLNR*YWSI(I,J,2)
-!             CWSI_3(I,J)=DTIME*DLNR*YWSI(I,J,3)
-
-!             CWIG_1(I,J)=DTIME*DLNR*YWIG(I,J,1)
-!             CWIG_2(I,J)=DTIME*DLNR*YWIG(I,J,2)
-!             CWIG_3(I,J)=DTIME*DLNR*YWIG(I,J,3)
-
-!             CWGI_1(I,J)=DTIME*DLNR*YWGI(I,J,1)
-!             CWGI_2(I,J)=DTIME*DLNR*YWGI(I,J,2)
-!             CWGI_3(I,J)=DTIME*DLNR*YWGI(I,J,3)
-
-!             CWIH_1(I,J)=DTIME*DLNR*YWIH(I,J,1)
-!             CWIH_2(I,J)=DTIME*DLNR*YWIH(I,J,2)
-!             CWIH_3(I,J)=DTIME*DLNR*YWIH(I,J,3)
-
-!             CWHI_1(I,J)=DTIME*DLNR*YWHI(I,J,1)
-!             CWHI_2(I,J)=DTIME*DLNR*YWHI(I,J,2)
-!             CWHI_3(I,J)=DTIME*DLNR*YWHI(I,J,3)
-! barry
-              if (i.lt.12.and.j.lt.12)then
-
-!              CWII_1_1(I,J)=0.D0
-!              CWII_1_2(I,J)=0.D0
-!              CWII_1_3(I,J)=0.D0
-
-!              CWII_2_1(I,J)=0.D0
-!              CWII_2_2(I,J)=0.D0
-!              CWII_2_3(I,J)=0.D0
-
-!              CWII_3_1(I,J)=0.D0
-!              CWII_3_2(I,J)=0.D0
-!              CWII_3_3(I,J)=0.D0
-!barry
-              else
-!              CWII_1_1(I,J)=DTIME*DLNR*YWII(I,J,1,1)
-!              CWII_1_2(I,J)=DTIME*DLNR*YWII(I,J,1,2)
-!              CWII_1_3(I,J)=DTIME*DLNR*YWII(I,J,1,3)
-
-!              CWII_2_1(I,J)=DTIME*DLNR*YWII(I,J,2,1)
-!              CWII_2_2(I,J)=DTIME*DLNR*YWII(I,J,2,2)
-!              CWII_2_3(I,J)=DTIME*DLNR*YWII(I,J,2,3)
-
-!              CWII_3_1(I,J)=DTIME*DLNR*YWII(I,J,3,1)
-!              CWII_3_2(I,J)=DTIME*DLNR*YWII(I,J,3,2)
-!              CWII_3_3(I,J)=DTIME*DLNR*YWII(I,J,3,3)
-              end if
-           ENDDO
-        ENDDO
-!       GO TO 88
-! NEW CHANGES 2.06.01 (BEGIN)
-        CALL TURBCOEF
-        DO J=1,7
-           DO I=15,24-J
-              CWGL(I,J)=0.0D0
-           ENDDO
-        ENDDO
-! NEW CHANGES 2.06.01 (END)
-! NEW CHANGES 3.02.01 (BEGIN)
-        DO I=1,NKR
-           DO J=1,NKR
-              CWLG(J,I)=CWGL(I,J)
-           ENDDO
-        ENDDO
-!       print*, 'ICETURB = ',ICETURB
-          DO I=KRMING_GL,KRMAXG_GL
-             DO J=KRMINL_GL,KRMAXL_GL
-               IF (ICETURB.EQ.1)THEN
-                CWGL(I,J)=CTURBGL(I,J)*CWGL(I,J)
-               ELSE
-                CWGL(I,J)=CWGL(I,J)
-               END IF
-             ENDDO
-          ENDDO
-          DO I=KRMING_GL,KRMAXG_GL
-             DO J=KRMINL_GL,KRMAXL_GL
-                CWLG(J,I)=CWGL(I,J)
-             ENDDO
-          ENDDO
+            if(flz(k).lt.0.0d0)  print*, 'flz(k).lt.0.0d0'
+            if(flz(kp).lt.0.0d0) print*, 'flz(kp).lt.0.0d0'
 
-88     CONTINUE
-	RETURN
-	END SUBROUTINE KERNALS_IN
-        SUBROUTINE TURBCOEF
-        IMPLICIT NONE
-        INTEGER I,J
-!       DOUBLE PRECISION X_KERN,Y_KERN,F
-        DOUBLE PRECISION X_KERN,Y_KERN
-	DOUBLE PRECISION RL_LL(K0_LL),RL_GL(K0L_GL),RG_GL(K0G_GL)
-          RL_LL(1)=RADXXO(KRMIN_LL,1)*1.E4
-          RL_LL(2)=10.0D0
-          RL_LL(3)=20.0D0
-          RL_LL(4)=30.0D0
-          RL_LL(5)=40.0D0
-          RL_LL(6)=50.0D0
-          RL_LL(7)=60.0D0
-          RL_LL(8)=RADXXO(KRMAX_LL,1)*1.E4
-          DO J=1,K0_LL
-             DO I=1,K0_LL
-                CTURB_LL(I,J)=1.0D0
-             ENDDO
-          ENDDO 
-	  CTURB_LL(1,1)=4.50D0
-	  CTURB_LL(1,2)=4.50D0
-	  CTURB_LL(1,3)=3.00D0
-	  CTURB_LL(1,4)=2.25D0
-	  CTURB_LL(1,5)=1.95D0
-	  CTURB_LL(1,6)=1.40D0
-	  CTURB_LL(1,7)=1.40D0
-	  CTURB_LL(1,8)=1.40D0
-
-	  CTURB_LL(2,1)=4.50D0
-	  CTURB_LL(2,2)=4.50D0
-	  CTURB_LL(2,3)=3.00D0
-	  CTURB_LL(2,4)=2.25D0
-	  CTURB_LL(2,5)=1.95D0
-	  CTURB_LL(2,6)=1.40D0
-	  CTURB_LL(2,7)=1.40D0
-	  CTURB_LL(2,8)=1.40D0
-
-	  CTURB_LL(3,1)=3.00D0
-	  CTURB_LL(3,2)=3.00D0
-	  CTURB_LL(3,3)=2.70D0
-	  CTURB_LL(3,4)=2.25D0
-	  CTURB_LL(3,5)=1.65D0
-	  CTURB_LL(3,6)=1.40D0
-	  CTURB_LL(3,7)=1.40D0
-	  CTURB_LL(3,8)=1.40D0
-
-	  CTURB_LL(4,1)=2.25D0
-	  CTURB_LL(4,2)=2.25D0
-	  CTURB_LL(4,3)=2.25D0
-	  CTURB_LL(4,4)=1.95D0
-	  CTURB_LL(4,5)=1.65D0
-	  CTURB_LL(4,6)=1.40D0
-	  CTURB_LL(4,7)=1.40D0
-	  CTURB_LL(4,8)=1.40D0
-
-	  CTURB_LL(5,1)=1.95D0
-	  CTURB_LL(5,2)=1.95D0
-	  CTURB_LL(5,3)=1.65D0
-	  CTURB_LL(5,4)=1.65D0
-	  CTURB_LL(5,5)=1.65D0
-	  CTURB_LL(5,6)=1.40D0
-	  CTURB_LL(5,7)=1.40D0
-	  CTURB_LL(5,8)=1.40D0
-
-	  CTURB_LL(6,1)=1.40D0
-	  CTURB_LL(6,2)=1.40D0
-	  CTURB_LL(6,3)=1.40D0
-	  CTURB_LL(6,4)=1.40D0
-	  CTURB_LL(6,5)=1.40D0
-	  CTURB_LL(6,6)=1.40D0
-	  CTURB_LL(6,7)=1.40D0
-	  CTURB_LL(6,8)=1.40D0
-
-	  CTURB_LL(7,1)=1.40D0
-	  CTURB_LL(7,2)=1.40D0
-	  CTURB_LL(7,3)=1.40D0
-	  CTURB_LL(7,4)=1.40D0
-	  CTURB_LL(7,5)=1.40D0
-	  CTURB_LL(7,6)=1.40D0
-	  CTURB_LL(7,7)=1.40D0
-	  CTURB_LL(7,8)=1.40D0
-
-	  CTURB_LL(8,1)=1.40D0
-	  CTURB_LL(8,2)=1.40D0
-	  CTURB_LL(8,3)=1.40D0
-	  CTURB_LL(8,4)=1.40D0
-	  CTURB_LL(8,5)=1.40D0
-	  CTURB_LL(8,6)=1.40D0
-	  CTURB_LL(8,7)=1.40D0
-	  CTURB_LL(8,8)=1.40D0
-          DO J=1,K0_LL
-             DO I=1,K0_LL
-                CTURB_LL(I,J)=(CTURB_LL(I,J)-1.0D0)/1.5D0+1.0D0
-             ENDDO
-          ENDDO
-	  DO I=KRMIN_LL,KRMAX_LL
-             DO J=KRMIN_LL,KRMAX_LL
-                CTURBLL(I,J)=1.0D0
-             ENDDO
-          ENDDO
-          DO I=KRMIN_LL,KRMAX_LL
-             X_KERN=RADXXO(I,1)*1.0D4
-             IF(X_KERN.LT.RL_LL(1)) X_KERN=RL_LL(1)
-             IF(X_KERN.GT.RL_LL(K0_LL)) X_KERN=RL_LL(K0_LL) 
-             DO J=KRMIN_LL,KRMAX_LL
-                Y_KERN=RADXXO(J,1)*1.0D4
-                IF(Y_KERN.LT.RL_LL(1)) Y_KERN=RL_LL(1)
-                IF(Y_KERN.GT.RL_LL(K0_LL)) Y_KERN=RL_LL(K0_LL)
-                CTURBLL(I,J)=F(X_KERN,Y_KERN,RL_LL,RL_LL,CTURB_LL &
-     &                      ,K0_LL,K0_LL)	                         
-             ENDDO
-          ENDDO
-          RL_GL(1) = RADXXO(1,1)*1.E4 
-          RL_GL(2) = 8.0D0
-          RL_GL(3) = 10.0D0
-	  RL_GL(4) = 16.0D0
-          RL_GL(5) = 20.0D0
-          RL_GL(6) = 30.0D0
-          RL_GL(7) = 40.0D0
-          RL_GL(8) = 50.0D0
-          RL_GL(9) = 60.0D0
-          RL_GL(10)= 70.0D0
-          RL_GL(11)= 80.0D0
-	  RL_GL(12)= 90.0D0
-	  RL_GL(13)=100.0D0
-	  RL_GL(14)=200.0D0
-	  RL_GL(15)=300.0D0
-	  RL_GL(16)=RADXXO(24,1)*1.0D4
-! TURBULENCE GRAUPEL BULK RADII IN MKM
-          RG_GL(1) = RADXXO(1,6)*1.0D4 
-          RG_GL(2) = 30.0D0  
-          RG_GL(3) = 60.0D0 
-          RG_GL(4) = 100.0D0 
-          RG_GL(5) = 200.0D0 
-	  RG_GL(6) = 300.0D0
-	  RG_GL(7) = 400.0D0
-	  RG_GL(8) = 500.0D0
-	  RG_GL(9) = 600.0D0
-	  RG_GL(10)= 700.0D0
-	  RG_GL(11)= 800.0D0
-	  RG_GL(12)= 900.0D0
-	  RG_GL(13)=1000.0D0
-	  RG_GL(14)=2000.0D0
-	  RG_GL(15)=3000.0D0
-	  RG_GL(16)=RADXXO(33,6)*1.0D4
-	  DO I=KRMING_GL,KRMAXG_GL
-             DO J=KRMINL_GL,KRMAXL_GL
-                CTURBGL(I,J)=1.0D0
-             ENDDO
-          ENDDO
-          DO I=1,K0G_GL
-             DO J=1,K0L_GL
-                CTURB_GL(I,J)=1.0D0
-             ENDDO
-          ENDDO 
-          IF(IEPS_400.EQ.1) THEN
-	    CTURB_GL(1,1)=0.0D0
-	    CTURB_GL(1,2)=0.0D0
-	    CTURB_GL(1,3)=1.2D0
-	    CTURB_GL(1,4)=1.3D0
-	    CTURB_GL(1,5)=1.4D0
-	    CTURB_GL(1,6)=1.5D0
-	    CTURB_GL(1,7)=1.5D0
-	    CTURB_GL(1,8)=1.5D0
-	    CTURB_GL(1,9)=1.5D0
-	    CTURB_GL(1,10)=1.5D0
-	    CTURB_GL(1,11)=1.5D0
-	    CTURB_GL(1,12)=1.0D0
-	    CTURB_GL(1,13)=1.0D0
-	    CTURB_GL(1,14)=1.0D0
-	    CTURB_GL(1,15)=1.0D0
-	
-	    CTURB_GL(2,1)=1.0D0
-	    CTURB_GL(2,2)=1.4D0
-	    CTURB_GL(2,3)=1.8D0
-	    CTURB_GL(2,4)=2.2D0
-	    CTURB_GL(2,5)=2.6D0
-	    CTURB_GL(2,6)=3.0D0
-	    CTURB_GL(2,7)=2.85D0
-	    CTURB_GL(2,8)=2.7D0
-	    CTURB_GL(2,9)=2.55D0
-	    CTURB_GL(2,10)=2.4D0
-	    CTURB_GL(2,11)=2.25D0
-	    CTURB_GL(2,12)=1.0D0
-	    CTURB_GL(2,13)=1.0D0
-	    CTURB_GL(2,14)=1.0D0
-
-	    CTURB_GL(3,1)=7.5D0
-	    CTURB_GL(3,2)=7.5D0
-	    CTURB_GL(3,3)=4.5D0	
-	    CTURB_GL(3,4)=4.5D0	
-	    CTURB_GL(3,5)=4.65D0	
-	    CTURB_GL(3,6)=4.65D0	
-	    CTURB_GL(3,7)=4.5D0	
-	    CTURB_GL(3,8)=4.5D0	
-	    CTURB_GL(3,9)=4.0D0	
-	    CTURB_GL(3,10)=3.0D0	
-	    CTURB_GL(3,11)=2.0D0	
-	    CTURB_GL(3,12)=1.5D0	
-	    CTURB_GL(3,13)=1.3D0	
-	    CTURB_GL(3,14)=1.0D0	
-    
-	    CTURB_GL(4,1)=5.5D0
-	    CTURB_GL(4,2)=5.5D0
-	    CTURB_GL(4,3)=4.5D0
-	    CTURB_GL(4,4)=4.5D0
-	    CTURB_GL(4,5)=4.65D0
-	    CTURB_GL(4,6)=4.65D0
-	    CTURB_GL(4,7)=4.5D0
-	    CTURB_GL(4,8)=4.5D0
-	    CTURB_GL(4,9)=4.0D0
-	    CTURB_GL(4,10)=3.0D0
-	    CTURB_GL(4,11)=2.0D0
-	    CTURB_GL(4,12)=1.5D0
-	    CTURB_GL(4,13)=1.35D0
-	    CTURB_GL(4,14)=1.0D0
-	 
-	    CTURB_GL(5,1)=4.5D0
-	    CTURB_GL(5,2)=4.5D0
-	    CTURB_GL(5,3)=3.3D0	
-	    CTURB_GL(5,4)=3.3D0	
-	    CTURB_GL(5,5)=3.3D0	
-	    CTURB_GL(5,6)=3.4D0	
-	    CTURB_GL(5,7)=3.8D0	
-	    CTURB_GL(5,8)=3.8D0	
-	    CTURB_GL(5,9)=3.8D0	
-	    CTURB_GL(5,10)=3.6D0
-	    CTURB_GL(5,11)=2.5D0	
-	    CTURB_GL(5,12)=2.0D0	
-	    CTURB_GL(5,13)=1.4D0	
-	    CTURB_GL(5,14)=1.0D0	
-			 		
-	    CTURB_GL(6,1)=4.0D0
-	    CTURB_GL(6,2)=4.0D0
-	    CTURB_GL(6,3)=2.8D0
-	    CTURB_GL(6,4)=2.8D0
-	    CTURB_GL(6,5)=2.85D0
-	    CTURB_GL(6,6)=2.9D0
-	    CTURB_GL(6,7)=3.0D0
-	    CTURB_GL(6,8)=3.1D0
-	    CTURB_GL(6,9)=2.9D0
-	    CTURB_GL(6,10)=2.6D0
-	    CTURB_GL(6,11)=2.5D0
-	    CTURB_GL(6,12)=2.0D0
-	    CTURB_GL(6,13)=1.3D0
-	    CTURB_GL(6,14)=1.1D0
-
-	    CTURB_GL(7,1)=3.5D0
-	    CTURB_GL(7,2)=3.5D0
-	    CTURB_GL(7,3)=2.5D0
-	    CTURB_GL(7,4)=2.5D0
-	    CTURB_GL(7,5)=2.6D0
-	    CTURB_GL(7,6)=2.7D0
-	    CTURB_GL(7,7)=2.8D0
-	    CTURB_GL(7,8)=2.8D0
-	    CTURB_GL(7,9)=2.8D0
-	    CTURB_GL(7,10)=2.6D0
-	    CTURB_GL(7,11)=2.3D0
-	    CTURB_GL(7,12)=2.0D0
-	    CTURB_GL(7,13)=1.3D0
-	    CTURB_GL(7,14)=1.1D0
-
-	    CTURB_GL(8,1)=3.25D0
-	    CTURB_GL(8,2)=3.25D0
-	    CTURB_GL(8,3)=2.3D0
-	    CTURB_GL(8,4)=2.3D0
-	    CTURB_GL(8,5)=2.35D0
-	    CTURB_GL(8,6)=2.37D0
-	    CTURB_GL(8,7)=2.55D0
-	    CTURB_GL(8,8)=2.55D0
-	    CTURB_GL(8,9)=2.55D0
-	    CTURB_GL(8,10)=2.3D0
-	    CTURB_GL(8,11)=2.1D0
-	    CTURB_GL(8,12)=1.9D0
-	    CTURB_GL(8,13)=1.3D0
-	    CTURB_GL(8,14)=1.1D0
-
-	    CTURB_GL(9,1)=3.0D0
-	    CTURB_GL(9,2)=3.0D0
-	    CTURB_GL(9,3)=3.1D0
-	    CTURB_GL(9,4)=2.2D0
-	    CTURB_GL(9,5)=2.2D0
-	    CTURB_GL(9,6)=2.2D0
-	    CTURB_GL(9,7)=2.3D0
-	    CTURB_GL(9,8)=2.3D0
-	    CTURB_GL(9,9)=2.5D0
-	    CTURB_GL(9,10)=2.5D0
-	    CTURB_GL(9,11)=2.2D0
-	    CTURB_GL(9,12)=1.8D0
-	    CTURB_GL(9,13)=1.25D0
-	    CTURB_GL(9,14)=1.1D0
-
-	    CTURB_GL(10,1)=2.75D0
-	    CTURB_GL(10,2)=2.75D0
-	    CTURB_GL(10,3)=2.0D0
-	    CTURB_GL(10,4)=2.0D0
-	    CTURB_GL(10,5)=2.0D0
-	    CTURB_GL(10,6)=2.1D0
-	    CTURB_GL(10,7)=2.2D0
-	    CTURB_GL(10,8)=2.2D0
-	    CTURB_GL(10,9)=2.3D0
-	    CTURB_GL(10,10)=2.3D0
-	    CTURB_GL(10,11)=2.3D0
-	    CTURB_GL(10,12)=1.8D0
-	    CTURB_GL(10,13)=1.2D0
-	    CTURB_GL(10,14)=1.1D0
-
-	    CTURB_GL(11,1)=2.6D0
-	    CTURB_GL(11,2)=2.6D0
-	    CTURB_GL(11,3)=1.95D0
-	    CTURB_GL(11,4)=1.95D0
-	    CTURB_GL(11,5)=1.95D0
-	    CTURB_GL(11,6)=2.05D0
-	    CTURB_GL(11,7)=2.15D0
-	    CTURB_GL(11,8)=2.15D0
-	    CTURB_GL(11,9)=2.25D0
-	    CTURB_GL(11,10)=2.25D0
-	    CTURB_GL(11,11)=1.9D0
-	    CTURB_GL(11,12)=1.8D0
-	    CTURB_GL(11,13)=1.2D0
-	    CTURB_GL(11,14)=1.1D0
-
-	    CTURB_GL(12,1)=2.4D0
-	    CTURB_GL(12,2)=2.4D0
-	    CTURB_GL(12,3)=1.85D0
-	    CTURB_GL(12,4)=1.85D0
-	    CTURB_GL(12,5)=1.85D0
-	    CTURB_GL(12,6)=1.75D0
-	    CTURB_GL(12,7)=1.85D0
-	    CTURB_GL(12,8)=1.85D0
-	    CTURB_GL(12,9)=2.1D0
-	    CTURB_GL(12,10)=2.1D0
-	    CTURB_GL(12,11)=1.9D0
-	    CTURB_GL(12,12)=1.8D0 
-	    CTURB_GL(12,13)=1.3D0
-	    CTURB_GL(12,14)=1.1D0
-
-	    CTURB_GL(13,1)=1.67D0
-	    CTURB_GL(13,2)=1.67D0
-	    CTURB_GL(13,3)=1.75D0
-	    CTURB_GL(13,4)=1.83D0
-	    CTURB_GL(13,5)=1.87D0
-	    CTURB_GL(13,6)=2.0D0
-	    CTURB_GL(13,7)=2.1D0
-	    CTURB_GL(13,8)=2.12D0
-	    CTURB_GL(13,9)=2.15D0
-	    CTURB_GL(13,10)=2.18D0
-	    CTURB_GL(13,11)=2.19D0
-	    CTURB_GL(13,12)=1.67D0
-	    CTURB_GL(13,13)=1.28D0
-	    CTURB_GL(13,14)=1.0D0
-
-	    CTURB_GL(14,1)=1.3D0
-	    CTURB_GL(14,2)=1.3D0
-	    CTURB_GL(14,3)=1.35D0
-	    CTURB_GL(14,4)=1.4D0
-	    CTURB_GL(14,5)=1.6D0
-	    CTURB_GL(14,6)=1.7D0
-	    CTURB_GL(14,7)=1.7D0
-	    CTURB_GL(14,8)=1.7D0
-	    CTURB_GL(14,9)=1.7D0
-	    CTURB_GL(14,10)=1.7D0
-	    CTURB_GL(14,11)=1.7D0
-	    CTURB_GL(14,12)=1.4D0
-	    CTURB_GL(14,13)=1.25D0
-	    CTURB_GL(14,14)=1.0D0
-
-	    CTURB_GL(15,1)=1.17D0
-	    CTURB_GL(15,2)=1.17D0
-	    CTURB_GL(15,3)=1.17D0
-	    CTURB_GL(15,4)=1.25D0
-	    CTURB_GL(15,5)=1.3D0
-	    CTURB_GL(15,6)=1.35D0
-	    CTURB_GL(15,7)=1.4D0
-	    CTURB_GL(15,8)=1.4D0
-	    CTURB_GL(15,9)=1.45D0
-	    CTURB_GL(15,10)=1.47D0
-	    CTURB_GL(15,11)=1.44D0
-	    CTURB_GL(15,12)=1.3D0
-	    CTURB_GL(15,13)=1.12D0
-	    CTURB_GL(15,14)=1.0D0
-
-	    CTURB_GL(16,1)=1.17D0
-	    CTURB_GL(16,2)=1.17D0
-	    CTURB_GL(16,3)=1.17D0
-	    CTURB_GL(16,4)=1.25D0
-	    CTURB_GL(16,5)=1.3D0
-	    CTURB_GL(16,6)=1.35D0
-	    CTURB_GL(16,7)=1.4D0
-	    CTURB_GL(16,8)=1.45D0
-	    CTURB_GL(16,9)=1.45D0
-	    CTURB_GL(16,10)=1.47D0
-	    CTURB_GL(16,11)=1.44D0
-	    CTURB_GL(16,12)=1.3D0
-	    CTURB_GL(16,13)=1.12D0
-	    CTURB_GL(16,14)=1.0D0
-          ENDIF
-          IF(IEPS_800.EQ.1) THEN
-	    CTURB_GL(1,1) =0.00D0
-	    CTURB_GL(1,2) =0.00D0
-	    CTURB_GL(1,3) =1.00D0
-            CTURB_GL(1,4) =1.50D0
-	    CTURB_GL(1,5) =1.40D0
-	    CTURB_GL(1,6) =1.30D0
-	    CTURB_GL(1,7) =1.20D0
-	    CTURB_GL(1,8) =1.10D0
-	    CTURB_GL(1,9) =1.00D0
-	    CTURB_GL(1,10)=1.00D0
-	    CTURB_GL(1,11)=1.00D0
-	    CTURB_GL(1,12)=1.00D0
-	    CTURB_GL(1,13)=1.00D0
-	    CTURB_GL(1,14)=1.00D0
-	    CTURB_GL(1,15)=1.00D0
-	    CTURB_GL(1,16)=1.00D0
-
-	    CTURB_GL(2,1) =0.00D0
-	    CTURB_GL(2,2) =0.00D0
-	    CTURB_GL(2,3) =1.00D0
-	    CTURB_GL(2,4) =2.00D0
-	    CTURB_GL(2,5) =1.80D0
-	    CTURB_GL(2,6) =1.70D0
-	    CTURB_GL(2,7) =1.60D0
-	    CTURB_GL(2,8) =1.50D0
-	    CTURB_GL(2,9) =1.50D0
-	    CTURB_GL(2,10)=1.50D0
-	    CTURB_GL(2,11)=1.50D0
-	    CTURB_GL(2,12)=1.50D0
-	    CTURB_GL(2,13)=1.50D0
-	    CTURB_GL(2,14)=1.00D0
-	    CTURB_GL(2,15)=1.00D0
-	    CTURB_GL(2,16)=1.00D0
-
-	    CTURB_GL(3,1) =0.00D0
-	    CTURB_GL(3,2) =0.00D0
-	    CTURB_GL(3,3) =4.00D0
-	    CTURB_GL(3,4) =7.65D0
-	    CTURB_GL(3,5) =7.65D0
-	    CTURB_GL(3,6) =8.00D0
-	    CTURB_GL(3,7) =8.00D0
-	    CTURB_GL(3,8) =7.50D0
-	    CTURB_GL(3,9) =6.50D0
-	    CTURB_GL(3,10)=6.00D0
-	    CTURB_GL(3,11)=5.00D0
-	    CTURB_GL(3,12)=4.50D0
-	    CTURB_GL(3,13)=4.00D0
-	    CTURB_GL(3,14)=2.00D0
-	    CTURB_GL(3,15)=1.30D0
-	    CTURB_GL(3,16)=1.00D0
-
-	    CTURB_GL(4,1) =7.50D0
-	    CTURB_GL(4,2) =7.50D0
-	    CTURB_GL(4,3) =7.50D0
-	    CTURB_GL(4,4) =7.65D0	
-	    CTURB_GL(4,5) =7.65D0	
-	    CTURB_GL(4,6) =8.00D0	
-	    CTURB_GL(4,7) =8.00D0	
-	    CTURB_GL(4,8) =7.50D0	
-	    CTURB_GL(4,9) =6.50D0	
-	    CTURB_GL(4,10)=6.00D0	
-	    CTURB_GL(4,11)=5.00D0	
-	    CTURB_GL(4,12)=4.50D0	
-	    CTURB_GL(4,13)=4.00D0	
-	    CTURB_GL(4,14)=2.00D0	
-	    CTURB_GL(4,15)=1.30D0	
-	    CTURB_GL(4,16)=1.00D0	
-    
-	    CTURB_GL(5,1) =5.50D0
-	    CTURB_GL(5,2) =5.50D0
-	    CTURB_GL(5,3) =5.50D0
-	    CTURB_GL(5,4) =5.75D0
-	    CTURB_GL(5,5) =5.75D0
-	    CTURB_GL(5,6) =6.00D0
-	    CTURB_GL(5,7) =6.25D0
-	    CTURB_GL(5,8) =6.17D0
-	    CTURB_GL(5,9) =5.75D0
-	    CTURB_GL(5,10)=5.25D0
-	    CTURB_GL(5,11)=4.75D0
-	    CTURB_GL(5,12)=4.25D0
-	    CTURB_GL(5,13)=4.00D0
-	    CTURB_GL(5,14)=2.00D0
-	    CTURB_GL(5,15)=1.35D0
-	    CTURB_GL(5,16)=1.00D0
-	 
-	    CTURB_GL(6,1) =4.50D0
-	    CTURB_GL(6,2) =4.50D0
-	    CTURB_GL(6,3) =4.50D0
-	    CTURB_GL(6,4) =4.75D0	
-	    CTURB_GL(6,5) =4.75D0	
-	    CTURB_GL(6,6) =5.00D0	
-	    CTURB_GL(6,7) =5.25D0	
-	    CTURB_GL(6,8) =5.25D0	
-	    CTURB_GL(6,9) =5.00D0	
-	    CTURB_GL(6,10)=4.75D0	
-	    CTURB_GL(6,11)=4.50D0	
-	    CTURB_GL(6,12)=4.00D0	
-	    CTURB_GL(6,13)=3.75D0	
-	    CTURB_GL(6,14)=2.00D0	
-	    CTURB_GL(6,15)=1.40D0	
-	    CTURB_GL(6,16)=1.00D0	
-			 		
-	    CTURB_GL(7,1) =4.00D0
-	    CTURB_GL(7,2) =4.00D0
-	    CTURB_GL(7,3) =4.00D0
-	    CTURB_GL(7,4) =4.00D0
-	    CTURB_GL(7,5) =4.00D0
-	    CTURB_GL(7,6) =4.25D0
-	    CTURB_GL(7,7) =4.50D0
-	    CTURB_GL(7,8) =4.67D0
-	    CTURB_GL(7,9) =4.50D0
-	    CTURB_GL(7,10)=4.30D0
-	    CTURB_GL(7,11)=4.10D0
-	    CTURB_GL(7,12)=3.80D0
-	    CTURB_GL(7,13)=3.50D0
-	    CTURB_GL(7,14)=2.00D0
-	    CTURB_GL(7,15)=1.30D0
-	    CTURB_GL(7,16)=1.10D0
-
-	    CTURB_GL(8,1) =3.50D0
-	    CTURB_GL(8,2) =3.50D0
-	    CTURB_GL(8,3) =3.50D0
-	    CTURB_GL(8,4) =3.65D0
-	    CTURB_GL(8,5) =3.65D0
-	    CTURB_GL(8,6) =3.80D0
-	    CTURB_GL(8,7) =4.1D02
-	    CTURB_GL(8,8) =4.17D0
-	    CTURB_GL(8,9) =4.17D0
-	    CTURB_GL(8,10)=4.00D0
-	    CTURB_GL(8,11)=3.80D0
-	    CTURB_GL(8,12)=3.67D0
-	    CTURB_GL(8,13)=3.40D0
-	    CTURB_GL(8,14)=2.00D0
-	    CTURB_GL(8,15)=1.30D0
-	    CTURB_GL(8,16)=1.10D0
-
-	    CTURB_GL(9,1) =3.25D0
-	    CTURB_GL(9,2) =3.25D0
-	    CTURB_GL(9,3) =3.25D0
-	    CTURB_GL(9,4) =3.25D0
-	    CTURB_GL(9,5) =3.25D0
-	    CTURB_GL(9,6) =3.50D0
-	    CTURB_GL(9,7) =3.75D0
-	    CTURB_GL(9,8) =3.75D0
-	    CTURB_GL(9,9) =3.75D0
-	    CTURB_GL(9,10)=3.75D0
-	    CTURB_GL(9,11)=3.60D0
-	    CTURB_GL(9,12)=3.40D0
-	    CTURB_GL(9,13)=3.25D0
-	    CTURB_GL(9,14)=2.00D0
-	    CTURB_GL(9,15)=1.30D0
-	    CTURB_GL(9,16)=1.10D0
-	    
-	    CTURB_GL(10,1) =3.00D0
-	    CTURB_GL(10,2) =3.00D0
-	    CTURB_GL(10,3) =3.00D0
-	    CTURB_GL(10,4) =3.10D0
-	    CTURB_GL(10,5) =3.10D0
-	    CTURB_GL(10,6) =3.25D0
-	    CTURB_GL(10,7) =3.40D0
-	    CTURB_GL(10,8) =3.50D0
-	    CTURB_GL(10,9) =3.50D0
-	    CTURB_GL(10,10)=3.50D0
-	    CTURB_GL(10,11)=3.40D0
-	    CTURB_GL(10,12)=3.25D0
-	    CTURB_GL(10,13)=3.15D0
-	    CTURB_GL(10,14)=1.90D0
-	    CTURB_GL(10,15)=1.30D0
-	    CTURB_GL(10,16)=1.10D0
-
-	    CTURB_GL(11,1) =2.75D0
-	    CTURB_GL(11,2) =2.75D0
-	    CTURB_GL(11,3) =2.75D0
-	    CTURB_GL(11,4) =2.75D0
-	    CTURB_GL(11,5) =2.75D0
-	    CTURB_GL(11,6) =3.00D0
-	    CTURB_GL(11,7) =3.25D0
-	    CTURB_GL(11,8) =3.25D0
-	    CTURB_GL(11,9) =3.25D0
-	    CTURB_GL(11,10)=3.25D0
-	    CTURB_GL(11,11)=3.25D0
-	    CTURB_GL(11,12)=3.15D0
-	    CTURB_GL(11,13)=3.00D0
-	    CTURB_GL(11,14)=1.80D0
-	    CTURB_GL(11,15)=1.30D0
-	    CTURB_GL(11,16)=1.10D0
-
-	    CTURB_GL(12,1) =2.60D0
-	    CTURB_GL(12,2) =2.60D0
-	    CTURB_GL(12,3) =2.60D0
-	    CTURB_GL(12,4) =2.67D0
-	    CTURB_GL(12,5) =2.67D0
-	    CTURB_GL(12,6) =2.75D0
-	    CTURB_GL(12,7) =3.00D0
-	    CTURB_GL(12,8) =3.17D0
-	    CTURB_GL(12,9) =3.17D0
-	    CTURB_GL(12,10)=3.17D0
-	    CTURB_GL(12,11)=3.10D0
-	    CTURB_GL(12,12)=2.90D0
-	    CTURB_GL(12,13)=2.80D0
-	    CTURB_GL(12,14)=1.87D0
-	    CTURB_GL(12,15)=1.37D0
-	    CTURB_GL(12,16)=1.10D0
-
-	    CTURB_GL(13,1) =2.40D0
-	    CTURB_GL(13,2) =2.40D0
-	    CTURB_GL(13,3) =2.40D0
-	    CTURB_GL(13,4) =2.50D0
-	    CTURB_GL(13,5) =2.50D0
-	    CTURB_GL(13,6) =2.67D0
-	    CTURB_GL(13,7) =2.83D0
-	    CTURB_GL(13,8) =2.90D0
-	    CTURB_GL(13,9) =3.00D0
-	    CTURB_GL(13,10)=2.90D0
-	    CTURB_GL(13,11)=2.85D0
-	    CTURB_GL(13,12)=2.80D0
-	    CTURB_GL(13,13)=2.75D0
-	    CTURB_GL(13,14)=1.83D0
-	    CTURB_GL(13,15)=1.30D0
-	    CTURB_GL(13,16)=1.10D0
-
-	    CTURB_GL(14,1) =1.67D0
-	    CTURB_GL(14,2) =1.67D0
-	    CTURB_GL(14,3) =1.67D0
-	    CTURB_GL(14,4) =1.75D0
-	    CTURB_GL(14,5) =1.75D0
-	    CTURB_GL(14,6) =1.83D0
-	    CTURB_GL(14,7) =1.87D0
-	    CTURB_GL(14,8) =2.00D0
-	    CTURB_GL(14,9) =2.10D0
-	    CTURB_GL(14,10)=2.12D0
-	    CTURB_GL(14,11)=2.15D0
-	    CTURB_GL(14,12)=2.18D0
-	    CTURB_GL(14,13)=2.19D0
-	    CTURB_GL(14,14)=1.67D0
-	    CTURB_GL(14,15)=1.28D0
-	    CTURB_GL(14,16)=1.00D0
-
-	    CTURB_GL(15,1) =1.30D0
-	    CTURB_GL(15,2) =1.30D0
-	    CTURB_GL(15,3) =1.30D0
-	    CTURB_GL(15,4) =1.35D0
-	    CTURB_GL(15,5) =1.35D0
-	    CTURB_GL(15,6) =1.40D0
-	    CTURB_GL(15,7) =1.60D0
-	    CTURB_GL(15,8) =1.70D0
-	    CTURB_GL(15,9) =1.70D0
-	    CTURB_GL(15,10)=1.70D0
-	    CTURB_GL(15,11)=1.70D0
-	    CTURB_GL(15,12)=1.70D0
-	    CTURB_GL(15,13)=1.70D0
-	    CTURB_GL(15,14)=1.40D0
-	    CTURB_GL(15,15)=1.25D0
-	    CTURB_GL(15,16)=1.00D0
-
-	    CTURB_GL(16,1) =1.17D0
-	    CTURB_GL(16,2) =1.17D0
-	    CTURB_GL(16,3) =1.17D0
-	    CTURB_GL(16,4) =1.17D0
-	    CTURB_GL(16,5) =1.17D0
-	    CTURB_GL(16,6) =1.25D0
-	    CTURB_GL(16,7) =1.30D0
-	    CTURB_GL(16,8) =1.35D0
-	    CTURB_GL(16,9) =1.40D0
-	    CTURB_GL(16,10)=1.45D0
-	    CTURB_GL(16,11)=1.45D0
-	    CTURB_GL(16,12)=1.47D0
-	    CTURB_GL(16,13)=1.44D0
-	    CTURB_GL(16,14)=1.30D0
-	    CTURB_GL(16,15)=1.12D0
-	    CTURB_GL(16,16)=1.00D0
-          ENDIF
-          IF(IEPS_800.EQ.1.AND.IEPS_1600.EQ.1) THEN
-            DO I=1,K0G_GL
-               DO J=1,K0L_GL
-                  CTURB_GL(I,J)=CTURB_GL(I,J)*1.7D0
-               ENDDO
-            ENDDO 
-          ENDIF
-          DO J=1,K0L_GL
-             DO I=1,K0G_GL
-                CTURB_GL(I,J)=(CTURB_GL(I,J)-1.0D0)/1.5D0+1.0D0
-             ENDDO
-          ENDDO
-	  DO I=KRMING_GL,KRMAXG_GL
-             DO J=KRMINL_GL,KRMAXL_GL
-                CTURBGL(I,J)=1.
-             ENDDO
-          ENDDO
-          DO I=KRMING_GL,KRMAXG_GL                   
-             X_KERN=RADXXO(I,6)*1.0D4
-             IF(X_KERN.LT.RG_GL(1)) X_KERN=RG_GL(1)
-             IF(X_KERN.GT.RG_GL(K0G_GL)) X_KERN=RG_GL(K0G_GL) 
-             DO J=KRMINL_GL,KRMAXL_GL
-                Y_KERN=RADXXO(J,1)*1.0D4
-                IF(Y_KERN.LT.RL_GL(1)) Y_KERN=RL_GL(1)
-                IF(Y_KERN.GT.RL_GL(K0L_GL)) Y_KERN=RL_GL(K0L_GL)
-                CTURBGL(I,J)=F(X_KERN,Y_KERN,RG_GL,RL_GL,CTURB_GL &
-     &                      ,K0G_GL,K0L_GL)	      
-             ENDDO
-          ENDDO
-          IF(IEPS_800.EQ.1) THEN
-            DO I=KRMING_GL,15
-               DO J=KRMINL_GL,13
-                  IF(CTURBGL(I,J).LT.3.0D0) CTURBGL(I,J)=3.0D0
-               ENDDO
-            ENDDO
-          ENDIF
-          IF(IEPS_1600.EQ.1) THEN
-            DO I=KRMING_GL,15
-               DO J=KRMINL_GL,13
-                  IF(CTURBGL(I,J).LT.5.1D0) CTURBGL(I,J)=5.1D0
-               ENDDO
-            ENDDO
-          ENDIF
-	  DO I=1,33
-             DO J=1,24
-                IF(I.LE.14.AND.J.EQ.8) CTURBGL(I,J)=1.0D0
-                IF(I.GT.14.AND.J.LE.8) CTURBGL(I,J)=1.2D0
-	     ENDDO
-          ENDDO                       
-	RETURN
-	END SUBROUTINE TURBCOEF
-!===================================================================
-! QUESTION
-        real * 8 function f(x,y,x0,y0,table,k0,kk0)
-! two-dimensional linear interpolation of the collision efficiency
-! with help table(k0,kk0)
-
-       implicit none
-       integer k0,kk0,k,ir,kk,iq
-       double precision x,y,p,q,ec,ek
-!      double precision x,y,p,q,ec,ek,f
-       double precision x0(k0),y0(kk0),table(k0,kk0)
-
-
-        do k=2,k0
-           if(x.le.x0(k).and.x.ge.x0(k-1)) then
-             ir=k     
-           elseif(x.gt.x0(k0)) then
-             ir=k0+1
-           elseif(x.lt.x0(1)) then
-             ir=1
-           endif
-        enddo
-        do kk=2,kk0
-           if(y.le.y0(kk).and.y.ge.y0(kk-1)) iq=kk
-        enddo
-        if(ir.lt.k0+1) then
-          if(ir.ge.2) then
-            p =(x-x0(ir-1))/(x0(ir)-x0(ir-1))
-            q =(y-y0(iq-1))/(y0(iq)-y0(iq-1))
-            ec=(1.d0-p)*(1.d0-q)*table(ir-1,iq-1)+ &
-     &              p*(1.d0-q)*table(ir,iq-1)+ &
-     &              q*(1.d0-p)*table(ir-1,iq)+ &
-     &                   p*q*table(ir,iq)    
-          else
-            q =(y-y0(iq-1))/(y0(iq)-y0(iq-1))
-            ec=(1.d0-q)*table(1,iq-1)+q*table(1,iq)    
-          endif
-        else
-          q =(y-y0(iq-1))/(y0(iq)-y0(iq-1))
-          ek=(1.d0-q)*table(k0,iq-1)+q*table(k0,iq)
-          ec=min(ek,1.d0) 
-        endif
-        f=ec
-        return
-        end function f
-! function f
-                                                                            
-
-                                                                            
-
-!======================================================================
-        SUBROUTINE FREEZ(FF1,XL,FF2,XI,FF3,XS,FF4,XG,FF5,XH &
-     &,TIN,DT,RO,COL,AFREEZMY,BFREEZMY,BFREEZMAX,KRFREEZ,ICEMAX,NKR)       
-      IMPLICIT NONE 
-      INTEGER KR,ICE,ICE_TYPE
-      REAL COL,AFREEZMY,BFREEZMY,BFREEZMAX
-      INTEGER KRFREEZ,ICEMAX,NKR
-      REAL DT,RO,YKK,PF,PF_1,DEL_T,TT_DROP,ARG_1,YK2,DF1,BF,ARG_M, & 
-     & TT_DROP_AFTER_FREEZ,CFREEZ,SUM_ICE,TIN,TTIN,AF,FF_MAX,F1_MAX, &
-     & F2_MAX,F3_MAX,F4_MAX,F5_MAX
-
-
-	REAL FF1(NKR),XL(NKR),FF2(NKR,ICEMAX) &
-     &           ,XI(NKR,ICEMAX),FF3(NKR),XS(NKR),FF4(NKR) &
-     &           ,XG(NKR),FF5(NKR),XH(NKR)
-
-
-
-	TTIN=TIN
-        DEL_T	=TTIN-273.15
-	ICE_TYPE=2
-	F1_MAX=0.
-	F2_MAX=0.
-	F3_MAX=0.
-	F4_MAX=0.
-	F5_MAX=0.
-	DO 1 KR=1,NKR
-	F1_MAX=AMAX1(F1_MAX,FF1(KR))
-	F3_MAX=AMAX1(F3_MAX,FF3(KR))
-	F4_MAX=AMAX1(F4_MAX,FF4(KR))
-	F5_MAX=AMAX1(F5_MAX,FF5(KR))
-	DO 1 ICE=1,ICEMAX
-     	F2_MAX=AMAX1(F2_MAX,FF2(KR,ICE))
-    1   CONTINUE
-    	FF_MAX=AMAX1(F2_MAX,F3_MAX,F4_MAX,F5_MAX)
-!
-!******************************* FREEZING ****************************
-!
-        IF(DEL_T.LT.0.AND.F1_MAX.NE.0) THEN
-	SUM_ICE=0.
-	AF	=AFREEZMY
-	CFREEZ	=(BFREEZMAX-BFREEZMY)/XL(NKR)
-!
-!***************************** MASS LOOP **************************
-!
-         DO  KR	=1,NKR
-	 ARG_M	=XL(KR)
-	 BF	=BFREEZMY+CFREEZ*ARG_M
-         PF_1	=AF*EXP(-BF*DEL_T)
-         PF	=ARG_M*PF_1
-	 YKK	=EXP(-PF*DT)
-         DF1	=FF1(KR)*(1.-YKK)
-	 YK2	=DF1
-         FF1(KR)=FF1(KR)*YKK
-	 IF(KR.LE.KRFREEZ)  THEN
-	 FF2(KR,ICE_TYPE)=FF2(KR,ICE_TYPE)+YK2
-			    ELSE
-	  FF5(KR)	=FF5(KR)+YK2
-	 ENDIF
-         SUM_ICE=SUM_ICE+YK2*3.*XL(KR)*XL(KR)*COL
-!
-!************************ END OF "MASS LOOP" **************************
-!
-	 ENDDO
-!
-!************************** NEW TEMPERATURE *************************
-!	
-	ARG_1	=333.*SUM_ICE/RO
-      	TT_DROP_AFTER_FREEZ=TTIN+ARG_1
-	TIN	=TT_DROP_AFTER_FREEZ
-!
-!************************** END OF "FREEZING" ****************************
-!
-	ENDIF
-!
-   	RETURN                                                           
-      	END SUBROUTINE FREEZ                                                             
+            print*,   'i,j,k,kp'
+            print*,    i,j,k,kp
 
-        SUBROUTINE ORIG_MELT(FF1,XL,FF2,XI,FF3,XS,FF4,XG,FF5,XH &
-     &                           ,TIN,DT,RO,COL,ICEMAX,NKR)
-      IMPLICIT NONE
-      INTEGER KR,ICE,ICE_TYPE
-      INTEGER ICEMAX,NKR
-      REAL COL
-      REAL ARG_M,TT_DROP,ARG_1,TT_DROP_AFTER_FREEZ,DT,DF1,DN,DN0, &
-     & RO,A,B,DTFREEZ,SUM_ICE,FF_MAX,F1_MAX,F2_MAX,F3_MAX,F4_MAX,F5_MAX, &
-     & DEL_T,gamma,TIN
-        REAL FF1(NKR),XL(NKR),FF2(NKR,ICEMAX),XI(NKR,ICEMAX) &
-     &           ,FF3(NKR),XS(NKR),FF4(NKR) &
-     &           ,XG(NKR),FF5(NKR),XH(NKR)
-
-
-        gamma=4.4
-        DEL_T	=TIN-273.15
-	ICE_TYPE=2
-	F1_MAX=0.
-	F2_MAX=0.
-	F3_MAX=0.
-	F4_MAX=0.
-	F5_MAX=0.
-	DO 1 KR=1,NKR
-	F1_MAX=AMAX1(F1_MAX,FF1(KR))
-	F3_MAX=AMAX1(F3_MAX,FF3(KR))
-	F4_MAX=AMAX1(F4_MAX,FF4(KR))
-	F5_MAX=AMAX1(F5_MAX,FF5(KR))
-	DO 1 ICE=1,ICEMAX
-     	F2_MAX=AMAX1(F2_MAX,FF2(KR,ICE))
-    1	CONTINUE
-    	FF_MAX=AMAX1(F2_MAX,F3_MAX,F4_MAX,F5_MAX)
-! MELTING :
-	IF(DEL_T.GE.0.AND.FF_MAX.NE.0) THEN
-	  SUM_ICE=0.
-! MASS LOOP :
-  	  DO KR=1,NKR
-	     ARG_M=FF3(KR)+FF4(KR)+FF5(KR)
-	     DO ICE=1,ICEMAX
-	        ARG_M=ARG_M+FF2(KR,ICE)
-      	        FF2(KR,ICE)=0.
- 	     ENDDO
-      	     FF1(KR)=FF1(KR)+ARG_M
-      	     FF3(KR)=0.
-             FF4(KR)=0.
-      	     FF5(KR)=0.
-	     SUM_ICE=SUM_ICE+ARG_M*3.*XL(KR)*XL(KR)*COL
-! END OF "MASS LOOP"
-	  ENDDO
-! CYCLE BY KR
-! NEW TEMPERATURE :
-	  ARG_1=333.*SUM_ICE/RO	
-	  TIN=TIN-ARG_1
-! END OF MELTING
-! IN CASE DEL_T.GE.0.AND.FF_MAX.NE.0
-	ENDIF
-   	RETURN                                                           
-      	END SUBROUTINE ORIG_MELT                                                             
-!===================================================================
-       SUBROUTINE J_W_MELT(FF1,XL,FF2,XI,FF3,XS,FF4,XG,FF5,XH &
-     &                           ,TIN,DT,RO,COL,ICEMAX,NKR)
-      IMPLICIT NONE
-      INTEGER KR,ICE,ICE_TYPE
-      INTEGER ICEMAX,NKR
-      REAL COL
-      REAL ARG_M,TT_DROP,ARG_1,TT_DROP_AFTER_FREEZ,DT,DF1,DN,DN0, &
-     & RO,A,B,DTFREEZ,SUM_ICE,FF_MAX,F1_MAX,F2_MAX,F3_MAX,F4_MAX,F5_MAX, &
-     & DEL_T,TIN,meltrate
-        REAL FF1(NKR),XL(NKR),FF2(NKR,ICEMAX),XI(NKR,ICEMAX) &
-     &           ,FF3(NKR),XS(NKR),FF4(NKR) &
-     &           ,XG(NKR),FF5(NKR),XH(NKR)
-
-
-!       gamma=4.4
-        DEL_T	=TIN-273.15
-	F1_MAX=0.
-	F2_MAX=0.
-	F3_MAX=0.
-	F4_MAX=0.
-	F5_MAX=0.
-	DO 1 KR=1,NKR
-	F1_MAX=AMAX1(F1_MAX,FF1(KR))
-	F3_MAX=AMAX1(F3_MAX,FF3(KR))
-	F4_MAX=AMAX1(F4_MAX,FF4(KR))
-	F5_MAX=AMAX1(F5_MAX,FF5(KR))
-	DO 1 ICE=1,ICEMAX
-     	F2_MAX=AMAX1(F2_MAX,FF2(KR,ICE))
-    1	CONTINUE
-    	FF_MAX=AMAX1(F2_MAX,F3_MAX,F4_MAX,F5_MAX)
-! MELTING :
-	SUM_ICE=0.
-	IF(DEL_T.GE.0.AND.FF_MAX.NE.0) THEN
-! Fan's "MASS LOOP"
-          DO KR = 1,NKR
-          ARG_M = 0.
-            DO ICE = 1,ICEMAX
-             IF (ICE ==1) THEN
-                 IF (KR .le. 10) THEN
-                     ARG_M = ARG_M+FF2(KR,ICE)
-                     FF2(KR,ICE)=0.
-                 ELSEIF (KR .gt. 10 .and. KR .lt. 18) THEN
-                     meltrate = 0.5/50.
-                     ARG_M=ARG_M+FF2(KR,ICE)*(meltrate*dt)
-                     FF2(KR,ICE)=FF2(KR,ICE)-FF2(KR,ICE)*(meltrate*dt)
-                 ELSE
-                     meltrate = 0.683/120.
-                     ARG_M=ARG_M+FF2(KR,ICE)*(meltrate*dt)
-                     FF2(KR,ICE)=FF2(KR,ICE)-FF2(KR,ICE)*(meltrate*dt)
-                 ENDIF
-             ENDIF
-             IF (ICE ==2 .or. ICE ==3) THEN
-                IF (kr .le. 12) THEN
-                    ARG_M = ARG_M+FF2(KR,ICE)
-                    FF2(KR,ICE)=0.
-                ELSEIF (kr .gt. 12 .and. kr .lt. 20) THEN
-                    meltrate = 0.5/50.
-                    ARG_M=ARG_M+FF2(KR,ICE)*(meltrate*dt)
-                    FF2(KR,ICE)=FF2(KR,ICE)-FF2(KR,ICE)*(meltrate*dt)
-                 ELSE
-                    meltrate = 0.683/120.
-                    ARG_M=ARG_M+FF2(KR,ICE)*(meltrate*dt)
-                    FF2(KR,ICE)=FF2(KR,ICE)-FF2(KR,ICE)*(meltrate*dt)
-                 ENDIF
-             ENDIF
-            ENDDO  ! Do ice
-! snow
-                 IF (kr .le. 14) THEN
-                    ARG_M = ARG_M+FF3(KR)
-                    FF3(KR)=0.
-                 ELSEIF (kr .gt. 14 .and. kr .lt. 22) THEN
-                    meltrate = 0.5/50.
-                    ARG_M=ARG_M+FF3(KR)*(meltrate*dt)
-                    FF3(KR)=FF3(KR)-FF3(KR)*(meltrate*dt)
-                 ELSE
-                    meltrate = 0.683/120.
-                    ARG_M=ARG_M+FF3(KR)*(meltrate*dt)
-                    FF3(KR)=FF3(KR)-FF3(KR)*(meltrate*dt)
-                 ENDIF
-! graupel/hail
-                 IF (kr .le. 13) then
-                     ARG_M = ARG_M+FF4(KR)+FF5(KR)
-                     FF4(KR)=0.
-                     FF5(KR)=0.
-                 ELSEIF (kr .gt. 13 .and. kr .lt. 23) THEN
-                     meltrate = 0.5/50.
-                     ARG_M=ARG_M+(FF4(KR)+FF5(KR))*(meltrate*dt)
-                     FF4(KR)=FF4(KR)-FF4(KR)*(meltrate*dt)
-                     FF5(KR)=FF5(KR)-FF5(KR)*(meltrate*dt)
-                 ELSE
-                    meltrate = 0.683/120.
-                    ARG_M=ARG_M+(FF4(KR)+FF5(KR))*(meltrate*dt)
-                    FF4(KR)=FF4(KR)-FF4(KR)*(meltrate*dt)
-                    FF5(KR)=FF5(KR)-FF5(KR)*(meltrate*dt)
-                 ENDIF
+            print*,   'jx0,jx1,iy0,iy1'
+            print*,    jx0,jx1,iy0,iy1
 
-                   FF1(KR)=FF1(KR)+ARG_M
+            print*,   'gz_kp_old'
+            print 201, gz_kp_old
 
-                   SUM_ICE=SUM_ICE+ARG_M*3.*XL(KR)*XL(KR)*COL
-! END OF Fan'a "MASS LOOP"
-       ENDDO
-! CYCLE BY KR
-! NEW TEMPERATURE :
-        ARG_1=333.*SUM_ICE/RO
-        TIN=TIN-ARG_1
-! END OF MELTING
+            print*,   'x01,x02,x03'
+            print 203, x01,x02,x03
 
-	ENDIF
-   	RETURN                                                           
-      	END SUBROUTINE J_W_MELT                                                             
-!===================================================================
-      SUBROUTINE JERNUCL01(PSI1,PSI2,FCCNR &
-     &                    ,X1,X2,DTT,DQQ,ROR,PP,DSUP1,DSUP2 &
-     &  ,COL,AA1_MY, BB1_MY, AA2_MY, BB2_MY &
-     &  ,C1_MEY,C2_MEY,SUP2_OLD,DSUPICEXZ &
-     &  ,RCCN,DROPRADII,NKR,ICEMAX,ICEPROCS)
-      IMPLICIT NONE 
-!
-      INTEGER ICEMAX,NKR
-      INTEGER ICEPROCS
-      REAL COL,AA1_MY, BB1_MY, AA2_MY, BB2_MY, &
-     &  C1_MEY,C2_MEY,SUP2_OLD,DSUPICEXZ, &
-     &  RCCN(NKR),DROPRADII(NKR),FCCNR(NKR)
-!
-      INTEGER KR,ICE,ITYPE,NRGI,ICORR,II,JJ,KK,NKRDROP,NCRITI
-       DOUBLE PRECISION DTT,DQQ,DSUP1,DSUP2
-       REAL TT,QQ,              &
-     & DX,BMASS,CONCD,C2,CONCDF,DELTACD,CONCDIN,ROR, &
-     & DELTAF,DELMASSL,FMASS,HELEK1,DEL2NN,FF1BN, &
-     & HELEK2,TPCC,PP,ADDF,DSUP2N,FACT,EW1N,ES2N,ES1N,FNEW, &
-     & C1,SUP1N,SUP2N,QPN,TPN,TPC,SUP1,SUP2,DEL1N,DEL2N,AL1,AL2, &
-     & TEMP1,TEMP2,TEMP3,A1,B1,A2,B2 
-!
+            print*,   'gsi,gsj,gsk'
+            print 203, gsi,gsj,gsk
 
-!********************************************************************
+            print*,   'gsi_w,gsj_w,gsk_w'
+            print 203, gsi_w,gsj_w,gsk_w
 
-! NEW MEYERS IN JERNUCL01 SUBROUTINE 
+            print*,   'gk,gk_w'
+            print 202, gk,gk_w
 
+            print*,   'fl_gk,fl_gsk'
+            print 202, fl_gk,fl_gsk
 
+            print*,   'x1,c(i,j)'
+            print 202, x1,c(i,j)
 
-!********************************************************************
+            print*,   'flux'
+            print 201, flux
 
+            print*,   'flux_w'
+            print 201, flux_w
 
+            print*,   'gz_k_w'
+            print 201, gz_k_w
 
-      REAL PSI1(NKR),X1(NKR),DROPCONCN(NKR) &
-     &     ,PSI2(NKR,ICEMAX),X2(NKR,ICEMAX)
-      
+            print*,   'gz_kp_w'
+            print 204, gz_kp_w
 
-      DATA A1,B1,A2,B2/-0.639,0.1296,-2.8,0.262/
-      DATA TEMP1,TEMP2,TEMP3/-5.,-2.,-20./
-      DATA AL1/2500./,AL2/2834./
-      SUP1=DSUP1
-      SUP2=DSUP2
+            if(flz(k).lt.0.0d0) print*, &
+            'stop 2022: in subroutine coll_xyz_lwf, flz(k) < 0'
 
+            if(flz(kp).lt.0.0d0) print*, &
+               'stop 2022: in subroutine coll_xyz_lwf, flz(kp) < 0'
 
-      TT=DTT
-      QQ=DQQ
-! DROPLETS NUCLEATION (BEGIN)
+            if(flz(k).gt.1.0001d0) print*, &
+               'stop 2022: in sub. coll_xyz_lwf, flz(k) > 1.0001'
 
-        TPN=TT
-        QPN=QQ
+            if(flz(kp).gt.1.0001d0) print*, &
+               'stop 2022: in sub. coll_xyz_lwf, flz(kp) > 1.0001'
+              call wrf_error_fatal("fatal error: in sub. coll_xyz_lwf,model stop")
+            endif
+2021         continue
+         enddo
+! cycle by j
+2020      continue
+      enddo
+! cycle by i
+
+201    format(1x,d13.5)
+202    format(1x,2d13.5)
+203    format(1x,3d13.5)
+204    format(1x,4d13.5)
+
+ return
+ end subroutine coll_xyz_lwf
+! -----------------------------------------------+
+ subroutine coll_xxy_lwf(gx,gy,flx,fly,ckxx,x, &
+                        c,ima,prdkrn,nkr)
+
+  implicit none
+
+  integer,intent(in) :: nkr
+  real(kind=r8size),intent(inout):: gx(nkr),gy(nkr),flx(nkr),fly(nkr)
+  real(kind=r8size),intent(in) :: x(nkr),ckxx(nkr,nkr),c(nkr,nkr)
+  real(kind=r8size),intent(in) :: prdkrn
+  integer,intent(in) :: ima(nkr,nkr)
+
+! ... Locals
+  real(kind=r8size) :: gmin,ckxx_ij,x01,x02,x03,gsi,gsj,gsk,gsi_w,gsj_w,gsk_w, &
+                       gk,gk_w,flux,flux_w,fl_gk,fl_gsk,x1,gy_k_w,gy_kp_w, &
+                       gy_kp_old
+  integer::i,ix0,ix1,j,k,kp
+! ... Locals
+
+!gmin=g_lim*1.0d3
+gmin = 1.0d-60
+
+! ix0 - lower limit of integration by i
+do i=1,nkr-1
+   ix0=i
+   if(gx(i).gt.gmin) goto 2000
+enddo
+2000   continue
+if(ix0.eq.nkr-1) return
+
+! ix1 - upper limit of integration by i
+do i=nkr-1,ix0,-1
+   ix1=i
+   if(gx(i).gt.gmin) goto 2010
+enddo
+2010   continue
+
+! ... collisions
+      do i=ix0,ix1
+         if(gx(i).le.gmin) goto 2020
+         do j=i,ix1
+            if(gx(j).le.gmin) goto 2021
+            k=ima(i,j)
+            kp=k+1
+            ckxx_ij = ckxx(i,j)
+            x01=ckxx_ij*gx(i)*gx(j)*prdkrn
+            x02=dmin1(x01,gx(i)*x(j))
+            x03=dmin1(x02,gx(j)*x(i))
+            gsi=x03/x(j)
+            gsj=x03/x(i)
+            gsk=gsi+gsj
+
+            if(gsk.le.gmin) goto 2021
+
+            gsi_w=gsi*flx(i)
+            gsj_w=gsj*flx(j)
+            gsk_w=gsi_w+gsj_w
+            gsk_w=dmin1(gsk_w,gsk)
+
+            gx(i)=gx(i)-gsi
+            gx(i)=dmax1(gx(i),0.0d0)
+
+            gx(j)=gx(j)-gsj
+            gx(j)=dmax1(gx(j),0.0d0)
+
+            gk=gy(k)+gsk
+
+            if(gk.le.gmin) goto 2021
+
+            gk_w=gy(k)*fly(k)+gsk_w
+            gk_w=dmin1(gk_w,gk)
+            fl_gk=gk_w/gk
+            fl_gsk=gsk_w/gsk
+
+            flux=0.d0
+
+            x1=dlog(gy(kp)/gk+1.d-15)
+            !		print *,'nir1',gy(kp),gk,kp,i,j
+            flux=gsk/x1*(dexp(0.5d0*x1)-dexp(x1*(0.5d0-c(i,j))))
+            flux=dmin1(flux,gsk)
+            flux=dmin1(flux,gk)
+
+            if(kp.gt.kp_flux_max) flux=0.5d0*flux
+
+            flux_w=flux*fl_gsk
+            flux_w=dmin1(flux_w,gk_w)
+            flux_w=dmin1(flux_w,gsk_w)
+            flux_w=dmax1(flux_w,0.0d0)
+
+            gy(k)=gk-flux
+            gy_k_w=gk*fl_gk-flux_w
+            gy_k_w=dmin1(gy_k_w,gy(k))
+            gy_k_w=dmax1(gy_k_w,0.0d0)
+            !		print *,'nirxxylwf4',k,gy(k),gy_k_w,x1,flux
+            if (gy(k)/=0.0) then
+              fly(k)=gy_k_w/gy(k)
+            else
+              fly(k)=0.0d0
+            endif
+            gy_kp_old=gy(kp)
+            gy(kp)=gy(kp)+flux
+            gy_kp_w=gy_kp_old*fly(kp)+flux_w
+            gy_kp_w=dmin1(gy_kp_w,gy(kp))
+            if (gy(kp)/=0.0) then
+              fly(kp)=gy_kp_w/gy(kp)
+            else
+              fly(kp)=0.0d0
+            endif
+2021  continue
 
-        DEL1N=100.*SUP1
-        TPC=TT-273.15
+      if(fly(k).gt.1.0d0.and.fly(k).le.1.0001d0) &
+          fly(k)=1.0d0
 
-        IF(DEL1N.GT.0.AND.TPC.GT.-30.) THEN
-         CALL WATER_NUCL (PSI1,FCCNR,X1,TT,SUP1  &
-     &        ,COL,RCCN,DROPRADII,NKR,ICEMAX)
-        ENDIF
-! DROPLETS NUCLEATION (END)
-! drop nucleation                                               (end)
-! nucleation of crystals                                      (begin)
+        if(fly(kp).gt.1.0d0.and.fly(kp).le.1.0001d0) &
+          fly(kp)=1.0d0
 
-       IF (ICEPROCS.EQ.1)THEN
-        DEL2N=100.*SUP2
-        IF(TPC.LT.0..AND.TPC.GE.-35..AND.DEL2N.GT.0.) THEN
+         end do
+! cycle by j
+2020      continue
+      end do
+! cycle by i
+
+ return
+ end subroutine coll_xxy_lwf
+! +-------------------------------------------------------------------------------+
+					subroutine modkrn_KS (tt,qq,pp,rho,factor_t,ttcoal,ICase,Icondition, &
+             										Iin,Jin,Kin)
+
+					implicit none
+
+					real(kind=r8size),intent(in) :: tt, pp
+          real(kind=r8size),intent(inout) :: qq
+					real(kind=r4size),intent(in) :: ttcoal, rho
+					real(kind=r8size),intent(out) :: factor_t
+					integer :: ICase, Iin, Jin, Kin, Icondition
+
+					real(kind=r8size) :: satq2, temp, epsf, tc, ttt1, ttt, qs2, qq1, dele, tc_min, &
+                        				tc_max, factor_max, factor_min, f, t, a, b, c, p, d
+					real(kind=r8size) :: at, bt, ct, dt
+					real(kind=r8size) :: AA,BB,CC,DD,Es,Ew,AA1_MY,BB1_MY
+					real(kind=r4size) :: tt_r
+
+					satq2(t,p) = 3.80d3*(10**(9.76421d0-2667.1d0/t))/p
+					temp(a,b,c,d,t) = d*t*t*t+c*t*t+b*t+a
+
+					SELECT CASE (ICase)
+
+					CASE(1)
+
+					!satq2(t,p) = 3.80d3*(10**(9.76421d0-2667.1d0/t))/p
+					!temp(a,b,c,d,t) = d*t*t*t+c*t*t+b*t+a
+
+	  			data at, bt, ct, dt /0.88333d0,  0.0931878d0,  0.0034793d0,  4.5185186d-05/
+
+    			if(qq.le.0.0) qq = 1.0e-15
+    				epsf = 0.5d0
+    				tc = tt - 273.15
+
+				    ttt1	=temp(at,bt,ct,dt,tc)
+					  ttt	=ttt1
+				    qs2	=satq2(tt,pp)
+				    qq1	=qq*(0.622d0+0.378d0*qs2)/(0.622d0+0.378d0*qq)/qs2
+				    dele	=ttt*qq1
+
+						if(tc.ge.-6.0d0) then
+							factor_t = dele
+							if(factor_t.lt.epsf) factor_t = epsf
+							if(factor_t.gt.1.0d0) factor_t = 1.0d0
+						endif
+
+				  	if (Icondition == 0) then
+				  		if(tc.ge.-12.5d0 .and. tc.lt.-6.0d0) factor_t = 0.5D0  ! 0.5d0 !### (KS-ICE-SNOW)
+				  		if(tc.ge.-17.0d0 .and. tc.lt.-12.5d0) factor_t = 1.0
+				  		if(tc.ge.-20.0d0 .and. tc.lt.-17.0d0) factor_t = 0.4d0
+				  	else
+				  		if(tc.ge.-12.5d0 .and. tc.lt.-6.0d0) factor_t = 0.3D0  ! 0.5d0 !### (KS-ICE-SNOW)
+				  		if(tc.ge.-17.0d0 .and. tc.lt.-12.5d0) factor_t = 0.1d0
+				  		if(tc.ge.-20.0d0 .and. tc.lt.-17.0d0) factor_t = 0.05d0
+				  	endif
+
+				   if(tc.lt.-20.0d0) then
+			  		tc_min = ttcoal-273.15d0
+			  		tc_max = -20.0d0
+			  		if(Icondition == 0)then
+			  			factor_max = 0.4d0
+			  			factor_min = 0.0d0
+			  		else
+			  			factor_max = 0.05d0
+			  			factor_min = 0.0d0
+			  		endif
+
+      			f = factor_min + (tc-tc_min)*(factor_max-factor_min)/ &
+								     				(tc_max-tc_min)
+						factor_t = f
+					! in case tc.lt.-20.0d0
+					endif
+
+					if(tc.lt.-40.0d0) then
+						factor_t = 0.0d0
+					endif
+
+					if (factor_t > 1.0) factor_t = 1.0
+
+					if(tc.ge.0.0d0) then
+						factor_t = 1.0d0
+					endif
+
+					END SELECT
+
+			  return
+			  end subroutine modkrn_KS
+  ! +-----------------------------------------------------------+
+  subroutine coll_breakup_KS (gt_mg, xt_mg, jmax, dt, jbreak, &
+                              PKIJ, QKJ, NKRinput, NKR)
+
+    implicit none
+  ! ... Interface
+    integer,intent(in) :: jmax, jbreak, NKRInput, NKR
+    real(kind=r8size),intent(in) :: xt_mg(:), dt
+    real(kind=r4size),intent(in) :: pkij(:,:,:),qkj(:,:)
+    real(kind=r8size),intent(inout) :: gt_mg(:)
+  ! ... Interface
+
+  ! ... Locals
+  ! ke = jbreak
+  integer,parameter :: ia=1, ja=1, ka=1
+  integer :: ie, je, ke, nkrdiff, jdiff, k, i, j
+  real(kind=r8size),parameter :: eps = 1.0d-20
+  real(kind=r8size) :: gt(jmax), xt(jmax+1), ft(jmax), fa(jmax), dg(jmax), df(jmax), dbreak(jbreak) &
+                     ,amweight(jbreak), gain, aloss
+  ! ... Locals
+
+  ie=jbreak
+  je=jbreak
+  ke=jbreak
+
+  !input variables
+
+  ! gt_mg : mass distribution function of Bott
+  ! xt_mg : mass of bin in mg
+  ! jmax  : number of bins
+  ! dt    : timestep in s
+
+  !in CGS
+
+  nkrdiff = nkrinput-nkr
+  do j=1,jmax
+  xt(j)=xt_mg(j)
+  gt(j)=gt_mg(j)
+  ft(j)=gt(j)/xt(j)/xt(j)
+  enddo
+
+  !shift between coagulation and breakup grid
+  jdiff=jmax-jbreak
+
+  !initialization
+  !shift to breakup grid
+  fa = 0.0
+  do k=1,ke-nkrdiff
+    fa(k)=ft(k+jdiff+nkrdiff)
+  enddo
+
+  !breakup: bleck's first order method
+  !pkij: gain coefficients
+  !qkj : loss coefficients
+
+  xt(jmax+1)=xt(jmax)*2.0d0
+
+  amweight = 0.0
+  dbreak = 0.0
+  do k=1,ke-nkrdiff
+    gain=0.0d0
+    do i=1,ie-nkrdiff
+      do j=1,i
+        gain=gain+fa(i)*fa(j)*pkij(k,i,j)
+      enddo
+    enddo
+    aloss=0.0d0
+    do j=1,je-nkrdiff
+      aloss=aloss+fa(j)*qkj(k,j)
+    enddo
+    j=jmax-jbreak+k+nkrdiff
+    amweight(k)=2.0/(xt(j+1)**2.0-xt(j)**2.0)
+    dbreak(k)=amweight(k)*(gain-fa(k)*aloss)
+
+    if(dbreak(k) .ne. dbreak(k)) then
+      print*,dbreak(k),amweight(k),gain,fa(k),aloss
+      print*,"-"
+      print*,dbreak
+      print*,"-"
+      print*,amweight
+      print*,"-"
+      print*,j,jmax,jbreak,k,nkrdiff
+      print*,"-"
+      print*,fa
+      print*,"-"
+      print*,xt
+      print*,"-"
+      print*,gt
+      call wrf_error_fatal(" inside coll_breakup, NaN, model stop")
+    endif
+  enddo
+
+  !shift rate to coagulation grid
+  df = 0.0d0
+  do j=1,jdiff+nkrdiff
+    df(j)=0.0d0
+  enddo
+
+  do j=1,ke-nkrdiff
+    df(j+jdiff)=dbreak(j)
+  enddo
+
+  !transformation to mass distribution function g(ln x)
+  do j=1,jmax
+    dg(j)=df(j)*xt(j)*xt(j)
+  enddo
+
+  !time integration
+
+  do j=1,jmax
+    gt(j)=gt(j)+dg(j)*dt
+  !	if(gt(j)<0.0) then
+    !print*, 'gt(j) < 0'
+    !print*, 'j'
+    !print*,  j
+    !print*, 'dg(j),dt,gt(j)'
+    !print*,  dg(j),dt,gt(j)
+    !hlp=dmin1(gt(j),hlp)
+  !	gt(j) = eps
+  !	print*,'kr',j
+  !	print*,'gt',gt
+  !	print*,'dg',dg
+  !	print*,'gt_mg',gt_mg
+    !stop "in coll_breakup_ks gt(kr) < 0.0 "
+  !	endif
+  enddo
+
+   gt_mg = gt
+
+  return
+  end subroutine coll_breakup_KS
+  ! +----------------------------------------------------+
+  subroutine courant_bott_KS(xl, nkr, chucm, ima, scal)
+
+    implicit none
+
+    integer,intent(in) :: nkr
+    real,intent(in) :: xl(:)
+    real(kind=r8size),intent(inout) :: chucm(:,:)
+    integer,intent(inout) :: ima(:,:)
+    real(kind=r8size),intent(in) :: scal
+
+    ! ... Locals
+    integer :: k, kk, j, i
+    real(kind=r8size) :: x0, xl_mg(nkr), dlnr
+    ! ... Locals
+
+    ! ima(i,j) - k-category number,
+    ! chucm(i,j)   - courant number :
+    ! logarithmic grid distance(dlnr) :
+
+      !xl_mg(0)=xl_mg(1)/2
+      xl_mg(1:nkr) = xl(1:nkr)*1.0D3
+
+      dlnr=dlog(2.0d0)/(3.0d0*scal)
+
+      do i = 1,nkr
+         do j = i,nkr
+            x0 = xl_mg(i) + xl_mg(j)
+            do k = j,nkr
+              !if(k == 1) goto 1000 ! ### (KS)
+               kk = k
+               if(k == 1) goto 1000
+               if(xl_mg(k) >= x0 .and. xl_mg(k-1) < x0) then
+                 chucm(i,j) = dlog(x0/xl_mg(k-1))/(3.d0*dlnr)
+                 if(chucm(i,j) > 1.0d0-1.d-08) then
+                   chucm(i,j) = 0.0d0
+                   kk = kk + 1
+                 endif
+                 ima(i,j) = min(nkr-1,kk-1)
+                 !if (ima(i,j) == 0) then
+                 !	print*,"ima==0"
+                 !endif
+                 goto 2000
+               endif
+               1000 continue
+            enddo
+            2000  continue
+            !if(i.eq.nkr.or.j.eq.nkr) ima(i,j)=nkr
+            chucm(j,i) = chucm(i,j)
+            ima(j,i) = ima(i,j)
+         enddo
+      enddo
 
-              CALL ICE_NUCL (PSI2,X2,TT,ROR,SUP2,SUP2_OLD &
-     &                      ,C1_MEY,C2_MEY,COL,DSUPICEXZ &
-     &                      ,NKR,ICEMAX)
-        ENDIF
-       ENDIF
-! nucleation of crystals                                        (end)
-! new change in drop nucleation                               (begin)
-! no sink of water vapour by nucleation
-      RETURN
-      END SUBROUTINE JERNUCL01
+      return
+      end subroutine courant_bott_KS
+  ! +----------------------------------+
+end module module_mp_SBM_Collision
+! +-----------------------------------------------------------------------------+
+! +-----------------------------------------------------------------------------+
+ module module_mp_SBM_Auxiliary
+
+ private
+ public :: POLYSVP, JERRATE_KS, JERTIMESC_KS, JERSUPSAT_KS, &
+ 		       JERDFUN_KS, JERDFUN_NEW_KS, Relaxation_Time
+
+ ! Kind paramater
+ INTEGER, PARAMETER, PRIVATE:: R8SIZE = 8
+ INTEGER, PARAMETER, PRIVATE:: R4SIZE = 4
+
+ INTEGER,PARAMETER :: ISIGN_KO_1 = 0, ISIGN_KO_2 = 0,  ISIGN_3POINT = 1,  &
+                      IDebug_Print_DebugModule = 1
+ DOUBLE PRECISION,PARAMETER::COEFF_REMAPING = 0.0066667D0
+ DOUBLE PRECISION,PARAMETER::VENTPL_MAX = 5.0D0
+
+ DOUBLE PRECISION,PARAMETER::RW_PW_MIN = 1.0D-10
+ DOUBLE PRECISION,PARAMETER::RI_PI_MIN = 1.0D-10
+ DOUBLE PRECISION,PARAMETER::RW_PW_RI_PI_MIN = 1.0D-10
+ DOUBLE PRECISION,PARAMETER::RATIO_ICEW_MIN = 1.0D-4
+
+ contains
+! +---------------------------------------------+
+     double precision FUNCTION POLYSVP (T,TYPE)
+! ..................................
+!  COMPUTE SATURATION VAPOR PRESSURE
+
+!  POLYSVP RETURNED IN UNITS OF PA.
+!  T IS INPUT IN UNITS OF K.
+!  TYPE REFERS TO SATURATION WITH RESPECT TO LIQUID (0) OR ICE (1)
+
+! REPLACE GOFF-GRATCH WITH FASTER FORMULATION FROM FLATAU ET AL. 1992, TABLE 4 (RIGHT-HAND COLUMN)
+! +------------------------------------------------------------------------------------------------+
 
-! SUBROUTINE JERNUCL01
-!======================================================================      
-      SUBROUTINE WATER_NUCL (PSI1,FCCNR,X1,TT,SUP1 &
-     &,COL,RCCN,DROPRADII,NKR,ICEMAX)
       IMPLICIT NONE
-      INTEGER NDROPMAX,KR,ICEMAX,NKR
-      REAL PSI1(NKR),FCCNR(NKR),X1(NKR)
-      REAL DROPCONCN(NKR)
-      REAL RCCN(NKR),DROPRADII(NKR)
-      REAL TT,SUP1,DX,COL
-
-
-      CALL NUCLEATION (SUP1,TT,FCCNR,DROPCONCN  &
-     &,NDROPMAX,COL,RCCN,DROPRADII,NKR,ICEMAX)
-
-! NEW WATER SIZE DISTRIBUTION FUNCTION (BEGIN)
-        DO KR=1,NDROPMAX
-           DX=3.*COL*X1(KR)
-! new changes 25.06.01                                        (begin)
-           PSI1(KR)=PSI1(KR)+DROPCONCN(KR)/DX
-! new changes 25.06.01                                          (end)
-        ENDDO
+
+      REAL DUM
+      REAL T
+      INTEGER TYPE
+! ice
+      real a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i
+      data a0i,a1i,a2i,a3i,a4i,a5i,a6i,a7i,a8i /&
+	6.11147274, 0.503160820, 0.188439774e-1, &
+        0.420895665e-3, 0.615021634e-5,0.602588177e-7, &
+        0.385852041e-9, 0.146898966e-11, 0.252751365e-14/
+
+! liquid
+      real a0,a1,a2,a3,a4,a5,a6,a7,a8
+
+! V1.7
+      data a0,a1,a2,a3,a4,a5,a6,a7,a8 /&
+	6.11239921, 0.443987641, 0.142986287e-1, &
+        0.264847430e-3, 0.302950461e-5, 0.206739458e-7, &
+        0.640689451e-10,-0.952447341e-13,-0.976195544e-15/
+      real dt
+
+! ICE
+
+      IF (TYPE == 1) THEN
+         POLYSVP = (10.**(-9.09718*(273.16/T-1.)-3.56654*                &
+          			LOG10(273.16/T)+0.876793*(1.-T/273.16)+						&
+          			LOG10(6.1071)))*100.0*10.0
+      END IF
+
+! LIQUID
+
+      IF (TYPE == 0) THEN
+        POLYSVP = (10.**(-7.90298*(373.16/T-1.)+                        &
+              5.02808*LOG10(373.16/T)-									&
+              1.3816E-7*(10**(11.344*(1.-T/373.16))-1.)+				&
+              8.1328E-3*(10**(-3.49149*(373.16/T-1.))-1.)+				&
+              LOG10(1013.246)))*100.0*10.0
+         END IF
 
       RETURN
-      END SUBROUTINE WATER_NUCL
-      SUBROUTINE ICE_NUCL (PSI2,X2,TT,ROR,SUP2,SUP2_OLD &
-     &                      ,C1_MEY,C2_MEY,COL,DSUPICEXZ &
-     &                      ,NKR,ICEMAX)
-        IMPLICIT NONE
-        INTEGER ITYPE,KR,ICE,NRGI,ICEMAX,NKR
-        REAL DEL2N,SUP2,C1,C2,C1_MEY,C2_MEY,TPC,TT,ROR
-        REAL DX,COL,BMASS,BFMASS,FMASS
-        REAL HELEK1,HELEK2,TPCC,DEL2NN,FF1BN,DSUPICEXZ
-        REAL FACT,DSUP2N,SUP2_OLD,DELTACD,DELTAF,ADDF,FNEW
-        REAL X2(NKR,ICEMAX),PSI2(NKR,ICEMAX)
-
-        REAL A1,B1,A2,B2
-        DATA A1,B1,A2,B2/-0.639,0.1296,-2.8,0.262/
-        REAL TEMP1,TEMP2,TEMP3
-        DATA TEMP1,TEMP2,TEMP3/-5.,-2.,-20./
-
-        C1=C1_MEY
-        C2=C2_MEY
-! TYPE OF ICE WITH NUCLEATION (BEGIN)
-
-        TPC=TT-273.15
-        ITYPE=0
+      END FUNCTION POLYSVP
+! +----------------------------------------------------------+
+      SUBROUTINE JERRATE_KS (xlS, &
+        						        TP,PP, &
+						                Vxl,RIEC,RO1BL, &
+						                B11_MY, &
+						                ID,IN,fl1,NKR,ICEMAX)
 
-        IF((TPC.GT.-4.0).OR.(TPC.LE.-8.1.AND.TPC.GT.-12.7).OR.&
-     &  (TPC.LE.-17.8.AND.TPC.GT.-22.4)) THEN
-          ITYPE=2
-        ELSE
-          IF((TPC.LE.-4.0.AND.TPC.GT.-8.1).OR.(TPC.LE.-22.4)) THEN
-            ITYPE=1
-          ELSE
-            ITYPE=3
-          ENDIF
-        ENDIF
+		IMPLICIT NONE
+! ... Interface
+		INTEGER,INTENT(IN) :: ID, IN, NKR, ICEMAX
+		REAL(KIND=r4size),INTENT(IN) :: RO1BL(NKR,ID),RIEC(NKR,ID),FL1(NKR)
+		REAL(KIND=r4size),INTENT(INOUT) :: B11_MY(NKR,ID)
+		REAL(KIND=r8size),INTENT(IN) :: PP, TP, xlS(NKR,ID),Vxl(NKR,ID)
+! ... Interface
+! ... Locals
+		INTEGER :: KR, nskin(nkr), ICE
+		REAL(KIND=r4size) :: VENTPLM(NKR), FD1(NKR,ICEMAX),FK1(NKR,ICEMAX), xl_MY1(NKR,ICEMAX), &
+        		              AL1_MY(2),ESAT1(2), TPreal
+		REAL(KIND=r8size) :: PZERO, TZERO, CONST, D_MY, COEFF_VISCOUS, SHMIDT_NUMBER,     &
+							           A, B, RVT, SHMIDT_NUMBER03, XLS_KR_ICE, RO1BL_KR_ICE, VXL_KR_ICE, REINOLDS_NUMBER, &
+							           RESHM, VENTPL, CONSTL, DETL
 
+		REAL(KIND=r4size) :: deg01,deg03
 
+! A1L_MY - CONSTANTS FOR "MAXWELL": MKS
+		REAL(KIND=r8size),parameter:: RV_MY=461.5D4, CF_MY=2.4D3, D_MYIN=0.211D0
 
-! NEW CRYSTAL SIZE DISTRIBUTION FUNCTION                      (BEGIN)
+! CGS :
 
-        ICE=ITYPE
+! RV_MY, CM*CM/SEC/SEC/KELVIN - INDIVIDUAL GAS CONSTANT
+!                               FOR WATER VAPOUR
+	!RV_MY=461.5D4
 
-        NRGI=2
-        IF(TPC.LT.TEMP1) THEN
-          DEL2N=100.*SUP2
-          DEL2NN=DEL2N
-          IF(DEL2N.GT.50.0) DEL2NN=50.
-          HELEK1=C1*EXP(A1+B1*DEL2NN)
-        ELSE
-          HELEK1=0.
-        ENDIF
+! D_MYIN, CM*CM/SEC - COEFFICIENT OF DIFFUSION OF WATER VAPOUR
 
-        IF(TPC.LT.TEMP2) THEN
-          TPCC=TPC
-          IF(TPCC.LT.TEMP3) TPCC=TEMP3
-          HELEK2=C2*EXP(A2-B2*TPCC)
-        ELSE
-          HELEK2=0.
-        ENDIF
+	!D_MYIN=0.211D0
 
-        FF1BN=HELEK1+HELEK2
+! PZERO, DYNES/CM/CM - REFERENCE PRESSURE
 
-        FACT=1.
-        DSUP2N=(SUP2-SUP2_OLD+DSUPICEXZ)*100.
+	PZERO=1.013D6
 
-        SUP2_OLD=SUP2
+! TZERO, KELVIN - REFERENCE TEMPERATURE
 
-        IF(DSUP2N.GT.50.) DSUP2N=50.
+	TZERO=273.15D0
 
-        DELTACD=FF1BN*B1*DSUP2N
+do kr=1,nkr
+	if (in==2 .and. fl1(kr)==0.0 .or. in==6 .or. in==3 .and. tp<273.15) then
+	   nskin(kr) = 2
+	else !in==1 or in==6 or lef/=0
+	   nskin(kr) = 1
+	endif
+enddo
 
-        IF(DELTACD.GE.FF1BN) DELTACD=FF1BN
+! CONSTANTS FOR CLAUSIUS-CLAPEYRON EQUATION :
 
-        IF(DELTACD.GT.0.) THEN
-          DELTAF=DELTACD*FACT
-          DO KR=1,NRGI-1
-             DX=3.*X2(KR,ICE)*COL
-             ADDF=DELTAF/DX
-             PSI2(KR,ICE)=PSI2(KR,ICE)+ADDF
-          ENDDO
-        ENDIF
-! NEW CRYSTAL SIZE DISTRIBUTION FUNCTION                        (END)
-       RETURN
-       END SUBROUTINE ICE_NUCL
+! A1_MY(1),G/SEC/SEC/CM
 
+!	A1_MY(1)=2.53D12
 
+! A1_MY(2),G/SEC/SEC/CM
 
+!	A1_MY(2)=3.41D13
 
+! BB1_MY(1), KELVIN
 
-      SUBROUTINE NUCLEATION (SUP1,TT,FCCNR,DROPCONCN  &
-     &,NDROPMAX,COL,RCCN,DROPRADII,NKR,ICEMAX)
-! DROPCONCN(KR), 1/cm^3 - drop bin concentrations, KR=1,...,NKR
+!	BB1_MY(1)=5.42D3
 
-! determination of new size spectra due to drop nucleation
+! BB1_MY(2), KELVIN
 
-      IMPLICIT NONE
-      INTEGER NDROPMAX,IDROP,ICCN,INEXT,ISMALL,KR,NCRITI
-      INTEGER ICEMAX,IMIN,IMAX,NKR,I,II,I0,I1
-      REAL &
-     &  SUP1,TT,RACTMAX,XKOE,R03,SUPCRITI,AKOE23,RCRITI,BKOE, &
-     &  AKOE,CONCCCNIN,DEG01,ALN_IP
-      REAL CCNCONC(NKR)
-      REAL CCNCONC_BFNUCL
+!	BB1_MY(2)=6.13D3
+
+! AL1_MY(1), CM*CM/SEC/SEC - LATENT HEAT OF VAPORIZATION
 
+	AL1_MY(1)=2.5D10
 
-      REAL COL
-      REAL RCCN(NKR),DROPRADII(NKR),FCCNR(NKR)
-      REAL RACT(NKR),DROPCONC(NKR),DROPCONCN(NKR)
-      REAL DLN1,DLN2,FOLD_IP
+! AL1_MY(2), CM*CM/SEC/SEC - LATENT HEAT OF SUBLIMATION
 
+	AL1_MY(2)=2.834D10
 
+! CF_MY, G*CM/SEC/SEC/SEC/KELVIN - COEFFICIENT OF
+!                                  THERMAL CONDUCTIVITY OF AIR
+	!CF_MY=2.4D3
 
-        DEG01=1./3.
+  DEG01=1.0/3.0
+  DEG03=1.0/3.0
 
+	CONST=12.566372D0
 
-! calculation initial value of NDROPMAX - maximal number of drop bin
-! which is activated
+! coefficient of diffusion
 
-! initial value of NDROPMAX
+	D_MY=D_MYIN*(PZERO/PP)*(TP/TZERO)**1.94D0
 
-        NDROPMAX=0
+! coefficient of viscousity
 
-        DO KR=1,NKR
-! initialization of bin radii of activated drops
-           RACT(KR)=0.
-! initialization of aerosol(CCN) bin concentrations
-           CCNCONC(KR)=0.
-! initialization of drop bin concentrations
-           DROPCONCN(KR)=0.
-        ENDDO
+! COEFF_VISCOUS=0.13 cm*cm/sec
+
+        COEFF_VISCOUS=0.13D0
+
+! Shmidt number
+
+        SHMIDT_NUMBER=COEFF_VISCOUS/D_MY
+
+! Constants used for calculation of Reinolds number
 
+        A=2.0D0*(3.0D0/4.0D0/3.141593D0)**DEG01
+        B=A/COEFF_VISCOUS
 
-! CCNCONC_BFNUCL - concentration of aerosol particles before
-!                  nucleation
+	RVT=RV_MY*TP
+  !	ESAT1(IN)=A1_MY(IN)*DEXP(-BB1_MY(IN)/TP)
+  !	if (IN==1) then
+  !            ESAT1(IN)=EW(TP)
+  !	ELSE
+  !            ESAT1(IN)=EI(TP)
+  !	endif
+
+		! ... (KS) - update the saturation vapor pressure
+		!ESAT1(1)=EW(TP)
+    !ESAT1(2)=EI(TP)
+		TPreal = TP
+		ESAT1(1) = POLYSVP(TPreal,0)
+		ESAT1(2) = POLYSVP(TPreal,1)
+
+	   DO KR=1,NKR
+	      VENTPLM(KR)=0.0D0
+    ENDDO
+
+		SHMIDT_NUMBER03=SHMIDT_NUMBER**DEG03
+
+	   DO ICE=1,ID
+	      DO KR=1,NKR
+
+          xlS_KR_ICE=xlS(KR,ICE)
+          RO1BL_KR_ICE=RO1BL(KR,ICE)
+          Vxl_KR_ICE=Vxl(KR,ICE)
+! Reynolds numbers
+          REINOLDS_NUMBER= &
+              B*Vxl_KR_ICE*(xlS_KR_ICE/RO1BL_KR_ICE)**DEG03
+          RESHM=DSQRT(REINOLDS_NUMBER)*SHMIDT_NUMBER03
+
+          IF(REINOLDS_NUMBER<2.5D0) THEN
+            VENTPL=1.0D0+0.108D0*RESHM*RESHM
+            VENTPLM(KR)=VENTPL
+          ELSE
+            VENTPL=0.78D0+0.308D0*RESHM
+            VENTPLM(KR)=VENTPL
+          ENDIF
 
-        CCNCONC_BFNUCL=0.
-        DO I=1,NKR
-           CCNCONC_BFNUCL=CCNCONC_BFNUCL+FCCNR(I)
         ENDDO
+! cycle by KR
 
-        CCNCONC_BFNUCL=CCNCONC_BFNUCL*COL
+! VENTPL_MAX is given in MICRO.PRM include file
 
-        IF(CCNCONC_BFNUCL.EQ.0.) THEN
-           RETURN    
-        ELSE
-           CALL BOUNDARY(IMIN,IMAX,FCCNR,NKR)
-           CALL CRITICAL (AKOE,BKOE,TT,RCRITI,SUP1,DEG01)
-           IF(RCRITI.GE.RCCN(IMAX))  RETURN
-        END IF
+	     DO KR=1,NKR
 
-! calculation of CCNCONC(I) - aerosol(CCN) bin concentrations;
-!                             I=IMIN,...,IMAX
-! determination of NCRITI - number bin in which is located RCRITI
-        IF (IMIN.EQ.1)THEN
-         CALL CCNIMIN(IMIN,IMAX,RCRITI,NCRITI,RCCN,CCNCONC,COL, &
-     &       FCCNR,NKR)
-         CALL CCNLOOP(IMIN,IMAX,RCRITI,NCRITI,RCCN,CCNCONC,COL, &
-     &       FCCNR,NKR)
-        ELSE
-         CALL CCNLOOP(IMIN,IMAX,RCRITI,NCRITI,RCCN,CCNCONC,COL, &
-     &       FCCNR,NKR)
-        END IF
+        VENTPL=VENTPLM(KR)
 
+        IF(VENTPL>VENTPL_MAX) THEN
+          VENTPL=VENTPL_MAX
+          VENTPLM(KR)=VENTPL
+        ENDIF
 
-! calculation CCNCONC_AFNUCL - ccn concentration after nucleation
+        CONSTL=CONST*RIEC(KR,ICE)
 
-!       CCNCONC_AFNUCL=0.
+        FD1(KR,ICE)=RVT/D_MY/ESAT1(nskin(kr))
+        FK1(KR,ICE)=(AL1_MY(nskin(kr))/RVT-1.0D0)*AL1_MY(nskin(kr))/CF_MY/TP
 
-!       DO I=IMIN,IMAX
-!          CCNCONC_AFNUCL=CCNCONC_AFNUCL+FCCNR(I)
-!       ENDDO
+        xl_MY1(KR,ICE)=VENTPL*CONSTL
+        ! growth rate
+        DETL=FK1(KR,ICE)+FD1(KR,ICE)
+        B11_MY(KR,ICE)=xl_MY1(KR,ICE)/DETL
 
-!       CCNCONC_AFNUCL=CCNCONC_AFNUCL*COL
+       ENDDO
+! cycle by KR
 
-! calculation DEL_CCNCONC
+      ENDDO
+! cycle by ICE
 
-!       DEL_CCNCONC=CCNCONC_BFNUCL-CCNCONC_AFNUCL
-        CALL ACTIVATE(IMIN,IMAX,AKOE,BKOE,RCCN,RACT,RACTMAX,NKR)
+	RETURN
+	END SUBROUTINE JERRATE_KS
 
+! SUBROUTINE JERRATE
+! ................................................................................
+	SUBROUTINE JERTIMESC_KS (FI1,X1,SFN11, &
+        				  	       B11_MY,CF,ID,NKR,ICEMAX,COL)
+
+	IMPLICIT NONE
+
+! ... Interface
+	INTEGER,INTENT(IN) :: ID,NKR,ICEMAX
+	REAL(KIND=r4size),INTENT(in) :: B11_MY(NKR,ID), FI1(NKR,ID), COL, CF
+	REAL(KIND=r8size),INTENT(in) :: X1(NKR,ID)
+	REAL(KIND=r4size),INTENT(out) :: SFN11(ID)
+! ... Interface
+
+! ... Locals
+	INTEGER :: ICE, KR
+	REAL(KIND=r4size) :: SFN11S, FK, DELM, FUN, B11
+! ... Locals
+
+	DO ICE=1,ID
+     SFN11S=0.0D0
+ 	   SFN11(ICE)=CF*SFN11S
+   DO KR=1,NKR
+! value of size distribution functions
+      	FK=FI1(KR,ICE)
+! delta-m
+      	DELM=X1(KR,ICE)*3.0D0*COL
+! integral's expression
+	      	FUN=FK*DELM
+! values of integrals
+	      	B11=B11_MY(KR,ICE)
+		  	SFN11S=SFN11S+FUN*B11
+  ENDDO
+! cycle by kr
+! correction
+ 	SFN11(ICE)=CF*SFN11S
+  ENDDO
+
+! cycle by ice
 
+	RETURN
+	END SUBROUTINE JERTIMESC_KS
+! +--------------------------------------------------------+
+	SUBROUTINE JERSUPSAT_KS (DEL1,DEL2,DEL1N,DEL2N, &
+			                     RW,PW,RI,PI, &
+          			           DT,DEL1INT,DEL2INT,DYN1,DYN2, &
+          			           ISYM1,ISYM2,ISYM3,ISYM4,ISYM5)
+
+		IMPLICIT NONE
+! ... Interface
+		INTEGER,INTENT(INOUT) :: 		ISYM1, ISYM2(:), ISYM3, ISYM4, ISYM5
+		REAL(KIND=r4size),INTENT(IN) ::   DT, DYN1, DYN2
+		REAL(KIND=r8size),INTENT(IN) :: 	DEL1, DEL2
+		REAL(KIND=r8size),INTENT(INOUT) :: DEL1N,DEL2N,DEL1INT,DEL2INT,RW, PW, RI, PI
+! ... Interface
+! ... Locals
+	   INTEGER :: I, ISYMICE
+	   REAL(KIND=r8size) :: X, EXPM1, DETER, EXPR, EXPP, A, ALFA, BETA, GAMA, G31, G32, G2, EXPB, EXPG, &
+	   				  C11, C21, C12, C22, A1DEL1N, A2DEL1N, A3DEL1N, A4DEL1N, A1DEL1INT, A2DEL1INT, &
+							A3DEL1INT, A4DEL1INT, A1DEL2N, A2DEL2N, A3DEL2N , A4DEL2N, A1DEL2INT, A2DEL2INT, &
+							A3DEL2INT, A4DEL2INT, A5DEL2INT
+! ... Locals
+
+		EXPM1(x)=x+x*x/2.0D0+x*x*x/6.0D0+x*x*x*x/24.0D0+ &
+                 x*x*x*x*x/120.0D0
+
+	ISYMICE = sum(ISYM2) + ISYM3 + ISYM4 + ISYM5
+
+	IF(AMAX1(RW,PW,RI,PI)<=RW_PW_RI_PI_MIN) THEN
+
+	    RW = 0.0
+	    PW = 0.0
+	    RI = 0.0
+	    PI = 0.0
+	    ISYM1 = 0
+	    ISYMICE = 0
+
+	ELSE
+
+    IF(DMAX1(RW,PW)>RW_PW_MIN) THEN
+
+			! ... (KS) - A zero can pass through, assign a minimum value
+			IF(RW < RW_PW_MIN*RW_PW_MIN) RW = 1.0D-20
+			IF(PW < RW_PW_MIN*RW_PW_MIN) PW = 1.0D-20
+			! ... (KS) ...................................................
+
+        IF(DMAX1(PI/PW,RI/RW)<=RATIO_ICEW_MIN) THEN
+			! only water
+	      		RI = 0.0
+	      		PI = 0.0
+	      		ISYMICE = 0
+	    	ENDIF
+
+        IF(DMIN1(PI/PW,RI/RW)>1.0D0/RATIO_ICEW_MIN) THEN
+			! only ice
+	      		RW = 0.0
+	      		PW = 0.0
+	      		ISYM1 = 0
+       ENDIF
 
-        CALL DROPMAX(DROPRADII,RACTMAX,NDROPMAX,NKR)
-! put nucleated droplets into the drop bin according to radius
-! change in drop concentration due to activation DROPCONCN(IDROP)
-        ISMALL=NCRITI
+    ELSE
+			! only ice
+			RW = 0.0
+    	PW = 0.0
+    	ISYM1 = 0
 
-        INEXT=ISMALL
-!       ISMALL=1
+	  ENDIF
+	 ENDIF
 
-!       INEXT=ISMALL
+	IF(ISYMICE == 0)THEN
+		ISYM2 = 0
+		ISYM3 = 0
+		ISYM4 = 0
+		ISYM5 = 0
+	ENDIF
 
-        DO IDROP=1,NDROPMAX
-           DROPCONCN(IDROP)=0.
-           DO I=ISMALL,IMAX
-              IF(RACT(I).LE.DROPRADII(IDROP)) THEN
-                DROPCONCN(IDROP)=DROPCONCN(IDROP)+CCNCONC(I)
-                INEXT=I+1
-              ENDIF
-           ENDDO
-           ISMALL=INEXT
-        ENDDO
+    DETER=RW*PI-PW*RI
 
-!999    CONTINUE
 
+    IF(RW==0.0 .AND. RI==0.0) THEN
 
-        RETURN
-        END SUBROUTINE NUCLEATION
+          DEL1N=DEL1+DYN1*DT
+          DEL2N=DEL2+DYN2*DT
+          DEL1INT=DEL1*DT+DYN1*DT*DT/2.0D0
+          DEL2INT=DEL2*DT+DYN2*DT*DT/2.0D0
 
+          GOTO 100
 
+    ENDIF
 
-        SUBROUTINE BOUNDARY(IMIN,IMAX,FCCNR,NKR)
-! IMIN - left CCN spectrum boundary
-        IMPLICIT NONE
-        INTEGER I,IMIN,IMAX,NKR
-        REAL FCCNR(NKR)
+! solution of equation for supersaturation with
+! different DETER values
 
-        IMIN=0
+    IF(RI==0.0) THEN
+! only water                                                     (start)
 
-        DO I=1,NKR
-           IF(FCCNR(I).NE.0.) THEN
-             IMIN=I
-             GOTO 40
-           ENDIF
-        ENDDO
+      EXPR=EXP(-RW*DT)
+      IF(ABS(RW*DT)>1.0E-6) THEN
+        DEL1N=DEL1*EXPR+(DYN1/RW)*(1.0D0-EXPR)
+        DEL2N=PW*DEL1*EXPR/RW-PW*DYN1*DT/RW- &
+              PW*DYN1*EXPR/(RW*RW)+DYN2*DT+ &
+              DEL2-PW*DEL1/RW+PW*DYN1/(RW*RW)
+        DEL1INT=-DEL1*EXPR/RW+DYN1*DT/RW+ &
+                 DYN1*EXPR/(RW*RW)+DEL1/RW-DYN1/(RW*RW)
+        DEL2INT=PW*DEL1*EXPR/(-RW*RW)-PW*DYN1*DT*DT/(2.0D0*RW)+ &
+                PW*DYN1*EXPR/(RW*RW*RW)+DYN2*DT*DT/2.0D0+ &
+                DEL2*DT-PW*DEL1*DT/RW+PW*DYN1*DT/(RW*RW)+ &
+                PW*DEL1/(RW*RW)-PW*DYN1/(RW*RW*RW)
+        GOTO 100
+! in case DABS(RW*DT)>1.0D-6
+	     ELSE
 
- 40     CONTINUE
+! in case DABS(RW*DT)<=1.0D-6
 
-! IMAX - right CCN spectrum boundary
+          EXPR=EXPM1(-RW*DT)
+          DEL1N=DEL1+DEL1*EXPR+(DYN1/RW)*(0.0D0-EXPR)
+          DEL2N=PW*DEL1*EXPR/RW-PW*DYN1*DT/RW- &
+                   PW*DYN1*EXPR/(RW*RW)+DYN2*DT+DEL2
+          DEL1INT=-DEL1*EXPR/RW+DYN1*DT/RW+DYN1*EXPR/(RW*RW)
+          DEL2INT=PW*DEL1*EXPR/(-RW*RW)-PW*DYN1*DT*DT/(2.0D0*RW)+ &
+                     PW*DYN1*EXPR/(RW*RW*RW)+DYN2*DT*DT/2.0D0+ &
+                     DEL2*DT-PW*DEL1*DT/RW+PW*DYN1*DT/(RW*RW)
+          GOTO 100
 
-        IMAX=0
+	       ENDIF
+! only water                                                    (end)
+
+! in case RI==0.0D0
+    ENDIF
+
+    IF(RW==0.0) THEN
+! only ice                                                    (start)
+
+      EXPP=EXP(-PI*DT)
+
+      IF(ABS(PI*DT)>1.0E-6) THEN
+
+        DEL2N = DEL2*EXPP+(DYN2/PI)*(1.0D0-EXPP)
+        DEL2INT = -DEL2*EXPP/PI+DYN2*DT/PI+ &
+                   DYN2*EXPP/(PI*PI)+DEL2/PI-DYN2/(PI*PI)
+        DEL1N = +RI*DEL2*EXPP/PI-RI*DYN2*DT/PI- &
+                  RI*DYN2*EXPP/(PI*PI)+DYN1*DT+ &
+                  DEL1-RI*DEL2/PI+RI*DYN2/(PI*PI)
+        DEL1INT = -RI*DEL2*EXPP/(PI*PI)-RI*DYN2*DT*DT/(2.0D0*PI)+ &
+                    RI*DYN2*EXPP/(PI*PI*PI)+DYN1*DT*DT/2.0D0+ &
+                    DEL1*DT-RI*DEL2*DT/PI+RI*DYN2*DT/(PI*PI)+ &
+                    RI*DEL2/(PI*PI)-RI*DYN2/(PI*PI*PI)
+        GOTO 100
+! in case DABS(PI*DT)>1.0D-6
+      ELSE
 
-        DO I=NKR,1,-1
-           IF(FCCNR(I).NE.0.) THEN
-             IMAX=I
-             GOTO 41
-           ENDIF
-        ENDDO
+! in case DABS(PI*DT)<=1.0D-6
 
- 41     CONTINUE
-        RETURN
-        END  SUBROUTINE BOUNDARY
+          EXPP=EXPM1(-PI*DT)
+          DEL2N=DEL2+DEL2*EXPP-EXPP*DYN2/PI
+          DEL2INT=-DEL2*EXPP/PI+DYN2*DT/PI+DYN2*EXPP/(PI*PI)
+          DEL1N=+RI*DEL2*EXPP/PI-RI*DYN2*DT/PI- &
+                    RI*DYN2*EXPP/(PI*PI)+DYN1*DT+DEL1
+          DEL1INT=-RI*DEL2*EXPP/(PI*PI)-RI*DYN2*DT*DT/(2.0D0*PI)+ &
+                      RI*DYN2*EXPP/(PI*PI*PI)+DYN1*DT*DT/2.0D0+ &
+                      DEL1*DT-RI*DEL2*DT/PI+RI*DYN2*DT/(PI*PI)
+          GOTO 100
 
-        SUBROUTINE CRITICAL (AKOE,BKOE,TT,RCRITI,SUP1,DEG01)
-! AKOE & BKOE - constants in Koehler equation
-        IMPLICIT NONE
-        REAL AKOE,BKOE,TT,RCRITI,SUP1,DEG01
-        REAL RO_SOLUTE
-        PARAMETER (RO_SOLUTE=2.16)
+      ENDIF
+! only ice                                                      (end)
+
+! in case RW==0.0D0
+    ENDIF
+
+    IF(RW/=0.0 .AND. RI/=0.0) THEN
+
+      A=(RW-PI)*(RW-PI)+4.0E0*PW*RI
+
+	     IF(A < 0.0) THEN
+	          PRINT*,   'IN SUBROUTINE JERSUPSAT: A < 0'
+            PRINT*,   'DETER'
+            PRINT 201, DETER
+            PRINT*,   'RW,PW,RI,PI'
+            PRINT 204, RW,PW,RI,PI
+            PRINT*,   'DT,DYN1,DYN2'
+            PRINT 203, DT,DYN1,DYN2
+            PRINT*,   'DEL1,DEL2'
+            PRINT 202, DEL1,DEL2
+	          PRINT*,   'STOP 1905:A < 0'
+	          call wrf_error_fatal("fatal error: STOP 1905:A < 0, model stop")
+       ENDIF
+! water and ice                                               (start)
+       ALFA=DSQRT((RW-PI)*(RW-PI)+4.0D0*PW*RI)
+
+! 5/8/04 Nir, Beta is negative to the simple solution so
+! it will decay
+
+        BETA=0.5D0*(ALFA+RW+PI)
+        GAMA=0.5D0*(ALFA-RW-PI)
+        G31=PI*DYN1-RI*DYN2
+        G32=-PW*DYN1+RW*DYN2
+        G2=RW*PI-RI*PW
+        IF (G2 == 0.0D0) G2 = 1.0004d-11*1.0003d-11-1.0002d-11*1.0001e-11 ! ... (KS) - 24th,May,2016
+        EXPB=DEXP(-BETA*DT)
+        EXPG=DEXP(GAMA*DT)
+
+        IF(DABS(GAMA*DT)>1.0E-6) THEN
+          C11=(BETA*DEL1-RW*DEL1-RI*DEL2-BETA*G31/G2+DYN1)/ALFA
+          C21=(GAMA*DEL1+RW*DEL1+RI*DEL2-GAMA*G31/G2-DYN1)/ALFA
+          C12=(BETA*DEL2-PW*DEL1-PI*DEL2-BETA*G32/G2+DYN2)/ALFA
+          C22=(GAMA*DEL2+PW*DEL1+PI*DEL2-GAMA*G32/G2-DYN2)/ALFA
+          DEL1N=C11*EXPG+C21*EXPB+G31/G2
+          DEL1INT=C11*EXPG/GAMA-C21*EXPB/BETA+(C21/BETA-C11/GAMA) &
+                  +G31*DT/G2
+          DEL2N=C12*EXPG+C22*EXPB+G32/G2
+          DEL2INT=C12*EXPG/GAMA-C22*EXPB/BETA+(C22/BETA-C12/GAMA) &
+                  +G32*DT/G2
+            GOTO 100
+! in case DABS(GAMA*DT)>1.0D-6
+	       ELSE
+! in case DABS(GAMA*DT)<=1.0D-6
+            IF(ABS(RI/RW)>1.0E-12) THEN
+              IF(ABS(RW/RI)>1.0E-12) THEN
+                ALFA=DSQRT((RW-PI)*(RW-PI)+4.0D0*PW*RI)
+                BETA=0.5D0*(ALFA+RW+PI)
+                GAMA=0.5D0*(ALFA-RW-PI)
+		            IF (GAMA == 0.0D0) GAMA=0.5D0*(2.002d-10-2.001d-10) ! ... (KS) - 24th,May,2016
+                EXPG=EXPM1(GAMA*DT)
+                EXPB=DEXP(-BETA*DT)
+
+! beta/alfa could be very close to 1 that why I transform it
+! remember alfa-beta=gama
+
+                C11=(BETA*DEL1-RW*DEL1-RI*DEL2+DYN1)/ALFA
+                C21=(GAMA*DEL1+RW*DEL1+RI*DEL2-GAMA*G31/G2-DYN1)/ALFA
+                C12=(BETA*DEL2-PW*DEL1-PI*DEL2+DYN2)/ALFA
+                C22=(GAMA*DEL2+PW*DEL1+PI*DEL2-GAMA*G32/G2-DYN2)/ALFA
+
+                A1DEL1N=C11
+                A2DEL1N=C11*EXPG
+                A3DEL1N=C21*EXPB
+                A4DEL1N=G31/G2*(GAMA/ALFA+(GAMA/ALFA-1.0D0)*EXPG)
+
+                DEL1N=A1DEL1N+A2DEL1N+A3DEL1N+A4DEL1N
+
+                A1DEL1INT=C11*EXPG/GAMA
+                A2DEL1INT=-C21*EXPB/BETA
+                A3DEL1INT=C21/BETA
+                A4DEL1INT=G31/G2*DT*(GAMA/ALFA)
+
+                DEL1INT=A1DEL1INT+A2DEL1INT+A3DEL1INT+A4DEL1INT
+
+                A1DEL2N=C12
+                A2DEL2N=C12*EXPG
+                A3DEL2N=C22*EXPB
+                A4DEL2N=G32/G2*(GAMA/ALFA+ &
+                       (GAMA/ALFA-1.0D0)* &
+                       (GAMA*DT+GAMA*GAMA*DT*DT/2.0D0))
+
+                DEL2N=A1DEL2N+A2DEL2N+A3DEL2N+A4DEL2N
+
+                A1DEL2INT=C12*EXPG/GAMA
+                A2DEL2INT=-C22*EXPB/BETA
+                A3DEL2INT=C22/BETA
+                A4DEL2INT=G32/G2*DT*(GAMA/ALFA)
+                A5DEL2INT=G32/G2*(GAMA/ALFA-1.0D0)* &
+                                 (GAMA*DT*DT/2.0D0)
+
+                DEL2INT=A1DEL2INT+A2DEL2INT+A3DEL2INT+A4DEL2INT+ &
+                        A5DEL2INT
+
+! in case DABS(RW/RI)>1D-12
+              ELSE
 
-         
+! in case DABS(RW/RI)<=1D-12
 
-        AKOE=3.3E-05/TT
-        BKOE=2.*4.3/(22.9+35.5)
-! new change 21.07.02                                         (begin)
-        BKOE=BKOE*(4./3.)*3.141593*RO_SOLUTE                  
-! new change 21.07.02                                           (end)
-        
+                X=-2.0D0*RW*PI+RW*RW+4.0D0*PW*RI
 
-! table of critical aerosol radii
+                ALFA=PI*(1+(X/PI)/2.0D0-(X/PI)*(X/PI)/8.0D0)
+                BETA=PI+(X/PI)/4.0D0-(X/PI)*(X/PI)/16.0D0+RW/2.0D0
+                GAMA=(X/PI)/4.0D0-(X/PI)*(X/PI)/16.0D0-RW/2.0D0
 
-!	GOTO 992
+                EXPG=EXPM1(GAMA*DT)
+                EXPB=DEXP(-BETA*DT)
 
-! SUP1_TEST(I), %
-!       SUP1_TEST(1)=0.01
-!       DO I=1,99
-!          SUP1_TEST(I+1)=SUP1_TEST(I)+0.01
-!          SUP1_I=SUP1_TEST(I)*0.01
-!          RCRITI_TEST(I)=(AKOE/3.)*(4./BKOE/SUP1_I/SUP1_I)**DEG01
-!       ENDDO
+    	        	C11=(BETA*DEL1-RW*DEL1-RI*DEL2+DYN1)/ALFA
+    	        	C21=(GAMA*DEL1+RW*DEL1+RI*DEL2-GAMA*G31/G2-DYN1)/ALFA
+    	        	C12=(BETA*DEL2-PW*DEL1-PI*DEL2+DYN2)/ALFA
+    	        	C22=(GAMA*DEL2+PW*DEL1+PI*DEL2-GAMA*G32/G2-DYN2)/ALFA
 
-! RCRITI, cm - critical radius of "dry" aerosol
+                DEL1N=C11+C11*EXPG+C21*EXPB+ &
+                         G31/G2*(GAMA/ALFA+(GAMA/ALFA-1)*EXPG)
+                DEL1INT=C11*EXPG/GAMA-C21*EXPB/BETA+(C21/BETA)+ &
+                           G31/G2*DT*(GAMA/ALFA)
+                DEL2N=C12+C12*EXPG+C22*EXPB+G32/G2*(GAMA/ALFA+ &
+                        (GAMA/ALFA-1.0D0)* &
+                        (GAMA*DT+GAMA*GAMA*DT*DT/2.0D0))
+	              DEL2INT=C12*EXPG/GAMA-C22*EXPB/BETA+ &
+      		       (C22/BETA)+G32/G2*DT*(GAMA/ALFA)+ &
+      		        G32/G2*(GAMA/ALFA-1.0D0)*(GAMA*DT*DT/2.0D0)
+
+! in case DABS(RW/RI)<=1D-12
+	         ENDIF
+! alfa/beta 2
+! in case DABS(RI/RW)>1D-12
+
+            ELSE
+
+! in case DABS(RI/RW)<=1D-12
+
+              X=-2.0D0*RW*PI+PI*PI+4.0D0*PW*RI
+
+              ALFA=RW*(1.0D0+(X/RW)/2.0D0-(X/RW)*(X/RW)/8.0D0)
+              BETA=RW+(X/RW)/4.0D0-(X/RW)*(X/RW)/16.0D0+PI/2.0D0
+              GAMA=(X/RW)/4.0D0-(X/RW)*(X/RW)/16.0D0-PI/2.0D0
+
+              EXPG=EXPM1(GAMA*DT)
+              EXPB=DEXP(-BETA*DT)
+
+              C11=(BETA*DEL1-RW*DEL1-RI*DEL2+DYN1)/ALFA
+      	      C21=(GAMA*DEL1+RW*DEL1+RI*DEL2-GAMA*G31/G2-DYN1)/ALFA
+              C12=(BETA*DEL2-PW*DEL1-PI*DEL2+DYN2)/ALFA
+  	          C22=(GAMA*DEL2+PW*DEL1+PI*DEL2-GAMA*G32/G2-DYN2)/ALFA
+
+              DEL1N=C11+C11*EXPG+C21*EXPB+ &
+                    G31/G2*(GAMA/ALFA+(GAMA/ALFA-1.0D0)*EXPG)
+              DEL1INT=C11*EXPG/GAMA-C21*EXPB/BETA+(C21/BETA)+ &
+                      G31/G2*DT*(GAMA/ALFA)
+              DEL2N=C12+C12*EXPG+C22*EXPB+G32/G2* &
+                    (GAMA/ALFA+ &
+                    (GAMA/ALFA-1.0D0)*(GAMA*DT+GAMA*GAMA*DT*DT/2.0D0))
+	      	   DEL2INT=C12*EXPG/GAMA-C22*EXPB/BETA+C22/BETA+ &
+      		      G32/G2*DT*(GAMA/ALFA)+ &
+      		      G32/G2*(GAMA/ALFA-1.0D0)*(GAMA*DT*DT/2.0D0)
+! alfa/beta
+! in case DABS(RI/RW)<=1D-12
+	    ENDIF
+! in case DABS(GAMA*DT)<=1D-6
+	  ENDIF
+
+! water and ice                                                 (end)
+
+! in case ISYM1/=0.AND.ISYM2/=0
 
-        RCRITI=(AKOE/3.)*(4./BKOE/SUP1/SUP1)**DEG01
-        RETURN
-        END  SUBROUTINE CRITICAL
-            
-        SUBROUTINE CCNIMIN(IMIN,IMAX,RCRITI,NCRITI,RCCN,CCNCONC,COL, &
-     &       FCCNR,NKR)
-! FOR    IMIN=1
-        IMPLICIT NONE
-        INTEGER IMIN,II,IMAX,NCRITI,NKR
-        REAL RCRITI,COL
-        REAL RCCN(NKR),FCCNR(NKR),CCNCONC(NKR)
-        REAL RCCN_MIN
-        REAL DLN1,DLN2,FOLD_IP
-! rccn_min - minimum aerosol(ccn) radius
-        RCCN_MIN=RCCN(1)/10000.
-! calculation of ccnconc(ii)=fccnr(ii)*col - aerosol(ccn) bin
-!                                            concentrations,
-!                                            ii=imin,...,imax
-! determination of ncriti   - number bin in which is located rcriti
-! calculation of ccnconc(ncriti)=fccnr(ncriti)*dln1/(dln1+dln2),
-! where,    
-! dln1=Ln(rcriti)-Ln(rccn_min)
-! dln2=Ln(rccn(1)-Ln(rcriti)
-! calculation of new value of fccnr(ncriti)
-
-!       IF(IMIN.EQ.1) THEN
-          IF(RCRITI.LE.RCCN_MIN) THEN
-            NCRITI=1
-            DO II=NCRITI+1,IMAX
-               CCNCONC(II)=COL*FCCNR(II)     
-               FCCNR(II)=0.                  
-            ENDDO
-            GOTO 42
-          ENDIF
-          IF(RCRITI.GT.RCCN_MIN.AND.RCRITI.LT.RCCN(IMIN)) THEN
-            NCRITI=1
-            DO II=NCRITI+1,IMAX
-               CCNCONC(II)=COL*FCCNR(II)
-               FCCNR(II)=0.
-            ENDDO
-            DLN1=ALOG(RCRITI)-ALOG(RCCN_MIN)
-            DLN2=ALOG(RCCN(1))-ALOG(RCRITI)
-            CCNCONC(NCRITI)=DLN2*FCCNR(NCRITI)
-            FCCNR(NCRITI)=FCCNR(NCRITI)*DLN1/(DLN1+DLN2)
-            GOTO 42
-! in case RCRITI.GT.RCCN_MIN.AND.RCRITI.LT.RCCN(IMIN)
-          ENDIF
-! in case IMIN.EQ.1
-42       CONTINUE
-     
-         RETURN
-         END SUBROUTINE CCNIMIN
-        SUBROUTINE CCNLOOP(IMIN,IMAX,RCRITI,NCRITI,RCCN,CCNCONC,COL, &
-     &       FCCNR,NKR)
-        IMPLICIT NONE
-         INTEGER I,IMIN,IMAX,NKR,II,NCRITI
-         REAL COL
-         REAL RCRITI,RCCN(NKR),CCNCONC(NKR),FCCNR(NKR)
-         REAL DLN1,DLN2,FOLD_IP
-        IF(IMIN.GT.1) THEN
-          IF(RCRITI.LE.RCCN(IMIN-1)) THEN
-            NCRITI=IMIN
-            DO II=NCRITI,IMAX
-               CCNCONC(II)=COL*FCCNR(II)
-               FCCNR(II)=0.
-            ENDDO
-            GOTO 42
-          ENDIF
-          IF(RCRITI.LT.RCCN(IMIN).AND.RCRITI.GT.RCCN(IMIN-1)) &
-     &    THEN
-! this line eliminates bug you found (when IMIN=IMAX)
-            NCRITI=IMIN
-            
-            DO II=NCRITI+1,IMAX
-               CCNCONC(II)=COL*FCCNR(II)
-               FCCNR(II)=0.
-            ENDDO
-            DLN1=ALOG(RCRITI)-ALOG(RCCN(IMIN-1))
-            DLN2=COL-DLN1
-            CCNCONC(NCRITI)=DLN2*FCCNR(NCRITI)
-            FCCNR(NCRITI)=FCCNR(NCRITI)*DLN1/COL
-            GOTO 42
-! in case RCRITI.LT.RCCN(IMIN).AND.RCRITI.GT.RCCN(IMIN-1)
-          ENDIF
-! in case IMIN.GT.1
         ENDIF
-        
-! END of part of interest. so in case
-!RCRITI.LT.RCCN(IMIN).AND.RCRITI.GT.RCCN(IMIN-1)
-!we go to 42 and avoid the next loop
-
-      
-
-         DO I=IMIN,IMAX-1
-           IF(RCRITI.EQ.RCCN(I)) THEN
-             NCRITI=I+1
-             DO II=I+1,IMAX
-                CCNCONC(II)=COL*FCCNR(II)
-                FCCNR(II)=0.
-             ENDDO
-             GOTO 42
-           ENDIF
-           IF(RCRITI.GT.RCCN(I).AND.RCRITI.LT.RCCN(I+1)) THEN
-             NCRITI=I+1
-             IF(I.NE.IMAX-1) THEN
-               DO II=NCRITI+1,IMAX
-                  CCNCONC(II)=COL*FCCNR(II)
-                  FCCNR(II)=0.
-               ENDDO
-             ENDIF
-             DLN1=ALOG(RCRITI)-ALOG(RCCN(I))
-             DLN2=COL-DLN1
-             CCNCONC(NCRITI)=DLN2*FCCNR(NCRITI)
-             FCCNR(NCRITI)=FCCNR(NCRITI)*DLN1/COL
-             GOTO 42
-! in case RCRITI.GT.RCCN(I).AND.RCRITI.LT.RCCN(I+1)
-           END IF
-      
 
-         ENDDO
-! cycle by I, I=IMIN,...,IMAX-1
+ 100    CONTINUE
+
+  201	FORMAT(1X,D13.5)
+  202	FORMAT(1X,2D13.5)
+  203	FORMAT(1X,3D13.5)
+  204	FORMAT(1X,4D13.5)
+
+        RETURN
+        END SUBROUTINE JERSUPSAT_KS
+
+! SUBROUTINE JERSUPSAT
+! ....................................................................
+	SUBROUTINE JERDFUN_KS (xi,xiN,B21_MY, &
+        					       FI2,PSI2,fl2,DEL2N, &
+        					       ISYM2,IND,ITYPE,TPN,IDROP, &
+        					       FR_LIM,FRH_LIM,ICEMAX,NKR,COL,Ihydro,Iin,Jin,Kin,Itimestep)
+
+	IMPLICIT NONE
+! ... Interface
+	INTEGER,INTENT(IN) :: ISYM2, IND, ITYPE, NKR, ICEMAX, Ihydro, Iin, Jin ,Kin, Itimestep
+	INTEGER,INTENT(INOUT) :: IDROP
+	REAL(kind=R4SIZE),INTENT(IN) :: B21_MY(:), FI2(:), FR_LIM(:), FRH_LIM(:), &
+					   				DEL2N, COL
+	REAL(kind=R8SIZE),INTENT(IN) :: TPN, xi(:)
+	REAL(kind=R8SIZE),INTENT(INOUT) :: xiN(:)
+	REAL(kind=R4SIZE),INTENT(INOUT) :: PSI2(:), FL2(:)
+! ... Interface
+
+! ... Locals
+	INTEGER :: ITYP, KR, NR, ICE, K, IDSD_Negative
+	REAL(kind=R8SIZE) :: FL2_NEW(NKR), FI2R(NKR), PSI2R(NKR), C, DEGREE1, DEGREE2, DEGREE3, D, RATEXI, &
+						           B, A, xiR(NKR),xiNR(NKR), FR_LIM_KR
+! ... Locals
+
+
+	C = 2.0D0/3.0D0
+
+	DEGREE1 = 1.0D0/3.0D0
+	DEGREE2 = C
+	DEGREE3 = 3.0D0/2.0D0
+
+	IF(IND > 1) THEN
+	  ITYP = ITYPE
+	ELSE
+	  ITYP = 1
+	ENDIF
+
+	DO KR=1,NKR
+	   PSI2R(KR) = FI2(KR)
+	   FI2R(KR) = FI2(KR)
+	ENDDO
+
+	NR=NKR
 
-  42    CONTINUE
-        RETURN
-        END  SUBROUTINE CCNLOOP
-       SUBROUTINE ACTIVATE(IMIN,IMAX,AKOE,BKOE,RCCN,RACT, RACTMAX,NKR)
-       IMPLICIT NONE
+! new size distribution functions                             (start)
+
+	IF(ISYM2 == 1) THEN
+	  IF(IND==1 .AND. ITYPE==1) THEN
+! drop diffusional growth
+	    DO KR=1,NKR
+	       D=xi(KR)**DEGREE1
+	       RATExi=C*DEL2N*B21_MY(KR)/D
+	       B=xi(KR)**DEGREE2
+	       A=B+RATExi
+	       IF(A<0.0D0) THEN
+	         xiN(KR)=1.0D-50
+	       ELSE
+	         xiN(KR)=A**DEGREE3
+	       ENDIF
+	    ENDDO
+! in case IND==1.AND.ITYPE==1
+	  ELSE
+! in case IND/=1.OR.ITYPE/=1
+	         DO KR=1,NKR
+	            RATExi = DEL2N*B21_MY(KR)
+	            xiN(KR) = xi(KR) + RATExi
+	         ENDDO
+	  ENDIF
 
-       INTEGER IMIN,IMAX,NKR
-       INTEGER I,I0,I1
-       REAL RCCN(NKR)
-        REAL  R03,SUPCRITI,RACT(NKR),XKOE
-        REAL AKOE,BKOE,AKOE23,RACTMAX
-! Spectrum of activated drops                                 (begin) 
-        DO I=IMIN,IMAX
+! recalculation of size distribution functions                (start)
 
-! critical water supersaturations appropriating CCN radii
+      DO KR=1,NKR
+        xiR(KR) = xi(KR)
+        xiNR(KR) = xiN(KR)
+      	FI2R(KR) = FI2(KR)
+      END DO
 
-           XKOE=(4./27.)*(AKOE**3/BKOE)
-           AKOE23=AKOE*2./3.
-           R03=RCCN(I)**3
-           SUPCRITI=SQRT(XKOE/R03)
+   		IDSD_Negative = 0
+			CALL JERNEWF_KS &
+				    (NR,xiR,FI2R,PSI2R,xiNR,ISIGN_3POINT,TPN,IDROP,NKR,COL,IDSD_Negative,Ihydro,Iin,Jin,Kin,Itimestep)
+			IF(IDSD_Negative == 1)THEN
+				IF(ISIGN_KO_1 == 1) THEN
+					! ... (KS) - we do not use Kovatch-Ouland as separate method
+					!	CALL JERNEWF_KO_KS &
+    			!					(NR,xiR,FI2R,PSI2R,xiNR,NKR,COL)
+				ENDIF
+			ENDIF
+
+   		DO KR=1,NKR
+          IF(ITYPE==5) THEN
+		      			FR_LIM_KR=FRH_LIM(KR)
+	    		ELSE
+		      			FR_LIM_KR=FR_LIM(KR)
+					ENDIF
+		  		IF(PSI2R(KR)<0.0D0) THEN
+					  PRINT*,    'STOP 1506 : PSI2R(KR)<0.0D0, in JERDFUN_KS'
+						call wrf_error_fatal("fatal error in PSI2R(KR)<0.0D0, in JERDFUN_KS, model stop")
+			  	ENDIF
+    	  	PSI2(KR) = PSI2R(KR)
+   	 ENDDO
+! cycle by ICE
+! recalculation of size distribution functions                  (end)
+! in case ISYM2/=0
+	ENDIF
+! new size distribution functions                               (end)
 
-! RACT(I) - radii of activated drops, I=IMIN,...,IMAX
+  201	FORMAT(1X,D13.5)
+  304   FORMAT(1X,I2,2X,4D13.5)
 
-           IF(RCCN(I).LE.(0.3E-5)) &
-     &     RACT(I)=AKOE23/SUPCRITI
-           IF(RCCN(I).GT.(0.3E-5))&
-     &     RACT(I)=5.*RCCN(I)
-        ENDDO
-! cycle by I
+	RETURN
+	END SUBROUTINE JERDFUN_KS
+! +----------------------------------------------------------------------------+
+		SUBROUTINE JERNEWF_KS &
+       				(NRX,RR,FI,PSI,RN,I3POINT,TPN,IDROP,NKR,COL,IDSD_Negative,Ihydro, &
+              Iin,Jin,Kin,Itimestep)
 
-! calculation of I0
+        IMPLICIT NONE
+! ... Interface
+		INTEGER,INTENT(IN) :: NRX, I3POINT, NKR, Ihydro, Iin, Jin, Kin, Itimestep
+		INTEGER,INTENT(INOUT) :: IDROP, IDSD_Negative
+		real(kind=R8SIZE),INTENT(IN) :: TPN
+		real(kind=R4SIZE),INTENT(IN) :: COL
+		real(kind=R8SIZE),INTENT(INOUT) :: PSI(:), RN(:), FI(:), RR(:)
+! ... Interface
+
+! ... Locals
+		INTEGER :: KMAX, KR, I, K , NRXP, ISIGN_DIFFUSIONAL_GROWTH, NRX1,  &
+              I3POINT_CONDEVAP, IEvap
+		real(kind=R8SIZE) :: RNTMP,RRTMP,RRP,RRM,RNTMP2,RRTMP2,RRP2,RRM2, GN1,GN2, &
+               GN3,GN1P,GMAT,GMAT2, &
+							 CDROP(NRX),DELTA_CDROP(NRX),RRS(NRX+1),PSINEW(NRX+1), &
+							 PSI_IM,PSI_I,PSI_IP, AOLDCON, ANEWCON, AOLDMASS, ANEWMASS
+
+		INTEGER,PARAMETER :: KRDROP_REMAPING_MIN = 6, KRDROP_REMAPING_MAX = 12
+! ... Locals
+
+	IF(TPN .LT. 273.15-5.0D0) IDROP=0
 
-        I0=IMIN
+! INITIAL VALUES FOR SOME VARIABLES
 
-        DO I=IMIN,IMAX-1
-           IF(RACT(I+1).LT.RACT(I)) THEN
-             I0=I+1
-             GOTO 45
-           ENDIF
-        ENDDO
+		NRXP = NRX + 1
+!   NRX1 = 24
+!   NRX1 = 35
+	  NRX1 = NKR
 
- 45     CONTINUE
-! new changes 9.04.02                                         (begin)
-        I1=I0-1
-! new changes 9.04.02                                           (end)
+	  DO I=1,NRX
+! RN(I), g - new masses after condensation or evaporation
+	    IF(RN(I) < 0.0D0) THEN
+		     RN(I) = 1.0D-50
+	       FI(I) = 0.0D0
+	    ENDIF
+	 ENDDO
 
-        IF(I0.EQ.IMIN) GOTO 47
+! new change 26.10.09                                         (start)
+	DO K=1,NRX
+	   RRS(K)=RR(K)
+	ENDDO
+! new change 26.10.09                                           (end)
+
+	I3POINT_CONDEVAP = I3POINT
+
+	IEvap = 0
+	IF(RN(1) < RRS(1)) THEN
+! evaporation
+	  I3POINT_CONDEVAP = 0
+! new change 26.10.09                                         (start)
+	  IDROP = 0
+! new change 26.10.09                                           (end)
+	  NRX1 = NRX
+	  IEvap = 1
+	ENDIF
 
-! new changes 9.04.02                                         (begin)
+	IF(IDROP == 0) I3POINT_CONDEVAP = 0
 
-        IF(I0.EQ.IMAX) THEN
-          RACT(IMAX)=RACT(IMAX-1)
-          GOTO 47
-        ENDIF
+! new change 26.10.09                                         (start)
 
-        IF(RACT(IMAX).LE.RACT(I0-1)) THEN
-          DO I=I0,IMAX
-             RACT(I)=RACT(I0-1)
-          ENDDO
-          GOTO 47
-        ENDIF
+	DO K=1,NRX
+	   PSI(K)=0.0D0
+	   CDROP(K)=0.0D0
+	   DELTA_CDROP(K)=0.0D0
+	   PSINEW(K)=0.0D0
+	ENDDO
 
-! new changes 9.04.02                                           (end)
+	RRS(NRXP)=RRS(NRX)*1024.0D0
 
+	PSINEW(NRXP) = 0.0D0
 
+! new change 26.10.09                                           (end)
 
-! calculation of I1
+	ISIGN_DIFFUSIONAL_GROWTH = 0
 
-        DO I=I0+1,IMAX
-           IF(RACT(I).GE.RACT(I0-1)) THEN
-             I1=I
-             GOTO 46
-           ENDIF
-        ENDDO
- 46     CONTINUE
+	DO K=1,NRX
+	   IF(RN(K).NE.RR(K)) THEN
+		  ISIGN_DIFFUSIONAL_GROWTH = 1
+		  GOTO 2000
+	   ENDIF
+	ENDDO
 
-! spectrum of activated drops                                   (end)
+ 2000   CONTINUE
 
+	IF(ISIGN_DIFFUSIONAL_GROWTH == 1) THEN
 
-! line interpolation RACT(I) for I=I0,...,I1
+! Kovetz-Olund method                                         (start)
 
-        DO I=I0,I1
-           RACT(I)=RACT(I0-1)+(I-I0+1)*(RACT(I1)-RACT(I0-1)) &
-     &                       /(I1-I0+1)
-        ENDDO
+! new change 26.10.09                                         (start)
+	  DO K=1,NRX1 ! ... [KS] >> NRX1-1
+! new change 26.10.09                                           (end)
 
+		 IF(FI(K) > 0.0) THEN
+		   IF(DABS(RN(K)-RR(K)) < 1.0D-16) THEN
+	         PSINEW(K) = FI(K)*RR(K)
+	         CYCLE
+       ENDIF
 
-  47    CONTINUE
+		   I = 1
+		   DO WHILE (.NOT.(RRS(I) <= RN(K) .AND. RRS(I+1) >= RN(K)) &
+                 .AND.I.LT.NRX1) ! [KS] >> was NRX1-1
+                  I = I + 1
+       ENDDO
 
+       IF(RN(K).LT.RRS(1)) THEN
+          RNTMP=RN(K)
+          RRTMP=0.0D0
+          RRP=RRS(1)
+          GMAT2=(RNTMP-RRTMP)/(RRP-RRTMP)
+          PSINEW(1)=PSINEW(1)+FI(K)*RR(K)*GMAT2
+		   ELSE
+
+        RNTMP=RN(K)
+        RRTMP=RRS(I)
+        RRP=RRS(I+1)
+        GMAT2=(RNTMP-RRTMP)/(RRP-RRTMP)
+        GMAT=(RRP-RNTMP)/(RRP-RRTMP)
+        PSINEW(I)=PSINEW(I)+FI(K)*RR(K)*GMAT
+        PSINEW(I+1)=PSINEW(I+1)+FI(K)*RR(K)*GMAT2
+		   ENDIF
+! in case FI(K).NE.0.0D0
+		 ENDIF
 
+ 3000    CONTINUE
 
-        RACTMAX=0.
+	  ENDDO
+! cycle by K
 
-        DO I=IMIN,IMAX
-           RACTMAX=AMAX1(RACTMAX,RACT(I))
-	ENDDO
-        RETURN
+	  DO KR=1,NRX1
+       PSI(KR)=PSINEW(KR)
+	  ENDDO
 
-        END SUBROUTINE ACTIVATE
-        SUBROUTINE DROPMAX(DROPRADII,RACTMAX,NDROPMAX,NKR)
-        IMPLICIT NONE
-        INTEGER IDROP,NKR,NDROPMAX
-        REAL RACTMAX,DROPRADII(NKR)
-! calculation of NDROPMAX - maximal number of drop bin which
-! is activated
+	  DO KR=NRX1+1,NRX
+       PSI(KR)=FI(KR)
+	  ENDDO
+! Kovetz-Olund method                                           (end)
+
+! calculation both new total drop concentrations(after KO) and new
+! total drop masses (after KO)
+
+! 3point method	                                              (start)
+	  IF(I3POINT_CONDEVAP == 1) THEN
+	    DO K=1,NRX1-1
+		   IF(FI(K) > 0.0) THEN
+		      IF(DABS(RN(K)-RR(K)).LT.1.0D-16) THEN
+	           PSI(K) = FI(K)*RR(K)
+	           GOTO 3001
+	         ENDIF
 
-        NDROPMAX=1
+          IF(RRS(2).LT.RN(K)) THEN
+             I = 2
+             DO WHILE &
+                     (.NOT.(RRS(I) <= RN(K) .AND. RRS(I+1) >= RN(K)) &
+                     .AND.I.LT.NRX1-1)
+                    I = I + 1
+         		ENDDO
+             RNTMP=RN(K)
 
-        DO IDROP=1,NKR
-           IF(RACTMAX.LE.DROPRADII(IDROP)) THEN
-             NDROPMAX=IDROP
-             GOTO 44
-           ENDIF
-        ENDDO
- 44     CONTINUE
-        RETURN
-        END  SUBROUTINE DROPMAX
+             RRTMP=RRS(I)
+             RRP=RRS(I+1)
+             RRM=RRS(I-1)
 
+             RNTMP2=RN(K+1)
 
-        SUBROUTINE ONECOND1 &
-     & (TT,QQ,PP,ROR &
-     & ,VR1,PSINGLE &
-     & ,DEL1N,DEL2N,DIV1,DIV2 &
-     & ,FF1,PSI1,R1,RLEC,RO1BL &
-     & ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
-     & ,C1_MEY,C2_MEY &
-     & ,COL,DTCOND,ICEMAX,NKR)
+             RRTMP2=RRS(I+1)
+             RRP2=RRS(I+2)
+             RRM2=RRS(I)
 
-       IMPLICIT NONE
+             GN1=(RRP-RNTMP)*(RRTMP-RNTMP)/(RRP-RRM)/ &
+                  (RRTMP-RRM)
 
+             GN1P=(RRP2-RNTMP2)*(RRTMP2-RNTMP2)/ &
+                   (RRP2-RRM2)/(RRTMP2-RRM2)
 
-      INTEGER NKR,ICEMAX
-      REAL    COL,VR1(NKR),PSINGLE &
-     &       ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
-     &       ,DTCOND
-
-      REAL C1_MEY,C2_MEY
-      INTEGER I_ABERGERON,I_BERGERON, &
-     & KR,ICE,ITIME,KCOND,NR,NRM, &
-     & KLIMIT, &
-     & KM,KLIMITL  
-      REAL AL1,AL2,D,GAM,POD, &
-     & RV_MY,CF_MY,D_MYIN,AL1_MY,AL2_MY,ALC,DT0LREF,DTLREF, &
-     & A1_MYN, BB1_MYN, A2_MYN, BB2_MYN,DT,DTT,XRAD, &
-     & TPC1, TPC2, TPC3, TPC4, TPC5, &
-     & EPSDEL, EPSDEL2,DT0L, DT0I,&
-     & ROR, &
-     & CWHUCM,B6,B8L,B8I, &
-     & DEL1,DEL2,DEL1S,DEL2S, &
-     & TIMENEW,TIMEREV,SFN11,SFN12, &
-     & SFNL,SFNI,B5L,B5I,B7L,B7I,DOPL,DOPI,RW,RI,QW,PW, &
-     & PI,QI,DEL1N0,DEL2N0,D1N0,D2N0,DTNEWL,DTNEWL1,D1N,D2N, &
-     & DEL_R1,DT0L0,DT0I0, &
-     & DTNEWL0, &
-     & DTNEWL2 
-       REAL DT_WATER_COND,DT_WATER_EVAP
-
-       INTEGER K
-! NEW ALGORITHM OF CONDENSATION (12.01.00)
-
-      REAL  FF1_OLD(NKR),SUPINTW(NKR)
-      DOUBLE PRECISION DSUPINTW(NKR),DD1N,DB11_MY,DAL1,DAL2
-      DOUBLE PRECISION COL3,RORI,TPN,TPS,QPN,QPS,TOLD,QOLD &
-     &                  ,FI1_K,FI2_K,FI3_K,FI4_K,FI5_K &
-     &                  ,R1_K,R2_K,R3_K,R4_K,R5_K &
-     &                  ,FI1R1,FI2R2,FI3R3,FI4R4,FI5R5 &
-     &                  ,RMASSLAA,RMASSLBB,RMASSIAA,RMASSIBB &
-     &                  ,ES1N,ES2N,EW1N,ARGEXP &
-     &                  ,TT,QQ,PP &
-     &                  ,DEL1N,DEL2N,DIV1,DIV2 &
-     &                  ,OPER2,OPER3,AR1,AR2
-
-       DOUBLE PRECISION DELMASSL1
-
-! DROPLETS 
-                                                                       
-        REAL R1(NKR) &
-     &           ,RLEC(NKR),RO1BL(NKR) &
-     &           ,FI1(NKR),FF1(NKR),PSI1(NKR) &
-     &           ,B11_MY(NKR),B12_MY(NKR)
-
-! WORK ARRAYS 
-
-! NEW ALGORITHM OF MIXED PHASE FOR EVAPORATION
-
-       
-	REAL DTIMEO(NKR),DTIMEL(NKR) &
-     &           ,TIMESTEPD(NKR)
-
-! NEW ALGORITHM (NO TYPE OF ICE)
-
-
-
-	OPER2(AR1)=0.622/(0.622+0.378*AR1)/AR1
-	OPER3(AR1,AR2)=AR1*AR2/(0.622+0.378*AR1)
-
-        DATA AL1 /2500./, AL2 /2834./, D /0.211/ &
-     &      ,GAM /1.E-4/, POD /10./ 
-           
-	DATA RV_MY,CF_MY,D_MYIN,AL1_MY,AL2_MY &
-     &      /461.5,0.24E-1,0.211E-4,2.5E6,2.834E6/
-
-	DATA A1_MYN, BB1_MYN, A2_MYN, BB2_MYN &
-     &      /2.53,5.42,3.41E1,6.13/
-
-	DATA TPC1, TPC2, TPC3, TPC4, TPC5 &
-     &      /-4.0,-8.1,-12.7,-17.8,-22.4/ 
-
-
-        DATA EPSDEL, EPSDEL2 /0.1E-03,0.1E-03/  
-    
-	DATA DT0L, DT0I /1.E20,1.E20/
-
-! CONTROL OF DROP SPECTRUM IN SUBROUTINE ONECOND
-
-
-! CONTROL OF TIMESTEP ITERATIONS IN MIXED PHASE: EVAPORATION
-        
-        I_ABERGERON=0
-        I_BERGERON=0
-        COL3=3.0*COL
-        ITIME=0
-        KCOND=0
-        DT_WATER_COND=0.4
-        DT_WATER_EVAP=0.4
-	ITIME=0
-	KCOND=0
-        DT0LREF=0.2
-        DTLREF=0.4
+             GN2=(RRP-RNTMP)*(RNTMP-RRM)/(RRP-RRTMP)/ &
+                   (RRTMP-RRM)
 
-	NR=NKR
-	NRM=NKR-1
-	DT=DTCOND
-	DTT=DTCOND
-	XRAD=0.
-
-!     BARRY
-	CWHUCM=0.
-	XRAD=0.
-	B6=CWHUCM*GAM-XRAD
-	B8L=1./ROR
-	B8I=1./ROR
-        RORI=1./ROR
-
-! INITIALIZATION OF SOME ARRAYS
-!       print*, 'got to here 0'
-
-!       BARRY: REMOVE RS2 LOOP
-        DO KR=1,NKR
-           FF1_OLD(KR)=FF1(KR)
-           SUPINTW(KR)=0.
-           DSUPINTW(KR)=0.
-        ENDDO
-! OLD TREATMENT OF "T" & "Q" 
-!DEL12RD=DEL12R**DEL_BBR
-! BARRY
-!       EW1PN=AA1_MY*(100.+DEL1IN*100.)*DEL12RD/100.
-! 	QQIN=OPER4(EW1PN,PP)
-        TPN=TT
-        QPN=QQ
-        DO 19 KR=1,NKR
-              FI1(KR)=FF1(KR)
-19     CONTINUE
-! WARM OR NO ICE (BEGIN)
-! ONLY WATER (CONDENSATION OR EVAPORATION) (BEGIN)
-              TIMENEW=0.
-              ITIME=0
-! NEW CHANGES 10.01.01 (BEGIN)
-              TOLD=TPN
-              QOLD=QPN
-! NEW CHANGES 10.01.01 (END)
-   56         ITIME=ITIME+1
-              TIMEREV=DT-TIMENEW
-              TIMEREV=DT-TIMENEW
-              DEL1=DEL1N
-              DEL2=DEL2N
-              DEL1S=DEL1N
-              DEL2S=DEL2N
-              TPS=TPN
-              QPS=QPN
-! NO QPS IN JERRATE
-              CALL JERRATE(R1,TPS,PP,ROR,VR1,PSINGLE &
-     &                    ,RLEC,RO1BL,B11_MY,B12_MY,1,1,ICEMAX,NKR)
-
-! INTEGRALS IN DELTA EQUATION (ONLY WATER)
-
-! CONTROL OF DROP SPECRUM IN SUBROUTINE ONECOND
-
-
-! CALL JERTIMESC WATER - 1 (ONLY WATER)
-
-              CALL JERTIMESC(FI1,R1,SFN11,SFN12 &
-     &                      ,B11_MY,B12_MY,RLEC,B8L,1,COL,NKR)        
-
-
-	      SFNL=SFN11+SFN12
-	      SFNI=0.       
-
-! SOME CONSTANTS 
-	      B5L=BB1_MY/TPS/TPS
-	      B5I=BB2_MY/TPS/TPS
-              B7L=B5L*B6                                                     
-              B7I=B5I*B6
-	      DOPL=1.+DEL1S                                                     
-	      DOPI=1.+DEL2S                                                     
-              RW=(OPER2(QPS)+B5L*AL1)*DOPL*SFNL                                                 
-              RI=(OPER2(QPS)+B5L*AL2)*DOPL*SFNI
-	      QW=B7L*DOPL
-	      PW=(OPER2(QPS)+B5I*AL1)*DOPI*SFNL
-              PI=(OPER2(QPS)+B5I*AL2)*DOPI*SFNI
-              QI=B7I*DOPI
-
-! SOLVING FOR TIMEZERO
-
-
-
-	      KCOND=10
-
-	      IF(DEL1.GT.0) KCOND=11
-
-! PROCESS'S TYPE 
-
-	      IF(KCOND.EQ.11) THEN
-! NEW TIME STEP IN CONDENSATION (ONLY WATER) (BEGIN)
-                IF (DEL1N.EQ.0)THEN
-	           DTNEWL=DT
-                ELSE
-                 DTNEWL=ABS(R1(ITIME)/(B11_MY(ITIME)*DEL1N &
-     &                               -B12_MY(ITIME)))
-	         IF(DTNEWL.GT.DT) DTNEWL=DT
-                END IF
-                IF(ITIME.GE.NKR) THEN
-                call wrf_error_fatal("fatal error in module_mp_fast_sbm (ITIME.GE.NKR), model stop")
-                ENDIF
-                TIMESTEPD(ITIME)=DTNEWL
+ 	           GMAT=(RRP-RNTMP)/(RRP-RRTMP)
 
-! NEW TIME STEP (ONLY WATER: CONDENSATION)
+             GN3=(RRTMP-RNTMP)*(RRM-RNTMP)/(RRP-RRM)/ &
+                                           (RRP-RRTMP)
+             GMAT2=(RNTMP-RRTMP)/(RRP-RRTMP)
 
+             PSI_IM = PSI(I-1)+GN1*FI(K)*RR(K)
 
-	        IF((TIMENEW+DTNEWL).GT.DT.AND.ITIME.LT.(NKR-1))  & 
-     &          DTNEWL=DT-TIMENEW
-                IF(ITIME.EQ.(NKR-1)) DTNEWL=DT-TIMENEW
+             PSI_I = PSI(I)+GN1P*FI(K+1)*RR(K+1)+&
+                   (GN2-GMAT)*FI(K)*RR(K)
 
-	        TIMESTEPD(ITIME)=DTNEWL
+             PSI_IP = PSI(I+1)+(GN3-GMAT2)*FI(K)*RR(K)
 
-	        TIMENEW=TIMENEW+DTNEWL
+             IF(PSI_IM > 0.0D0) THEN
 
-	        DTT=DTNEWL
+               IF(PSI_IP > 0.0D0) THEN
 
-! SOLVING FOR SUPERSATURATION 
+                 IF(I > 2) THEN
+! smoothing criteria
+                   IF(PSI_IM > PSI(I-2) .AND. PSI_IM < PSI_I &
+                     .AND. PSI(I-2) < PSI(I) .OR. PSI(I-2) >= PSI(I)) THEN
 
-! CALL JERSUPSAT - 2 (NEW TIMESTEP - ONLY WATER)
+                      PSI(I-1) = PSI_IM
 
+                      PSI(I) = PSI(I) + FI(K)*RR(K)*(GN2-GMAT)
 
-	        CALL JERSUPSAT(DEL1,DEL2,DEL1N,DEL2N &
-     &                        ,RW,PW,RI,PI,QW,QI &
-     &                        ,DTT,D1N,D2N,DT0L,DT0I)
+                      PSI(I+1) = PSI_IP
+! in case smoothing criteria
+                   ENDIF
+! in case I.GT.2
+                 ENDIF
 
-! END OF "NEW SUPERSATURATION"
+! in case PSI_IP.GT.0.0D0
+					   ELSE
+						         EXIT
+   	         ENDIF
+! in case PSI_IM.GT.0.0D0
+				  ELSE
+				        EXIT
+          ENDIF
+! in case I.LT.NRX1-2
+!         ENDIF
 
-! DROPLETS 
+! in case RRS(2).LT.RN(K)
+       ENDIF
 
-! DROPLET DISTRIBUTION FUNCTION 
-                                                         
-! CALL JERDFUN WATER - 1 (ONLY WATER: CONDENSATION)
-	          CALL JERDFUN(R1,B11_MY,B12_MY &
-     &                        ,FI1,PSI1,D1N &
-     &                        ,1,1,COL,NKR,TPN)
+! in case FI(K).NE.0.0D0
+      ENDIF
 
-	        IF((DEL1.GT.0.AND.DEL1N.LT.0) &
-     &         .AND.ABS(DEL1N).GT.EPSDEL) THEN
-             call wrf_error_fatal("fatal error in module_mp_fast_sbm (DEL1.GT.0.AND.DEL1N.LT.0), model stop")
-	        ENDIF
+ 3001 CONTINUE
 
-! IN CASE : KCOND.EQ.11
+	    ENDDO
+        ! cycle by K
 
-	      ELSE
+      ! in case I3POINT_CONDEVAP.NE.0
+	  ENDIF
+! 3 point method                                                (end)
 
-! EVAPORATION - ONLY WATER 
-
-! IN CASE : KCOND.NE.11
-               IF (DEL1N.EQ.0)THEN
-                DTIMEO(1)=DT
-	        DO KR=2,NKR
-	           DTIMEO(KR)=DT
-	        ENDDO
-               ELSE
-	        DTIMEO(1)=-R1(1)/(B11_MY(1)*DEL1N-B12_MY(1))
-
-	        DO KR=2,NKR
-	           KM=KR-1
-	           DTIMEO(KR)=(R1(KM)-R1(KR))/(B11_MY(KR)*DEL1N &
-     &                                       -B12_MY(KR))
-	        ENDDO
-               END IF
+! PSI(K) - new hydrometeor size distribution function
 
-	        KLIMIT=1
+	  DO K=1,NRX1
+	     PSI(K)=PSI(K)/RR(K)
+	  ENDDO
 
-	        DO KR=1,NKR
-	           IF(DTIMEO(KR).GT.TIMEREV) GOTO 55
-	           KLIMIT=KR
-	        ENDDO
+	  DO K=NRX1+1,NRX
+		 PSI(K)=FI(K)
+	  ENDDO
 
-   55           KLIMIT=KLIMIT-1
+	  IF(IDROP == 1) THEN
+				DO K=KRDROP_REMAPING_MIN,KRDROP_REMAPING_MAX
+					CDROP(K)=3.0D0*COL*PSI(K)*RR(K)
+				ENDDO
+	       ! KMAX - right boundary spectrum of drop sdf
+	        !(KRDROP_REMAP_MIN =< KMAX =< KRDROP_REMAP_MAX)
+				DO K=KRDROP_REMAPING_MAX,KRDROP_REMAPING_MIN,-1
+				   KMAX=K
+				   IF(PSI(K).GT.0.0D0) GOTO 2011
+				ENDDO
+
+	 2011  CONTINUE
+	! Andrei's new change 28.04.10                                (start)
+				DO K=KMAX-1,KRDROP_REMAPING_MIN,-1
+	! Andrei's new change 28.04.10                                  (end)
+					IF(CDROP(K).GT.0.0D0) THEN
+						DELTA_CDROP(K)=CDROP(K+1)/CDROP(K)
+							IF(DELTA_CDROP(K).LT.COEFF_REMAPING) THEN
+								CDROP(K)=CDROP(K)+CDROP(K+1)
+								CDROP(K+1)=0.0D0
+							ENDIF
+					ENDIF
+				ENDDO
+
+				DO K=KRDROP_REMAPING_MIN,KMAX
+					PSI(K)=CDROP(K)/(3.0D0*COL*RR(K))
+				ENDDO
+
+	! in case IDROP.NE.0
+		  ENDIF
+
+! new change 26.10.09                                           (end)
+
+! in case ISIGN_DIFFUSIONAL_GROWTH.NE.0
+        ELSE
+! in case ISIGN_DIFFUSIONAL_GROWTH.EQ.0
+  	  		DO K=1,NRX
+  	     		PSI(K)=FI(K)
+  	  		ENDDO
+       ENDIF
 
-	        IF(KLIMIT.LT.1) KLIMIT=1
+		DO KR=1,NRX
+	   		IF(PSI(KR) < 0.0) THEN ! ... (KS)
+					IDSD_Negative = 1
+					print*, "IDSD_Negative=",IDSD_Negative,"kr",kr
+					PRINT*,    'IN SUBROUTINE JERNEWF'
+					PRINT*,		'PSI(KR)<0'
+					PRINT*,    'BEFORE EXIT'
+					PRINT*,    'ISIGN_DIFFUSIONAL_GROWTH'
+					PRINT*,     ISIGN_DIFFUSIONAL_GROWTH
+					PRINT*,    'I3POINT_CONDEVAP'
+					PRINT*,     I3POINT_CONDEVAP
+					PRINT*,    'K,RR(K),RN(K),K=1,NRX'
+					PRINT*,    (K,RR(K),RN(K),K=1,NRX)
+					PRINT*,    'K,RR(K),RN(K),FI(K),PSI(K),K=1,NRX'
+					PRINT 304, (K,RR(K),RN(K),FI(K),PSI(K),K=1,NRX)
+					PRINT*,		IDROP,Ihydro,Iin,Jin,Kin,Itimestep
+          call wrf_error_fatal("fatal error in SUBROUTINE JERNEWF PSI(KR)<0, < min, model stop")
+			ENDIF
+		ENDDO
+
+  304   FORMAT(1X,I2,2X,4D13.5)
 
-! BARRY THIS LINE CAUSED A PROBLEM BECAUSE DTNEWL GOES FROM
-! LARGE TO SMALL
-  	        DTNEWL1=AMIN1(DTIMEO(3),TIMEREV)
-                IF(DTNEWL1.LT.DTLREF) DTNEWL1=AMIN1(DTLREF,TIMEREV)
-	        DTNEWL=DTNEWL1
-	        IF(ITIME.GE.NKR) THEN
-           call wrf_error_fatal("fatal error in module_mp_fast_sbm (ITIME.GE.NKR), model stop")
-	        ENDIF
+        RETURN
+        END SUBROUTINE JERNEWF_KS
+! +------------------------------------------------------------------+
+	SUBROUTINE JERDFUN_NEW_KS &
+       				(xi,xiN,B21_MY, &
+        			FI2,PSI2, &
+        			TPN,IDROP,FR_LIM,NKR,COL,Ihydro,Iin,Jin,Kin,Itimestep)
+
+	IMPLICIT NONE
+
+! ... Interface
+	INTEGER,INTENT(INOUT) :: IDROP, NKR
+	INTEGER,INTENT(IN) :: Ihydro,Iin,Jin,Kin,Itimestep
+	REAL(kind=R4SIZE),intent(IN) :: FI2(:), B21_MY(:), FR_LIM(:), COL
+	REAL(kind=R8SIZE), INTENT(IN) :: TPN, xi(:)
+	REAL(kind=R4SIZE),INTENT(INOUT) :: PSI2(:)
+	REAL(kind=R8SIZE),INTENT(INOUT) :: xiN(:)
+! ... Interface
+
+! ... Locals
+	INTEGER :: NR, KR, IDSD_Negative
+	REAL(kind=R8SIZE) :: C, DEGREE1, DEGREE2, DEGREE3, D, RATEXI, B, A, &
+						           xiR(NKR),FI2R(NKR),PSI2R(NKR),xiNR(NKR)
+! ... Locals
+
+	C=2.0D0/3.0D0
+
+	DEGREE1=C/2.0D0
+	DEGREE2=C
+	DEGREE3=3.0D0/2.0D0
 
-	        TIMESTEPD(ITIME)=DTNEWL
+	NR=NKR
 
-! NEW TIME STEP (ONLY_WATER: EVAPORATION)
+	xiR = xi
+	FI2R = FI2
+	PSI2R = PSI2
+	xiNR = xiN
 
-	        IF(DTNEWL.GT.DT) DTNEWL=DT
-                IF((TIMENEW+DTNEWL).GT.DT.AND.ITIME.LT.(NKR-1))  &
-     &          DTNEWL=DT-TIMENEW
-                IF(ITIME.EQ.(NKR-1)) DTNEWL=DT-TIMENEW
+! new drop size distribution functions                             (start)
 
-	        TIMESTEPD(ITIME)=DTNEWL
+! drop diffusional growth
 
-	        TIMENEW=TIMENEW+DTNEWL
+	DO KR=1,NKR
+	   D = xiR(KR)**DEGREE1
+! Andrei's new change of 3.09.10                              (start)
+!	   RATExi=C*DEL2N*B21_MY(KR)/D
+	   RATExi = C*B21_MY(KR)/D
+! Andrei's new change of 3.09.10                                (end)
+	   B = xiR(KR)**DEGREE2
+	   A = B+RATExi
+	   IF(A<0.0D0) THEN
+	     xiNR(KR) = 1.0D-50
+	   ELSE
+	     xiNR(KR) = A**DEGREE3
+	   ENDIF
+	ENDDO
 
-	        DTT=DTNEWL
+! recalculation of size distribution functions                (start)
+
+	IDSD_Negative = 0
+	CALL JERNEWF_KS &
+			(NR,xiR,FI2R,PSI2R,xiNR,ISIGN_3POINT,TPN,IDROP,NKR,COL,IDSD_Negative,Ihydro,Iin,Jin,Kin,Itimestep)
+	IF(IDSD_Negative == 1)THEN
+		IF(ISIGN_KO_2 == 1) THEN
+			! ... (KS) - we do not use Kovatch-Ouland as separate method
+	  	!	CALL JERNEWF_KO_KS &
+      !  				(NR,xiR,FI2R,PSI2R,xiNR,NKR,COL)
+		ENDIF
+	ENDIF
 
-! SOLVING FOR SUPERSATURATION 
+	PSI2 = PSI2R
 
+! recalculation of drop size distribution functions                  (end)
+! new drop size distribution functions                          (end)
 
-! CALL JERSUPSAT - 3 (ONLY_WATER: EVAPORATION)
+  201	FORMAT(1X,D13.5)
 
-	        CALL JERSUPSAT(DEL1,DEL2,DEL1N,DEL2N &
-     &                        ,RW,PW,RI,PI,QW,QI &
-     &                        ,DTT,D1N,D2N,DT0L0,DT0I0)
-! END OF "NEW SUPERSATURATION"
+	RETURN
+	END SUBROUTINE JERDFUN_NEW_KS
+! +---------------------------------------------------------+
+	SUBROUTINE Relaxation_Time(TPS,QPS,PP,ROR,DEL1S,DEL2S, &
+            							   R1,VR1,FF1in,RLEC,RO1BL, &
+            							   R2,VR2,FF2in,RIEC,RO2BL, &
+            							   R3,VR3,FF3in,RSEC,RO3BL, &
+            							   R4,VR4,FF4in,RGEC,RO4BL, &
+            							   R5,VR5,FF5in,RHEC,RO5BL, &
+            							   NKR,ICEMAX,COL,DTdyn,NCOND,DTCOND)
+
+	implicit none
+! ... Interface
+	integer,intent(in) :: NKR,ICEMAX
+	integer,intent(out) :: NCOND
+	real(kind=R4SIZE),intent(in) :: R1(:),FF1in(:),RLEC(:),RO1BL(:), &
+					   R2(:,:),FF2in(:,:),RIEC(:,:),RO2BL(:,:), &
+					   R3(NKR),FF3in(:),RSEC(:),RO3BL(:), &
+					   R4(NKR),FF4in(:),RGEC(:),RO4BL(:), &
+					   R5(NKR),FF5in(:),RHEC(:),RO5BL(:), &
+					   ROR,COL,DTdyn,VR1(:),VR2(:,:),VR3(:),VR4(:),VR5(:)
+  real(kind=R8SIZE),intent(in) :: TPS,QPS,PP,DEL1S,DEL2S
+  real(kind=R4SIZE),intent(out) :: DTCOND
+! ... Interface
+! ... Local
+	integer :: ISYM1, ISYM2(ICEMAX), ISYM3, ISYM4, ISYM5, ISYM_SUM, ICM
+  real(kind=R8SIZE),parameter :: AA1_MY = 2.53D12, BB1_MY = 5.42D3, AA2_MY = 3.41D13, &
+                                 BB2_MY = 6.13E3, AL1 = 2500.0, AL2 = 2834.0
+	real(kind=R8SIZE),parameter :: TAU_Min = 0.1 ! [s]
+	real(kind=R8SIZE) :: OPER2, AR1, TAU_RELAX, B5L, B5I, &
+						           R1D(NKR), R2D(NKR,ICEMAX), R3D(NKR), R4D(NKR), R5D(NKR), &
+                       VR1_d(nkr),VR2_d(nkr,icemax),VR3_d(nkr),VR4_d(nkr),VR5_d(nkr)
+	real(kind=R4SIZE) :: B11_MY(NKR), B21_MY(NKR,ICEMAX), B31_MY(NKR), &
+			                 B41_MY(NKR), B51_MY(NKR), FL1(NKR), FL3(NKR), FL4(NKR), FL5(NKR), &
+                       SFNDUMMY(3), SFN11, SFNI1(ICEMAX), SFNII1, SFN21, SFN31, SFN41, SFN51, SFNI, SFNL, B8L, B8I, RI, PW, &
+	                     DOPL, DOPI, TAU_w, TAU_i, phi, RW, PI
+! ... Local
+
+		OPER2(AR1)=0.622/(0.622+0.378*AR1)/AR1
+    VR1_d = VR1
+    VR2_d = VR2
+    VR3_d = VR3
+    VR4_d = VR4
+    VR5_d = VR5
+
+
+		ISYM1 = 0
+		ISYM2 = 0
+		ISYM3 = 0
+		ISYM4 = 0
+		ISYM5 = 0
+		IF(sum(FF1in) > 0.0) ISYM1 = 1
+		IF(sum(FF2in(:,1)) > 1.0D-10) ISYM2(1) = 1
+		IF(sum(FF2in(:,2)) > 1.0D-10) ISYM2(2) = 1
+		IF(sum(FF2in(:,3)) > 1.0D-10) ISYM2(3) = 1
+		IF(sum(FF3in) > 1.0D-10) ISYM3 = 1
+		IF(sum(FF4in) > 1.0D-10) ISYM4 = 1
+		IF(sum(FF5in) > 1.0D-10) ISYM5 = 1
+
+		ISYM_SUM = ISYM1 + sum(ISYM2) + ISYM3 + ISYM4  + ISYM5
+		IF(ISYM_SUM == 0)THEN
+			TAU_RELAX = DTdyn
+			NCOND = nint(DTdyn/TAU_RELAX)
+		    DTCOND = TAU_RELAX
+        RETURN
+		ENDIF
+
+		R1D = R1
+		R2D = R2
+		R3D = R3
+		R4D = R4
+		R5D = R5
+		B8L=1./ROR
+   	B8I=1./ROR
+		ICM = ICEMAX
+		SFN11 = 0.0
+		SFNI1 = 0.0
+		SFN31 = 0.0
+		SFN41 = 0.0
+		SFN51 = 0.0
+		B11_MY = 0.0
+		B21_MY = 0.0
+		B31_MY = 0.0
+		B41_MY = 0.0
+		B51_MY = 0.0
+
+
+		  ! ... Drops
+		  IF(ISYM1 == 1)THEN
+  			FL1 = 0.0
+  			CALL JERRATE_KS &
+           	 	(R1D,TPS,PP,VR1_d,RLEC,RO1BL,B11_MY,1,1,fl1,NKR,ICEMAX)
+  			sfndummy(1) = SFN11
+  			SFN11 = sfndummy(1)
+		  ENDIF
+		  ! ... IC
+		  !IF(sum(ISYM2) > 0) THEN
+	  	!	FL1 = 0.0
+	  	!	! ... ice crystals
+		  !	CALL JERRATE_KS (R2D,TPS,PP,VR2_d,RIEC,RO2BL,B21_MY,3,2,fl1,NKR,ICEMAX)
+		  !	CALL JERTIMESC_KS (FF2in,R2D,SFNI1,B21_MY,B8I,ICM,NKR,ICEMAX,COL)
+		  !ENDIF
+      ! ... Snow
+      IF(ISYM3 == 1) THEN
+	  		FL3 = 0.0
+	  		! ... snow
+		  	CALL JERRATE_KS (R3D,TPS,PP,VR3_d,RSEC,RO3BL,B31_MY,1,3,fl3,NKR,ICEMAX)
+		  	sfndummy(1) = SFN31
+		  	CALL JERTIMESC_KS(FF3in,R3D,SFNDUMMY,B31_MY,B8I,1,NKR,ICEMAX,COL)
+	  	  	SFN31 = sfndummy(1)
+     	ENDIF
+      ! ... Graupel
+     IF(ISYM4 == 1) THEN
+	  		FL4 = 0.0
+	  		! ... graupel
+		  	CALL JERRATE_KS(R4D,TPS,PP,VR4_d,RGEC,RO4BL,B41_MY,1,2,fl4,NKR,ICEMAX)
+
+		  	sfndummy(1) = SFN41
+		  	CALL JERTIMESC_KS(FF4in,R4D,SFNDUMMY,B41_MY,B8I,1,NKR,ICEMAX,COL)
+	  	  	SFN41 = sfndummy(1)
+	   ENDIF
+      ! ... Hail
+      IF(ISYM5 == 1) THEN
+        FL5 = 0.0
+        ! ... hail
+        CALL JERRATE_KS(R5D,TPS,PP,VR5_d,RHEC,RO5BL,B51_MY,1,2,fl5,NKR,ICEMAX)
+
+        sfndummy(1) = SFN51
+        CALL JERTIMESC_KS(FF5in,R5D,SFNDUMMY,B51_MY,B8I,1,NKR,ICEMAX,COL)
+        SFN51 = sfndummy(1)
+  	  ENDIF
+
+		  SFNII1 = 0.0
+		  SFN21 = 0.0
+		  SFNL = 0.0
+		  SFNI = 0.0
+		  RI = 0.0
+		  PW = 0.0
+		  SFNII1 = SFNI1(1)+SFNI1(2)+SFNI1(3)
+		  SFN21 = SFNII1 + SFN31 + SFN41 + SFN51
+		  SFNL = SFN11  ! Liquid
+		  SFNI = SFN21 	! Total Ice
+
+		  B5L=BB1_MY/TPS/TPS
+		  B5I=BB2_MY/TPS/TPS
+		  DOPL=1.+ DEL1S
+		  DOPI=1.+ DEL2S
+		  RW=(OPER2(QPS)+B5L*AL1)*DOPL*SFNL
+		  RI=(OPER2(QPS)+B5L*AL2)*DOPL*SFNI
+		  PW=(OPER2(QPS)+B5I*AL1)*DOPI*SFNL
+		  PI=(OPER2(QPS)+B5I*AL2)*DOPI*SFNI
+
+      TAU_w = DTdyn
+      TAU_i = DTdyn
+      phi = (1.0 + DEL2S)/(1.0 + DEL1S)
+      if(PW > 0.0 .or. PI > 0.0) TAU_w = (PW + phi*PI)**(-1.0)
+      if(RW > 0.0 .or. RI > 0.0) TAU_i =  phi/(RW + RI*phi)
+      TAU_RELAX = DTdyn
+		  IF(PW > 0.0 .or. RI > 0.0) TAU_RELAX = (PW + RI)**(-1.0)/3.0
+		  IF(PW > 0.0 .and. RI > 0.0) TAU_RELAX = min(TAU_w,TAU_i)/3.0
+
+      if(TAU_RELAX > DTdyn) TAU_RELAX = DTdyn/3.0
+		  if(TAU_RELAX < TAU_Min) TAU_RELAX = TAU_Min
+      IF(PW <= 0.0 .and. RI <= 0.0) TAU_RELAX = DTdyn
+
+		  !if(TAU_RELAX < DTdyn .and. IDebug_Print_DebugModule==1)then
+		  !		print*,"in Relaxation_Time,TAU_RELAX < DTdyn"
+			!  	print*,TAU_RELAX
+		  !endif
+
+		  !NCOND = nint(DTdyn/TAU_RELAX)
+		  NCOND = ceiling(DTdyn/TAU_RELAX)
+      DTCOND = TAU_RELAX
 
+	RETURN
+	END SUBROUTINE Relaxation_Time
+! +------------------------------+
+end module module_mp_SBM_Auxiliary
+! +-----------------------------------------------------------------------------+
+! +-----------------------------------------------------------------------------+
+ module module_mp_SBM_Nucleation
+
+ USE module_mp_SBM_Auxiliary,ONLY:POLYSVP
+
+ private
+ public JERNUCL01_KS, LogNormal_modes_Aerosol
+
+! Kind paramater
+ 	INTEGER, PARAMETER, PRIVATE:: R8SIZE = 8
+ 	INTEGER, PARAMETER, PRIVATE:: R4SIZE = 4
+
+	INTEGER,PARAMETER :: Use_cloud_base_nuc = 1
+	real(kind=r8size),PARAMETER::T_NUCL_DROP_MIN = -60.0D0
+	real(kind=r8size),PARAMETER::T_NUCL_ICE_MIN = -37.0D0
+! Ice nucleation method
+! using MEYERS method : ice_nucl_method == 0
+! using DE_MOTT method : ice_nucl_method == 1
+	INTEGER,PARAMETER :: ice_nucl_method = 0
+	INTEGER,PARAMETER :: ISIGN_TQ_ICENUCL = 1
+! DELSUPICE_MAX=59%
+	DOUBLE PRECISION,PARAMETER::DELSUPICE_MAX = 59.0D0
+
+ contains
+! +-----------------------------------------------------------------------------+
+ SUBROUTINE JERNUCL01_KS(PSI1_r, PSI2_r, FCCNR_r, 			   &
+						            XL_r, XI_r, TT, QQ, 			         &
+		                    ROR_r, PP_r, 				               &
+			                  SUP1, SUP2,      			  		       &
+			                  COL_r, 							               &
+			                  SUP2_OLD_r, DSUPICE_XYZ_r, 		     &
+			                  RCCN_r, DROPRADII_r, NKR, NKR_aerosol, ICEMAX, ICEPROCS, &
+			                  Win_r, Is_This_CloudBase, RO_SOLUTE, IONS, MWAERO, &
+			                  Iin, Jin, Kin)
+
+
+	implicit none
+
+ 	integer,intent(in) :: 	 Kin, Jin, Iin, NKR, NKR_aerosol, ICEMAX, ICEPROCS, Is_This_CloudBase,IONS
+ 	real(kind=r4size),intent(in) :: XL_r(:), XI_r(:,:), ROR_r, PP_r, COL_r, Win_r, &
+							             SUP2_OLD_r, DSUPICE_XYZ_r, RCCN_r(:), DROPRADII_r(:)
+  real(kind=r4size),intent(in) ::	 	   MWAERO, RO_SOLUTE
+ 	real(kind=r4size),intent(inout) :: 	 PSI1_r(:),PSI2_r(:,:),FCCNR_r(:)
+ 	real(kind=r8size),intent(inout) :: TT, QQ, SUP1,SUP2
+
+ ! ... Locals
+ 	integer :: KR, ICE, K
+ 	real(kind=r8size) :: DROPCONCN(NKR), ARG_1, COL3, RORI, TPN, QPN, TPC, AR1, AR2, OPER3,           &
+						           SUM_ICE, DEL2N, FI2(NKR,ICEMAX), TFREEZ_OLD, DTFREEZXZ, RMASSIAA_NUCL, RMASSIBB_NUCL, &
+		                   FI2_K, xi_K, FI2R2, DELMASSICE_NUCL, ES1N, ES2N, EW1N
+  real(kind=r8size),parameter :: AL2 = 2834.0D0
+  real(kind=r8size) :: PSI1(NKR),PSI2(NKR,ICEMAX),FCCNR(NKR_aerosol),ROR,XL(NKR),XI(NKR,ICEMAX),PP,COL, &
+						           SUP2_OLD,DSUPICE_XYZ,Win, RCCN(NKR_aerosol),DROPRADII(NKR)
+	real(kind=r4size) :: TPNreal
+ ! ... Locals
+
+ 	OPER3(AR1,AR2) = AR1*AR2/(0.622D0+0.378D0*AR1)
+
+	! ... Adjust the Imput
+	PSI1 = PSI1_r
+	PSI2 = PSI2_r
+	FCCNR = FCCNR_r
+	XL = XL_r
+	XI = XI_r
+	ROR = ROR_r
+	PP = PP_r
+	COL = COL_r
+	SUP2_OLD = SUP2_OLD_r
+	DSUPICE_XYZ = DSUPICE_XYZ_r
+	RCCN = RCCN_r
+	DROPRADII = DROPRADII_r
+  Win = Win_r
+
+	COL3 = 3.0D0*COL
+	RORI = 1.0D0/ROR
+
+! ... Drop Nucleation (start)
+	TPN = TT
+	QPN = QQ
+
+	TPC = TT - 273.15D0
+
+	IF(SUP1>0.0D0 .AND. TPC>T_NUCL_DROP_MIN) THEN
+		if(sum(FCCNR) > 0.0)then
+			DROPCONCN = 0.0D0
+			CALL WATER_NUCLEATION (COL, NKR_aerosol, PSI1, FCCNR, xl, TT, QQ, ROR, SUP1, DROPCONCN, &
+							 	   PP, Is_This_CloudBase, Win, RO_SOLUTE, RCCN, IONS,MWAERO)
+		endif
+		! ... Transfer drops to Ice-Crystals via direct homogenous nucleation
+		IF(TPC <= -38.0D0) THEN
+		  SUM_ICE = 0.0D0
+		  DO KR=1,NKR
+			  PSI2(KR,2) = PSI2(KR,2) + PSI1(KR)
+			  SUM_ICE = SUM_ICE + COL3*xl(KR)*xl(KR)*PSI1(KR)
+			  PSI1(KR) = 0.0D0
+		  END DO
+		  ARG_1 = 334.0D0*SUM_ICE*RORI
+		  TT = TT + ARG_1
+		ENDIF
+	ENDIF
+! ... Drop nucleation (end)
+! ... Nucleation of crystals (start)
+	DEL2N = 100.0D0*SUP2
+	TPC = TT-273.15D0
 
-! DROPLETS 
+	IF(TPC < 0.0D0 .AND. TPC >= T_NUCL_ICE_MIN .AND. DEL2N > 0.0D0) THEN
 
+		DO KR=1,NKR
+			DO ICE=1,ICEMAX
+				FI2(KR,ICE)=PSI2(KR,ICE)
+			ENDDO
+		ENDDO
 
-! DROPLET DISTRIBUTION FUNCTION (ONLY_WATER: EVAPORATION)
-                                                         
-! CALL JERDFUN WATER - 2 (ONLY_WATER: EVAPORATION)
-             
- 	          CALL JERDFUN(R1,B11_MY,B12_MY &
-     &                        ,FI1,PSI1,D1N &
-     &                        ,1,1,COL,NKR,TPN)
+	if(ice_nucl_method == 0) then
+	  CALL ICE_NUCL (PSI2,xi,SUP2,TT,DSUPICE_XYZ,SUP2_OLD,ICEMAX,NKR,COL)
+	endif
 
-! IN CASE : ISYML.NE.0 (ENDING OF 
-! "DROPLET DISTRIBUTION FUNCTION" (ONLY WATER: EVAPORATION)
+	IF(ISIGN_TQ_ICENUCL == 1) THEN
+		RMASSIAA_NUCL=0.0D0
+		RMASSIBB_NUCL=0.0D0
 
-!        ENDIF
+		! before ice crystal nucleation
+		DO K=1,NKR
+			DO ICE=1,ICEMAX
+			  FI2_K=FI2(K,ICE)
+			  xi_K=xi(K,ICE)
+			  FI2R2=FI2_K*xi_K*xi_K
+			  RMASSIBB_NUCL=RMASSIBB_NUCL+FI2R2
+			ENDDO
+		ENDDO
 
-	        IF((DEL1.LT.0.AND.DEL1N.GT.0) &
-     &         .AND.ABS(DEL1N).GT.EPSDEL) THEN
-            call wrf_error_fatal("fatal error in module_mp_fast_sbm (DEL1.LT.0.AND.DEL1N.GT.0), model stop")
-	        ENDIF
+		RMASSIBB_NUCL = RMASSIBB_NUCL*COL3*RORI
 
-! END OF "PROCESS'S TYPE" 
+		IF(RMASSIBB_NUCL < 0.0D0) RMASSIBB_NUCL = 0.0D0
 
-! IN CASE : KCOND.NE.11 (ONLY WATER: EVAPORATION)
+		! after ice crystal nucleation
+		DO K=1,NKR
+			DO ICE=1,ICEMAX
+			  FI2_K=PSI2(K,ICE)
+			  xi_K=xi(K,ICE)
+			  FI2R2=FI2_K*xi_K*xi_K
+			  RMASSIAA_NUCL=RMASSIAA_NUCL+FI2R2
+			ENDDO
+		ENDDO
 
-              ENDIF
+		RMASSIAA_NUCL = RMASSIAA_NUCL*COL3*RORI
 
-! IN CASES : KCOND.EQ.11 OR KCOND.NE.11 (BOTH CONDENSATION AND
-! EVAPORATION : ONLY WATER)
+		IF(RMASSIAA_NUCL < 0.0D0) RMASSIAA_NUCL=0.0D0
 
-! CONCENTRATION & MASS (ONLY WATER) 
+		DELMASSICE_NUCL = RMASSIAA_NUCL-RMASSIBB_NUCL
 
-      RMASSLBB=0.
-      RMASSLAA=0.
+		QPN = QQ-DELMASSICE_NUCL
+		QQ = QPN
 
-! BEFORE JERNEWF (ONLY WATER) 
+		TPN = TT + AL2*DELMASSICE_NUCL
+		TT = TPN
 
-              DO K=1,NKR
-                 FI1_K=FI1(K)
-                 R1_K=R1(K)
-                 FI1R1=FI1_K*R1_K*R1_K
-                 RMASSLBB=RMASSLBB+FI1R1
-              ENDDO
-              RMASSLBB=RMASSLBB*COL3*RORI
-! NEW CHANGE RMASSLBB
-              IF(RMASSLBB.LE.0.) RMASSLBB=0.
-              DO K=1,NKR
-                 FI1_K=PSI1(K)
-                 R1_K=R1(K)
-                 FI1R1=FI1_K*R1_K*R1_K
-                 RMASSLAA=RMASSLAA+FI1R1
-              ENDDO
-              RMASSLAA=RMASSLAA*COL3*RORI
-              IF(RMASSLAA.LE.0.) RMASSLAA=0.
-! NEW TREATMENT OF "T" & "Q" (ONLY WATER)
-              DELMASSL1=RMASSLAA-RMASSLBB
-              QPN=QPS-DELMASSL1
-              DAL1=AL1
-              TPN=TPS+DAL1*DELMASSL1
-! SUPERSATURATION (ONLY WATER)
-              ARGEXP=-BB1_MY/TPN
-              ES1N=AA1_MY*DEXP(ARGEXP)
-              ARGEXP=-BB2_MY/TPN
-              ES2N=AA2_MY*DEXP(ARGEXP)
-              EW1N=OPER3(QPN,PP)
-              IF(ES1N.EQ.0)THEN
-               DEL1N=0.5
-               DIV1=1.5
-              ELSE
-               DIV1=EW1N/ES1N
-               DEL1N=EW1N/ES1N-1.
-              END IF
-              IF(ES2N.EQ.0)THEN
-               DEL2N=0.5
-               DIV2=1.5
-              ELSE
-               DEL2N=EW1N/ES2N-1.
-               DIV2=EW1N/ES2N
-              END IF
-              DO KR=1,NKR
-                SUPINTW(KR)=SUPINTW(KR)+B11_MY(KR)*D1N
-                DD1N=D1N
-                DB11_MY=B11_MY(KR)
-                DSUPINTW(KR)=DSUPINTW(KR)+DB11_MY*DD1N
-              ENDDO
-! REPEATE TIME STEP (ONLY WATER: CONDENSATION OR EVAPORATION) 
-	      IF(TIMENEW.LT.DT) GOTO 56
-57            CONTINUE
-              CALL JERDFUN_NEW(R1,DSUPINTW &
-     &                        ,FF1_OLD,PSI1,D1N &
-     &                        ,1,1,COL,NKR,TPN)
-              RMASSLAA=0.0
-              RMASSLBB=0.0
-! BEFORE JERNEWF
-              DO K=1,NKR
-                 FI1_K=FF1_OLD(K)
-                 R1_K=R1(K)
-                 FI1R1=FI1_K*R1_K*R1_K
-                 RMASSLBB=RMASSLBB+FI1R1
-              ENDDO
-              RMASSLBB=RMASSLBB*COL3*RORI
-! NEW CHANGE RMASSLBB
-              IF(RMASSLBB.LT.0.0) RMASSLBB=0.0
-! AFTER  JERNEWF
-              DO K=1,NKR
-                 FI1_K=PSI1(K)
-                 R1_K=R1(K)
-                 FI1R1=FI1_K*R1_K*R1_K
-                 RMASSLAA=RMASSLAA+FI1R1
-              ENDDO
-              RMASSLAA=RMASSLAA*COL3*RORI
-! NEW CHANGE RMASSLAA
-              IF(RMASSLAA.LT.0.0) RMASSLAA=0.0
-              IF(RMASSLAA.LT.0.0) RMASSLAA=0.0
-! NEW TREATMENT OF "T" & "Q"
-              DELMASSL1=RMASSLAA-RMASSLBB
-! NEW CHANGES 10.01.01 (BEGIN)
-              QPN=QOLD-DELMASSL1
-              DAL1 = AL1
-              TPN=TOLD+DAL1*DELMASSL1
-! NEW CHANGES 10.01.01 (END)
-! SUPERSATURATION
-              ARGEXP=-BB1_MY/TPN
-              ES1N=AA1_MY*DEXP(ARGEXP)
-              ARGEXP=-BB2_MY/TPN
-              ES2N=AA2_MY*DEXP(ARGEXP)
-              EW1N=OPER3(QPN,PP)
-              IF(ES1N.EQ.0)THEN
-               DEL1N=0.5
-               DIV1=1.5
-   call wrf_error_fatal("fatal error in module_mp_fast_sbm (ES1N.EQ.0), model stop")
-              ELSE
-               DIV1=EW1N/ES1N
-               DEL1N=EW1N/ES1N-1.
-              END IF
-              IF(ES2N.EQ.0)THEN
-               DEL2N=0.5
-               DIV2=1.5
-   call wrf_error_fatal("fatal error in module_mp_fast_sbm (ES2N.EQ.0), model stop")
-              ELSE
-               DEL2N=EW1N/ES2N-1.
-               DIV2=EW1N/ES2N
-              END IF
-        TT=TPN
-        QQ=QPN
-	DO KR=1,NKR
-	   FF1(KR)=PSI1(KR)
-	ENDDO
+		TPNreal = TPN
+		ES1N = POLYSVP(TPNreal,0)
+		ES2N = POLYSVP(TPNreal,1)
 
+		EW1N = OPER3(QPN,PP)
 
+		SUP1 = EW1N/ES1N-1.0D0
+		SUP2 = EW1N/ES2N-1.0D0
 
+	  ! in case ISIGN_TQ_ICENUCL/=0
+	  ENDIF
 
-       RETURN
-!      END 
+	! in case TPC<0.AND.TPC>=T_NUCL_ICE_MIN.AND.DEL2N>0.D0
+	ENDIF
 
-  END SUBROUTINE ONECOND1
-!==================================================================
+! ... Nucleation of crystals (end)
+
+	! ... Output
+	PSI1_r = PSI1
+	PSI2_r = PSI2
+	FCCNR_r = FCCNR
+
+ RETURN
+ END SUBROUTINE JERNUCL01_KS
+! +-------------------------------------------------------------------------------------------------------------------------+
+ SUBROUTINE WATER_NUCLEATION (COL, NKR, PSI1, FCCNR, xl, TT, QQ, ROR, SUP1,     &
+                              DROPCONCN, PP, Is_This_CloudBase, Win, RO_SOLUTE, &
+                              RCCN, IONS, MWAERO)
+
+!===================================================================!
+!                                                                   !
+! DROP NUCLEATION SCHEME                                            !
+!                                                                   !
+! Authors: Khain A.P. & Pokrovsky A.G. July 2002 at Huji, Israel    !
+!                                                                   !
+!===================================================================!
+ implicit none
+
+! PSI1(KR), 1/g/cm3 - non conservative drop size distribution function
+! FCCNR(KR), 1/cm^3 - aerosol(CCN) non conservative, size distribution function
+! xl((KR), g        - drop bin masses
+
+  integer,intent(in) :: 			Is_This_CloudBase, NKR, IONS
+  real(kind=r8size),intent(in) :: 	xl(:), ROR, PP, Win, RCCN(:), COL
+  real(kind=r8size),intent(inout) :: FCCNR(:), PSI1(:), DROPCONCN(:), QQ, TT, SUP1
+  real(kind=r4size),intent(in) :: 	 RO_SOLUTE, MWAERO
+
+  ! ... Locals
+    integer :: 			IMAX, I, NCRITI, KR
+    real(kind=r8size) :: DX,AR2,RCRITI,DEG01,RORI,CCNCONC(NKR),AKOE,BKOE, AR1, OPER3, RCCN_MINIMUM, &
+						             DLN1, DLN2, RMASSL_NUCL, ES1N, EW1N
+   real(kind=r8size),parameter :: AL1 = 2500.0D0
+	 real(kind=r4size) :: TTreal
+  ! ... Locals
+
+	 OPER3(AR1,AR2)=AR1*AR2/(0.622D0+0.378D0*AR1)
+
+   DROPCONCN(:) = 0.0D0
+
+	DEG01 = 1.0D0/3.0D0
+	RORI=1.0/ROR
+
+	!RO_SOLUTE=2.16D0
+
+	! imax - right CCN spectrum boundary
+	IMAX = NKR
+	DO I=IMAX,1,-1
+	   IF(FCCNR(I) > 0.0D0) THEN
+		 IMAX = I
+		 exit
+	   ENDIF
+	ENDDO
 
+	NCRITI=0
+	! every iteration we will nucleate one bin, then we will check the new supersaturation
+	! and new Rcriti.
+    do while (IMAX>=NCRITI)
+	     CCNCONC = 0.0
+
+	! akoe & bkoe - constants in Koehler equation
+		    AKOE=3.3D-05/TT
+        !BKOE=2.0D0*4.3D0/(22.9D0+35.5D0)
+	      BKOE = ions*4.3/mwaero
+        BKOE=BKOE*(4.0D0/3.0D0)*3.141593D0*RO_SOLUTE
+
+        if(Use_cloud_base_nuc == 1) then
+	        if(Is_This_CloudBase == 1) then
+	            CALL Cloud_Base_Super (FCCNR, RCCN, TT, PP, Win, NKR, RCRITI, RO_SOLUTE, IONS, MWAERO, COL)
+          else
+ 	            ! rcriti, cm - critical radius of "dry" aerosol
+	            RCRITI = (AKOE/3.0D0)*(4.0D0/BKOE/SUP1/SUP1)**DEG01
+	        endif
+       else ! ismax_cloud_base==0
+            ! rcriti, cm - critical radius of "dry" aerosol
+            RCRITI=(AKOE/3.0D0)*(4.0D0/BKOE/SUP1/SUP1)**DEG01
+       endif
 
+        IF(RCRITI >= RCCN(IMAX)) EXIT ! nothing to nucleate
 
-!BARRY
-        SUBROUTINE JERDFUN(R2,B21_MY,B22_MY &
-     &                    ,FI2,PSI2,DEL2N &
-     &                    ,IND,ITYPE,COL,NKR,TPN)
-       IMPLICIT NONE
+        ! find the minimum bin to nucleate
+        NCRITI = IMAX
+        do while (RCRITI<=RCCN(NCRITI) .and. NCRITI>1)
+            NCRITI=NCRITI-1
+        enddo
 
-! CRYSTALS 
-       REAL COL,DEL2N
-                                                                       
-      INTEGER IND,ITYPE,KR,ICE,ITYP,NRM,NR,NKR,IDROP
-       REAL &
-     &       R2(NKR,IND),R2N(NKR,IND) &
-     &      ,FI2(NKR,IND),PSI2(NKR,IND) &
-     &      ,B21_MY(NKR,IND),B22_MY(NKR,IND) &
-     &      ,DEL_R2M(NKR,IND)
-        DOUBLE PRECISION R2R(NKR),R2NR(NKR),FI2R(NKR),PSI2R(NKR)
-        DOUBLE PRECISION DR2(NKR,IND),DR2N(NKR,IND),DDEL2N, &
-     &     DB21_MY(NKR,IND)
-       DOUBLE PRECISION CHECK,TPN
-          CHECK=0.D0
-           DO KR=1,NKR
-             CHECK=B21_MY(1,1)*B21_MY(KR,1)
-             IF (CHECK.LT.0) call wrf_error_fatal("fatal error in module_mp_fast_sbm (CHECK.LT.0), model stop") 
-           END DO
+		! rccn_minimum - minimum aerosol(ccn) radius
+        RCCN_MINIMUM = RCCN(1)/10000.0D0
+		! calculation of ccnconc(ii)=fccnr(ii)*col - aerosol(ccn) bin
+		!                                            concentrations,
+		!                                            ii=imin,...,imax
+		! determination of ncriti   - number bin in which is located rcriti
+		! calculation of ccnconc(ncriti)=fccnr(ncriti)*dln1/(dln1+dln2),
+		! where,
+		! dln1=Ln(rcriti)-Ln(rccn_minimum)
+		! dln2=Ln(rccn(1)-Ln(rcriti)
+		! calculation of new value of fccnr(ncriti)
+
+        ! each iteration we nucleate the last bin
+        IF (NCRITI==IMAX-1) then
+            if (NCRITI>1) then
+               DLN1=DLOG(RCRITI)-DLOG(RCCN(IMAX-1))
+               DLN2=COL-DLN1
+	           CCNCONC(IMAX)=DLN2*FCCNR(IMAX)
+	           FCCNR(IMAX)=FCCNR(IMAX)*DLN1/COL
+            else ! NCRITI==1
+               DLN1=DLOG(RCRITI)-DLOG(RCCN_MINIMUM)
+               DLN2=DLOG(RCCN(1))-DLOG(RCRITI)
+	           CCNCONC(IMAX)=DLN2*FCCNR(IMAX)
+	           FCCNR(IMAX)=FCCNR(IMAX)*DLN1/(DLN1+DLN2)
+            endif
+        else
+             CCNCONC(IMAX) = COL*FCCNR(IMAX)
+             FCCNR(IMAX)=0.0D0
+        endif
 
-	IF(IND.NE.1) THEN
-	  ITYP=ITYPE
-        ELSE
-	  ITYP=1
-	ENDIF
+        ! calculate the mass change due to nucleation
+        RMASSL_NUCL=0.0D0
+        if (IMAX <= NKR-8) then ! we pass it to drops mass grid
+	   		    DROPCONCN(1) = DROPCONCN(1)+CCNCONC(IMAX)
+           	RMASSL_NUCL = RMASSL_NUCL+CCNCONC(IMAX)*XL(1)*XL(1)
+        else
+	   		    DROPCONCN(8-(NKR-IMAX)) = DROPCONCN(8-(NKR-IMAX))+CCNCONC(IMAX)
+           	RMASSL_NUCL = RMASSL_NUCL + CCNCONC(IMAX)*XL(8-(NKR-IMAX))*XL(8-(NKR-IMAX))
+        endif
+        RMASSL_NUCL = RMASSL_NUCL*COL*3.0*RORI
+
+        ! prepering to check if we need to nucleate the next bin
+        IMAX = IMAX-1
+
+   ! cycle IMAX>=NCRITI
+   end do
+
+   ! ... Intergarting for including the previous nucleated drops
+   IF(sum(DROPCONCN) > 0.0)THEN
+	    DO KR = 1,8
+	       DX = 3.0D0*COL*xl(KR)
+	       PSI1(KR) = PSI1(KR)+DROPCONCN(KR)/DX
+ 	    ENDDO
+   ENDIF
+
+ RETURN
+ END SUBROUTINE WATER_NUCLEATION
+! +--------------------------------------------------------------------------+
+!====================================================================!
+!                                                                    !
+! ICE NUCLEATION SCHEME                                              !
+!                                                                    !
+! Authors: Khain A.P. & Pokrovsky A.G. July 2002 at Huji, Israel     !
+!                                                                    !
+!====================================================================!
+
+  SUBROUTINE ICE_NUCL (PSI2,xi,SUP2,TT,DSUPICE_XYZ,SUP2_OLD,ICEMAX,NKR,COL)
+
+	implicit none
+
+	integer,intent(in) :: NKR, ICEMAX
+	real(kind=r8size),intent(in) :: xi(:,:), DSUPICE_XYZ, COL
+	real(kind=r8size),intent(inout) :: PSI2(:,:),TT,SUP2,SUP2_OLD
+
+	! ... Locals
+	integer :: KR,ICE,ITYPE
+	real(kind=r8size) :: FI2(NKR,ICEMAX), CONCI_BFNUCL(ICEMAX), CONCI_AFNUCL(ICEMAX)
+	real(kind=r8size),parameter :: A1 = -0.639D0, B1 = 0.1296D0, A2 = -2.8D0, B2 = 0.262D0, &
+								                 TEMP1 = -5.0D0, TEMP2 = -2.0D0, TEMP3 = -20.0D0
+
+	! C1_MEY=0.001 1/cm^3
+	real(kind=r8size),PARAMETER::C1_MEY = 1.0D-3
+	real(kind=r8size),PARAMETER::C2_MEY = 0.0D0
+	INTEGER,PARAMETER :: NRGI = 2
+	real(kind=r8size) :: C1,C2,TPC,DEL2N,DEL2NN,HELEK1,HELEK2,FF1BN,FACT,DSUP2N,DELTACD,DELTAF, &
+			                 ADDF,DELCONCI_AFNUCL,TPCC,DX
+	! ... Locals
+
+	C1=C1_MEY
+	C2=C2_MEY
+
+	! size distribution functions of crystals before ice nucleation
 
-           DDEL2N=DEL2N
 	DO KR=1,NKR
-	   PSI2R(KR)=FI2(KR,ITYP)
-	   FI2R(KR)=FI2(KR,ITYP)
-           DR2(KR,ITYP)=R2(KR,ITYP)
-           DB21_MY(KR,ITYP)=B21_MY(KR,ITYP)
+	   DO ICE=1,ICEMAX
+		  FI2(KR,ICE)=PSI2(KR,ICE)
+	   ENDDO
 	ENDDO
-!
-!Q2=0.
-	NR=NKR
-	NRM=NKR-1
-
-! NEW DISTRIBUTION FUNCTION 
-
-	  DO 8 ICE=1,IND
-	       IF(ITYP.EQ.ICE) THEN
-	          DO KR=1,NKR
-                    DR2N(KR,ICE)=DR2(KR,ICE)+DDEL2N*DB21_MY(KR,ICE)
-                    R2N(KR,ICE)=DR2N(KR,ICE)
-!                   IF (D1N.LT.0)THEN
-!	             if (DR2N(KR,ICE).EQ.DR2(KR,ICE))THEN
-!		        KK=NKR-KR+1
-!	       		DR2N(KR,ICE)=R2N(KR,ICE)-2.E-15/2**KK
-!                    end if
-!                   END IF
-
-	          ENDDO
-	        ENDIF
-    8	  CONTINUE
-! CRYSTAL DISTRIBUTION FUNCTION 
-                                                          
-	  DO ICE=1,IND
-
-! ICE_TYPE 
-	     IF(ITYP.EQ.ICE) THEN
-!       Q2=20.*ITYPE+ICE
-               DO 5 KR=1,NKR
-	            R2R(KR)=DR2(KR,ICE)
-	            R2NR(KR)=DR2N(KR,ICE)               
-    5         continue
-! Andrei's new change 1.12.09                                 (start)
-!            IDROP=1
-!            IDROP=0
-             IF(IND.EQ.1.AND.ITYPE.EQ.1) IDROP=1
-! Andrei's new change 1.12.09                                   (end)
-             CALL JERNEWF(NR,NRM,R2R,FI2R,PSI2R,R2NR,COL,NKR &
-! Andrei's new change 1.12.09                                 (start)
-     &                   ,IDROP,TPN)
-! Andrei's new change 1.12.09                                   (end)
-
-
-
-!              CALL JERNEWF(NR,NRM,R2R,FI2R,PSI2R,R2NR,COL,NKR)
-	       DO KR=1,NKR                              
-	          PSI2(KR,ICE)=PSI2R(KR)
-	       ENDDO
-
-
-! END OF "ICE_TYPE" 
-
-	     ENDIF
-
-! END OF "CRYSTAL DISTRIBUTION FUNCTION" 
-                                                          
-	  ENDDO
 
-! END OF "NEW DISTRIBUTION FUNCTION"
+	! calculation concentration of crystals before ice nucleation
+
+	DO ICE=1,ICEMAX
+	   CONCI_BFNUCL(ICE)=0.0D0
+	   DO KR=1,NKR
+		  CONCI_BFNUCL(ICE)=CONCI_BFNUCL(ICE)+ &
+		  					3.0D0*COL*PSI2(KR,ICE)*xi(KR,ICE)
+	   ENDDO
+	ENDDO
 
+	! type of ice with nucleation                                (start)
 
-	RETURN
-	END SUBROUTINE JERDFUN
-!===================================================================
-        SUBROUTINE JERDFUN_NEW(R2,B21_MY &
-     &                    ,FI2,PSI2,DEL2N &
-     &                    ,IND,ITYPE,COL,NKR,TPN)
-       IMPLICIT NONE
+        TPC = TT-273.15D0
+        ITYPE=0
 
-! CRYSTALS 
-       REAL COL,DEL2N
-                                                                       
-      INTEGER IND,ITYPE,KR,ICE,ITYP,NRM,NR,KK,NKR,IDROP
-       REAL &
-     &       R2(NKR,IND),R2N(NKR,IND) &
-     &      ,FI2(NKR,IND),PSI2(NKR,IND)
-       DOUBLE PRECISION TPN
-       DOUBLE PRECISION  B21_MY(NKR,IND)
-        DOUBLE PRECISION R2R(NKR),R2NR(NKR),FI2R(NKR),PSI2R(NKR)
-        DOUBLE PRECISION DR2(NKR,IND),DR2N(NKR,IND),DDEL2N, &
-     &     DB21_MY(NKR,IND)
-	IF(IND.NE.1) THEN
-	  ITYP=ITYPE
+        IF((TPC>-4.0D0).OR.(TPC<=-8.1D0.AND.TPC>-12.7D0).OR. &
+        	(TPC<=-17.8D0.AND.TPC>-22.4D0)) THEN
+          	ITYPE=2
         ELSE
-	  ITYP=1
-	ENDIF
+          IF((TPC<=-4.0D0.AND.TPC>-8.1D0) &
+        	 .OR.(TPC<=-22.4D0)) THEN
+            	ITYPE=1
+          ELSE
+            	ITYPE=3
+          ENDIF
+        ENDIF
 
-           DDEL2N=DEL2N
-	DO KR=1,NKR
-	   PSI2R(KR)=FI2(KR,ITYP)
-	   FI2R(KR)=FI2(KR,ITYP)
-           DR2(KR,ITYP)=R2(KR,ITYP)
-	ENDDO
-!
-!Q2=0.
-	NR=NKR
-	NRM=NKR-1
-
-! NEW DISTRIBUTION FUNCTION 
-
-! CRYSTAL DISTRIBUTION FUNCTION 
-	  DO ICE=1,IND
-! ICE_TYPE 
-	     IF(ITYP.EQ.ICE) THEN
-               DO 5 KR=1,NKR
-	            R2R(KR)=DR2(KR,ICE)
-	            R2NR(KR)=DR2(KR,ICE)+B21_MY(KR,ICE)
-                    R2N(KR,ICE)=R2NR(KR)
-!                   IF (D1N.LT.0)THEN
-!	            	 if (R2NR(KR).EQ.R2R(KR))THEN
-!	       		 KK=NKR-KR+1
-!		        R2NR(KR)=R2R(KR)-2.E-15/2**KK
-!		      end if
-!	            END IF
-    5         continue
-! Andrei's new change 1.12.09                                 (start)
-             IDROP=1
-!            IDROP=0
-             CALL JERNEWF(NR,NRM,R2R,FI2R,PSI2R,R2NR,COL,NKR &
-     &                   ,IDROP,TPN)
-! Andrei's new change 1.12.09                                   (end)
-
-
-!              CALL JERNEWF(NR,NRM,R2R,FI2R,PSI2R,R2NR,COL,NKR)
-	       DO KR=1,NKR                              
-	          PSI2(KR,ICE)=PSI2R(KR)
-	       ENDDO
-
-! END OF "ICE_TYPE" 
-
-	     ENDIF
-
-! END OF "CRYSTAL DISTRIBUTION FUNCTION" 
-                                                          
-	  ENDDO
+	! type of ice with nucleation                                  (end)
 
-! END OF "NEW DISTRIBUTION FUNCTION"
+	! new crystal size distribution function                     (start)
+        ICE=ITYPE
+        IF (TPC < TEMP1) THEN
+          DEL2N = 100.0D0*SUP2
+          DEL2NN = DEL2N
+          IF( DEL2N > DELSUPICE_MAX) DEL2NN = DELSUPICE_MAX
+          HELEK1 = C1*DEXP(A1+B1*DEL2NN)
+	      ELSE
+          HELEK1 = 0.0D0
+        ENDIF
 
+        IF(TPC < TEMP2) THEN
+          TPCC = TPC
+          IF(TPCC < TEMP3) TPCC = TEMP3
+          HELEK2 = C2*DEXP(A2-B2*TPCC)
+        ELSE
+          HELEK2 = 0.0D0
+        ENDIF
 
-	RETURN
-	END SUBROUTINE JERDFUN_NEW
-! SUBROUTINE JERDFUN_NEW (NEW ALGORITHM OF CONDENSATION, 12.01.00)
-
-! new change 30.01.06                                         (start)
-!       SUBROUTINE JERNEWF(NRX,NRM,RR,FI,PSI,RN,COL,NKR)
-
-        SUBROUTINE JERNEWF &
-       (NRX,NRM,RR,FI_OLD,PSI,RN,COL,NKR, &
-! Andrei's new change 1.12.09                                 (start)           
-        IDROP,TPN)
-! Andrei's new change 1.12.09                                   (end)	
- 
-        IMPLICIT NONE
-        INTEGER  & 
-        I,K,KM,NRXP,IM,IP,IFIN,IIN,ISYM,NKR
-	
-! Andrei's new change 1.12.09                                 (start)
-
-        INTEGER &
-	KRDROP_REMAP_MIN,KRDROP_REMAP_MAX,IDROP,KMAX
-	
-        DOUBLE PRECISION &
-	COEFF_REMAP,TPN
-	
-        DOUBLE PRECISION & 
-        CDROP(NRX),DELTA_CDROP(NRX)
-		
-! Andrei's new change 1.12.09                                   (end)                      	
-
- 
-        REAL & 
-        COL
-
-        DOUBLE PRECISION &
-	AOLDCON,ANEWCON,AOLDMASS,ANEWMASS
-
-        DOUBLE PRECISION &
-        RNTMP,RRTMP,RRP,RRM,RNTMP2,RRTMP2,RRP2,RRM2, &
-        GN1,GN1P,GN2,GN3,GMAT2
-
-        DOUBLE PRECISION &
-        DRP,FNEW,FIK,PSINEW,DRM,GMAT,R1,R2,R3,DMASS,CONCL,RRI,RNK
-
-        INTEGER NRX,NRM
-
-        DOUBLE PRECISION & 
-        RR(NRX),FI(NRX),PSI(NRX),RN(NRX) &
-       ,RRS(NKR+1),RNS(NKR+1),PSIN(NKR+1),FIN(NKR+1)
-
-        DOUBLE PRECISION & 
-        FI_OLD(NRX)
-! ANDREI                                                      (start) 
-! new change 7.02.06                                          (start)
-        DOUBLE PRECISION & 
-        PSI_IM,PSI_I,PSI_IP
-! ANDREI                                                        (end) 
-! new change 7.02.06                                            (end)
-
-! Andrei's new change 1.12.09                                 (start)           
-
-       IF(TPN.LT.273.15-7.0D0) IDROP=0
-! LEAVE REMAPPING ON
-!      IDROP=0
- 
-! VALUES FOR SOME REMAPING VARIABLES
-
-        KRDROP_REMAP_MIN=8
-	KRDROP_REMAP_MAX=13 
-	
-        COEFF_REMAP=1.0D0/150.0D0 
-	       	
-! Andrei's new change 1.12.09                                   (end)                      
-	
-! INITIAL VALUES FOR SOME VARIABLES
+        FF1BN = HELEK1+HELEK2
+        FACT=1.0D0
+        DSUP2N = (SUP2-SUP2_OLD+DSUPICE_XYZ)*100.0D0
+        SUP2_OLD = SUP2 ! ### (KS) : We calculate SUP2_OLD outside of JERNUCL01
 
-	NRXP=NRX+1
+	      IF(DSUP2N > DELSUPICE_MAX) DSUP2N = DELSUPICE_MAX
 
-	DO K=1,NRX
-	   FI(K)=FI_OLD(K)
-        ENDDO
- 
-	DO K=1,NRX
-	   PSI(K)=0.0D0
-        ENDDO
-! ANDREI                                                      (start) 
-! new change 7.02.06                                          (start)
+        DELTACD = FF1BN*B1*DSUP2N
 
-	IF(RN(NRX).NE.RR(NRX)) THEN
+        IF(DELTACD>=FF1BN) DELTACD=FF1BN
 
-! Kovetz-Olund method                                         (start)
+        IF(DELTACD>0.0D0) THEN
+          DELTAF=DELTACD*FACT
+		  ! concentration of ice crystals
+          if(CONCI_BFNUCL(ICE)<=helek1) then
+          	DO KR=1,NRGI-1
+             	DX=3.0D0*xi(KR,ICE)*COL
+             	ADDF=DELTAF/DX
+             	PSI2(KR,ICE)=PSI2(KR,ICE)+ADDF
+          	ENDDO
+          endif
+        ENDIF
 
-! ANDREI                                                        (end) 
-! new change 7.02.06                                            (end)
+		! calculation of crystal concentration after ice nucleation
 
-	  ISYM=1
+        DO ICE=1,ICEMAX
+           CONCI_AFNUCL(ICE)=0.0D0
+           DO KR=1,NKR
+              CONCI_AFNUCL(ICE)=CONCI_AFNUCL(ICE)+ &
+              3.0D0*COL*PSI2(KR,ICE)*xi(KR,ICE)
+           END DO
+           DELCONCI_AFNUCL=DABS(CONCI_AFNUCL(ICE)-CONCI_BFNUCL(ICE))
+           IF(DELCONCI_AFNUCL>10.0D0) THEN
+             PRINT*,    'IN SUBROUTINE ICE_NUCL, AFTER NUCLEATION'
+             PRINT*,    'BECAUSE DELCONCI_AFNUCL > 10/cm^3'
+             PRINT*,    'CONCI_BFNUCL(ICE),CONCI_AFNUCL(ICE)'
+             PRINT 202,  CONCI_BFNUCL(ICE),CONCI_AFNUCL(ICE)
+             PRINT*,    'DELTACD,DSUP2N,FF1BN,B1,DSUPICEXZ,SUP2'
+             PRINT 206,  DELTACD,DSUP2N,FF1BN,B1,DSUPICE_XYZ,SUP2
+             PRINT*,    'KR,   FI2(KR,ICE),   PSI2(KR,ICE), KR=1,NKR'
+             PRINT 302, (KR,   FI2(KR,ICE),   PSI2(KR,ICE), KR=1,NKR)
+             PRINT*, 'STOP 099 : DELCONCI_AFNUCL(ICE) > 10/cm^3'
+             STOP 099
+           ENDIF
+        END DO
 
-	  IF(RN(1).LT.RR(1)) ISYM=-1
+! new crystal size distribution function                       (end)
 
-! CALCULATION OF DISTRIBUTION FUNCTION 
 
-	  IF(ISYM.GT.0) THEN
-	
-! CONDENSATION 
+  202	FORMAT(1X,2D13.5)
+  206	FORMAT(1X,6D13.5)
+  302   FORMAT(1X,I2,2X,2D13.5)
 
-	    RNS(NRXP)=1024.0D0*RR(NRX)
-	    RRS(NRXP)=1024.0D0*RR(NRX)
+        RETURN
+        END SUBROUTINE ICE_NUCL
 
-  	    PSIN(NRXP)=0.0D0
-	    FIN(NRXP)=0.0D0
+! SUBROUTINE ICE_NUCL
+! +-------------------------------------------------------------------------------------------------+
+	SUBROUTINE Cloud_Base_Super (FCCNR, RCCN, TT, PP, Wbase, NKR, RCRITI, RO_SOLUTE, IONS, MWAERO, &
+								              COL)
 
-	    DO K=1,NRX
-	       RNS(K)=RN(K)
-	       RRS(K)=RR(K)
-	       PSIN(K)=0.0D0
-! FIN(K) - initial(before condensation) concentration of hydrometeors
-	       FIN(K)=3.0D0*FI(K)*RR(K)*COL
-	    ENDDO
+	implicit none
 
-! NUMBER OF NEW RADII POSITION IN REGULAR GRID 
+! RCCN(NKR),  cm- aerosol's radius
 
-! RNK - new first bin mass(after condensation)
+! FCCNR(KR), 1/cm^3 - aerosol(CCN) non conservative, size
+!                     distribution function in point with X,Z
+!                     coordinates, KR=1,...,NKR
+	integer,intent(in) :: 				   NKR, IONS
+	real(kind=r8size),intent(in) ::  TT, PP, Wbase, RCCN(:), COL
+	real(kind=r8size),intent(inout) :: 	FCCNR(:), RCRITI
+	real(kind=r4size),intent(in) ::  MWAERO, RO_SOLUTE
 
-	    RNK=RNS(1)
+	! ... Locals
+	  integer :: NR, NN, KR
+	  real(kind=r8size) :: PL(NKR), supmax(NKR), AKOE, BKOE, C3, PR, CCNCONACT, DL1, DL2, &
+	  					            TPC
+	! ... Locals
 
-	    DO I=1,NRX
-	       RRI=RRS(I)
-	       IF(RRI.GT.RNK) GOTO 3
-            ENDDO
+	CALL supmax_COEFF(AKOE,BKOE,C3,PP,TT,RO_SOLUTE,IONS,MWAERO)
 
-    3	    IIN=I-1
+! supmax calculation
 
-	    IFIN=NRX
+! 'Analytical estimation of droplet concentration at cloud base', eq.21, 2012
+! calculation of right side hand of equation for S_MAX
+! while wbase>0, calculation PR
 
-	    CONCL=0.0D0
-            DMASS=0.0D0
-                        
-            DO 6 I=IIN,IFIN
+   	PR = C3*wbase**(0.75D0)
 
-                 IP=I+1
-                                                                                
-                 IM=MAX(1,I-1)
+! calculation supersaturation in cloud base
 
-	         R1=RRS(IM)
-	         R2=RRS(I)
-	         R3=RRS(IP)
+   	SupMax = 999.0
+	  PL = 0.0
+    NN = -1
+    DO NR=2,NKR
+	   supmax(NR)=DSQRT((4.0D0*AKOE**3.0D0)/(27.0D0*RCCN(NR)**3.0D0*BKOE))
+	! calculation CCNCONACT- the concentration of ccn that were activated
+	! following nucleation
+	! CCNCONACT=N from the paper
+	! 'Analytical estimation of droplet concentration at cloud base', eq.19, 2012
+	! CCNCONACT, 1/cm^3- concentration of activated CCN = new droplet concentration
+	! CCNCONACT=FCCNR(KR)*COL
+	! COL=Ln2/3
 
-	         DRM=R2-R1
-	         DRP=R3-R2
+		CCNCONACT=0.0D0
 
-	         FNEW=0.0D0
+	! NR represents the number of bin in which rcriti is located
+	! from NR bin to NKR bin goes to droplets
 
-	         DO 7 K=1,I
-                 
-	              FIK=FIN(K)
+		DO KR=NR,NKR
+			CCNCONACT = CCNCONACT + COL*FCCNR(KR)
+		ENDDO
 
-	              IF(FIK.NE.0.0D0) THEN
+	! calculate LHS of equation for S_MAX
+	! when PLRCCN_MIN_3LN.AND.RCCN(KR)> Should be read automatically from "module_state_description")
+ INTEGER, PRIVATE,PARAMETER :: r_p_ff1i01=2, r_p_ff1i06=07,r_p_ff2i01=08,r_p_ff2i06=13,r_p_ff3i01=14,&
+          r_p_ff3i06=19,r_p_ff4i01=20,r_p_ff4i06=25,r_p_ff5i01=26,r_p_ff5i06=31,r_p_ff6i01=32,r_p_ff6i06=37,&
+				  r_p_ff7i01=38,r_p_ff7i06=43,r_p_ff8i01=44,r_p_ff8i06=49,r_p_ff9i01=50,r_p_ff9i06=55
+
+ INTEGER,PARAMETER :: IBREAKUP = 1
+ INTEGER,PARAMETER :: Snow_BreakUp_On = 1
+ INTEGER,PARAMETER :: Spont_Rain_BreakUp_On = 1
+ LOGICAL,PARAMETER :: CONSERV = .TRUE.
+ INTEGER,PARAMETER :: JIWEN_FAN_MELT = 1
+ LOGICAL,PARAMETER :: IPolar_HUCM = .TRUE.
+ INTEGER,PARAMETER :: hail_opt = 0
+ INTEGER,PARAMETER :: ILogNormal_modes_Aerosol = 1
+
+ REAL,PARAMETER :: DX_BOUND = 1433
+ REAL(kind=r8size), PARAMETER ::  SCAL = 1.d0
+ INTEGER,PARAMETER :: ICEPROCS = 1
+ INTEGER,PARAMETER :: ICETURB = 0, LIQTURB = 0
+
+ INTEGER,PARAMETER :: icempl=1,ICEMAX=3,NCD=33,NHYDR=5,NHYDRO=7    &
+             					,K0_LL=8,KRMIN_LL=1,KRMAX_LL=19,L0_LL=6                  &
+             					,IEPS_400=1,IEPS_800=0,IEPS_1600=0                       &
+             					,K0L_GL=16,K0G_GL=16                                     &
+             					,KRMINL_GL=1,KRMAXL_GL=24                                &
+             					,KRMING_GL=1,KRMAXG_GL=33                                &
+             					,KRDROP=15,KRBREAK=17,KRICE=18                           & ! KRDROP=Bin 15 --> 50um
+             					!,NKR=43,JMAX=43,NRG=2,JBREAK=28,BR_MAX=43,KRMIN_BREAKUP=31,NKR_aerosol=43   ! 43 bins
+             					,NKR=33,JMAX=33,NRG=2,JBREAK=18,BR_MAX=33,KRMIN_BREAKUP=31,NKR_aerosol=43    ! 33 bins
+
+ REAL(kind=r4size) :: dt_coll
+ REAL,PARAMETER :: C1_MEY=0.00033,C2_MEY=0.0,COL=0.23105, &
+                   p1=1000000.0,p2=750000.0,p3=500000.0,  &
+                   ALCR = 0.5, &
+                   ALCR_G = 100.0 ! ... [KS] forcing no transition from graupel to hail in this version
+ INTEGER :: NCOND, NCOLL
+ INTEGER,PARAMETER :: kr_icempl=9
+
+ REAL(kind=r4size) :: &
+ 					 RADXX(NKR,NHYDR-1),MASSXX(NKR,NHYDR-1),DENXX(NKR,NHYDR-1) &
+ 					,MASSXXO(NKR,NHYDRO),DENXXO(NKR,NHYDRO),VRI(NKR)           &
+          ,XX(nkr),ROCCN(nkr),FCCNR_MIX(NKR),FCCNR(NKR)
+
+ REAL(kind=r8size),DIMENSION (NKR) :: FF1R_D,XL_D,VR1_D &
+ 							,FF3R_D,XS_D,VR3_D,VTS_D,FLIQFR_SD,RO3BL_D &
+ 							,FF4R_D,XG_D,VR4_D,VTG_D,FLIQFR_GD,RO4BL_D &
+ 							,FF5R_D,XH_D,VR5_D,VTH_D,FLIQFR_HD,RO5BL_D &
+ 							,XS_MELT_D,XG_MELT_D,XH_MELT_D,VR_TEST,FRIMFR_SD,RF3R
+
+ ! ... SBMRADAR VARIABLES
+ REAL(kind=r8size),DIMENSION (nkr,icemax) :: XI_MELT_D &
+							,FF2R_D,XI_D,VR2_D,VTC_D,FLIQFR_ID,RO2BL_D
+ REAL(kind=r8size) :: T_NEW_D,rhocgs_D,pcgs_D,DT_D,qv_old_D,qv_d
+
+ REAL(kind=r4size),private :: C2,C3,C4
+ REAL(kind=r8size),private ::  &
+ 	            xl_mg(nkr),xs_mg(nkr),xg_mg(nkr),xh_mg(nkr) &
+             ,xi1_mg(nkr),xi2_mg(nkr),xi3_mg(nkr)
+
+ ! ----------------------------------------------------------------------------------+
+ ! ... WRFsbm_Init
+ ! ... Holding Lookup tables and memory arrays for the FAST_SBM module
+         REAL (KIND=R8SIZE), ALLOCATABLE, DIMENSION(:)::                             &
+                                          bin_mass,tab_colum,tab_dendr,tab_snow,bin_log
+         REAL (KIND=R4SIZE), ALLOCATABLE, DIMENSION(:) ::                            &
+                                          RLEC,RSEC,RGEC,RHEC,XL,XS,XG,XH,VR1,VR3,VR4,VR5
+         REAL (KIND=R4SIZE), ALLOCATABLE, DIMENSION(:,:)::                           &
+                                          RIEC,XI,VR2
+         REAL (KIND=R4SIZE), ALLOCATABLE ::                              &
+                                          COEFIN(:),SLIC(:,:),TLIC(:,:), &
+                                          YWLL_1000MB(:,:),YWLL_750MB(:,:),YWLL_500MB(:,:)
+         REAL (KIND=R4SIZE), ALLOCATABLE ::                              &
+                                         YWLI_300MB(:,:,:),YWLI_500MB(:,:,:),YWLI_750MB(:,:,:),              &
+                                         YWLG_300MB(:,:),YWLG_500MB(:,:),YWLG_750MB(:,:),YWLG(:,:),          &
+                                         YWLH_300MB(:,:),YWLH_500MB(:,:),YWLH_750MB(:,:),                    &
+                                         YWLS_300MB(:,:),YWLS_500MB(:,:),YWLS_750MB(:,:),                    &
+                                         YWII_300MB(:,:,:,:),YWII_500MB(:,:,:,:),YWII_750MB(:,:,:,:),        &
+                                         YWII_300MB_tmp(:,:,:,:),YWII_500MB_tmp(:,:,:,:),YWII_750MB_tmp(:,:,:,:),        &
+                                         YWIS_300MB(:,:,:),YWIS_500MB(:,:,:),YWIS_750MB(:,:,:),              &
+                                         YWSG_300MB(:,:),YWSG_500MB(:,:),YWSG_750MB(:,:),                    &
+                                         YWSS_300MB(:,:),YWSS_500MB(:,:),YWSS_750MB(:,:)
+
+         REAL (KIND=R4SIZE), ALLOCATABLE ::                  &
+                                         RO1BL(:), RO2BL(:,:), RO3BL(:), RO4BL(:), RO5BL(:),                 &
+                                         RADXXO(:,:)
+
+         INTEGER,ALLOCATABLE ::              ima(:,:)
+         REAL (KIND=R8SIZE), ALLOCATABLE ::  chucm(:,:)
+
+         REAL (KIND=R8SIZE), ALLOCATABLE ::  BRKWEIGHT(:),ECOALMASSM(:,:), Prob(:),Gain_Var_New(:,:),NND(:,:)
+         REAL (KIND=R4SIZE), ALLOCATABLE ::  DROPRADII(:),PKIJ(:,:,:),QKJ(:,:)
+         INTEGER ::          ikr_spon_break
+
+         REAL (KIND=R8SIZE), ALLOCATABLE ::  cwll(:,:), &
+                                             cwli_1(:,:),cwli_2(:,:),cwli_3(:,:),        &
+                                             cwil_1(:,:),cwil_2(:,:),cwil_3(:,:),        &
+                                             cwlg(:,:),cwlh(:,:),cwls(:,:),              &
+                                             cwgl(:,:),cwhl(:,:),cwsl(:,:),              &
+                                             cwii_1_1(:,:),cwii_1_2(:,:),cwii_1_3(:,:),  &
+                                             cwii_2_1(:,:),cwii_2_2(:,:),cwii_2_3(:,:),  &
+                                             cwii_3_1(:,:),cwii_3_2(:,:),cwii_3_3(:,:),  &
+                                             cwis_1(:,:),cwis_2(:,:),cwis_3(:,:),        &
+                                             cwsi_1(:,:),cwsi_2(:,:),cwsi_3(:,:),        &
+                                             cwig_1(:,:),cwig_2(:,:),cwig_3(:,:),        &
+                                             cwih_1(:,:),cwih_2(:,:),cwih_3(:,:),        &
+                                             cwsg(:,:),cwss(:,:)
+         REAL(kind=r8size),ALLOCATABLE ::  FCCNR_MAR(:),FCCNR_CON(:)
+         REAL(kind=r4size),ALLOCATABLE :: Scale_CCN_Factor,XCCN(:),RCCN(:),FCCN(:)
+
+ ! ... WRFsbm_Init
+ ! --------------------------------------------------------------------------------+
+
+ INTEGER :: icloud
+
+ ! ### (KS) - CCN related
+ ! -----------------------------------------------------------------------
+ !REAL (KIND=R4SIZE), parameter :: mwaero = 22.9 + 35.5 ! sea salt
+ real(kind=r4size),parameter :: mwaero = 115.0
+ !integer,parameter :: ions = 2        	! sea salt
+ integer,parameter  :: ions = 3         ! ammonium-sulfate
+ !real(KIND=R4SIZE),parameter :: RO_SOLUTE = 2.16   	! sea salt
+ real(kind=r4size),parameter ::  RO_SOLUTE = 1.79  	! ammonium-sulfate
+ ! ----------------------------------------------------------------------
+ REAL (KIND=R4SIZE) :: FR_LIM(NKR), FRH_LIM(NKR)
+
+   CONTAINS
+ !-----------------------------------------------------------------------
+       SUBROUTINE FAST_SBM (w,u,v,th_old,                                &
+      &                      chem_new,n_chem,                            &
+      &                      itimestep,DT,DX,DY,                         &
+      &                      dz8w,rho_phy,p_phy,pi_phy,th_phy,           &
+      &                      xland,ivgtyp,xlat,xlong,                    &
+      &                      QV,QC,QR,QI,QS,QG,QV_OLD,                   &
+      &                      QNC,QNR,QNI,QNS,QNG,QNA,                    &
+      &                      ids,ide, jds,jde, kds,kde,		        	     &
+      &                      ims,ime, jms,jme, kms,kme,		        	     &
+      &                      its,ite, jts,jte, kts,kte,                  &
+      &                      diagflag,      	                           &
+      &                      sbmradar,num_sbmradar,                      &
+      &                      RAINNC,RAINNCV,SNOWNC,SNOWNCV,GRAUPELNC,GRAUPELNCV,SR)
+ !-----------------------------------------------------------------------
        IMPLICIT NONE
+ !-----------------------------------------------------------------------
+ 	INTEGER :: KR,IKL,ICE
+
+ 	INTEGER,INTENT(IN) :: IDS,IDE,JDS,JDE,KDS,KDE                     &
+ 	&                     ,IMS,IME,JMS,JME,KMS,KME                    &
+ 	&                     ,ITS,ITE,JTS,JTE,KTS,KTE                    &
+ 	&                     ,ITIMESTEP,N_CHEM,NUM_SBMRADAR
+
+ 	REAL, INTENT(IN) 	    :: DT,DX,DY
+ 	REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ), &
+ 	INTENT(IN   ) ::                                 &
+ 							  U, &
+ 							  V, &
+ 							  W
+
+ 	REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem),INTENT(INOUT)   :: chem_new
+ 	REAL    ,DIMENSION(ims:ime,kms:kme,jms:jme,num_sbmradar),INTENT(INOUT)   :: sbmradar
+ 	REAL,    DIMENSION( ims:ime , kms:kme , jms:jme ),               &
+ 		       INTENT(INOUT) ::                                          &
+ 						  qv, 		&
+ 						  qv_old, 	&
+ 						  th_old, 	&
+ 						  qc, 		&
+ 						  qr, 		&
+ 						  qi,	 	   &
+ 						  qs, 		&
+ 						  qg, 		&
+ 						  qnc, 		&
+ 						  qnr, 		&
+              qni,    &
+ 						  qns, 		&
+ 						  qng, 		&
+ 						  qna
+
+       REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN)   :: XLAND
+       LOGICAL, OPTIONAL, INTENT(IN) :: diagflag
+
+       INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN)::   IVGTYP
+       REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN   )    :: XLAT, XLONG
+       REAL, INTENT(IN),     DIMENSION(ims:ime, kms:kme, jms:jme)::      &
+      &                      dz8w,p_phy,pi_phy,rho_phy
+       REAL, INTENT(INOUT),  DIMENSION(ims:ime, kms:kme, jms:jme)::      &
+      &                      th_phy
+       REAL, INTENT(INOUT),  DIMENSION(ims:ime,jms:jme), OPTIONAL ::     &
+      &      RAINNC,RAINNCV,SNOWNC,SNOWNCV,GRAUPELNC,GRAUPELNCV,SR
+
+ !-----------------------------------------------------------------------
+ !     LOCAL VARS
+ !-----------------------------------------------------------------------
+
+       REAL (KIND=R4SIZE),  DIMENSION(its-1:ite+1, kts:kte, jts-1:jte+1)::  &
+                                                  t_new,t_old,zcgs,rhocgs,pcgs
+
+       INTEGER :: I,J,K,KFLIP
+       INTEGER :: KRFREEZ
+
+       REAL (KIND=R4SIZE),PARAMETER :: Z0IN=2.0E5,ZMIN=2.0E5
+
+       REAL (KIND=R4SIZE) :: EPSF2D, &
+      &        TAUR1,TAUR2,EPS_R1,EPS_R2,ANC1IN, &
+      &        PEPL,PEPI,PERL,PERI,ANC1,ANC2,PARSP, &
+      &        AFREEZMY,BFREEZMY,BFREEZMAX, &
+      &        TCRIT,TTCOAL, &
+      &        EPSF1,EPSF3,EPSF4, &
+      &        SUP2_OLD, DSUPICEXZ,TFREEZ_OLD,DTFREEZXZ, &
+      &        AA1_MY,BB1_MY,AA2_MY,BB2_MY, &
+      &        DTIME,DTCOND,DTNEW,DTCOLL, &
+      &        A1_MYN, BB1_MYN, A2_MYN, BB2_MYN
+      DATA A1_MYN, BB1_MYN, A2_MYN, BB2_MYN  &
+      &      /2.53,5.42,3.41E1,6.13/
+      DATA AA1_MY,BB1_MY,AA2_MY,BB2_MY/2.53E12,5.42E3,3.41E13,6.13E3/
+             !QSUM,ISUM,QSUM1,QSUM2,CCNSUM1,CCNSUM2
+      DATA KRFREEZ,BFREEZMAX,ANC1,ANC2,PARSP,PEPL,PEPI,PERL,PERI, &
+      &  TAUR1,TAUR2,EPS_R1,EPS_R2,TTCOAL,AFREEZMY,&
+      &  BFREEZMY,EPSF1,EPSF3,EPSF4,TCRIT/21,&
+      &  0.6600E00, &
+      &  1.0000E02,1.0000E02,0.9000E02, &
+      &  0.6000E00,0.6000E00,1.0000E-03,1.0000E-03, &
+      &  0.5000E00,0.8000E00,0.1500E09,0.1500E09, &
+      &  2.3315E02,0.3333E-04,0.6600E00, &
+      &  0.1000E-02,0.1000E-05,0.1000E-05, &
+      &  2.7015E02/
+
+      REAL (KIND=R4SIZE),DIMENSION (nkr) :: FF1IN,FF3IN,FF4IN,FF5IN,&
+      &              FF1R,FF3R,FF4R,FF5R,FLIQFR_S,FRIMFR_S,FLIQFR_G,FLIQFR_H, &
+      &              FF1R_NEW,FF3R_NEW,FF4R_NEW,FF5R_NEW
+      REAL (KIND=R4SIZE),DIMENSION (nkr) :: FL3R,FL4R,FL5R,FL3R_NEW,FL4R_NEW,FL5R_NEW
+
+      REAL (KIND=R4SIZE),DIMENSION (nkr,icemax) :: FF2IN,FF2R,FLIQFR_I
+
+      REAL (KIND=R4SIZE) :: XI_MELT(NKR,ICEMAX),XS_MELT(NKR),XG_MELT(NKR),XH_MELT(NKR)
+ !!!! NOTE: ZCGS AND OTHER VARIABLES ARE ALSO DIMENSIONED IN FALFLUXHUCM
+      REAL (KIND=R8SIZE) :: DEL1NR,DEL2NR,DEL12R,DEL12RD,ES1N,ES2N,EW1N,EW1PN
+      REAL (KIND=R8SIZE) :: DELSUP1,DELSUP2,DELDIV1,DELDIV2
+      REAL (KIND=R8SIZE) :: TT,QQ,TTA,QQA,PP,DPSA,DELTATEMP,DELTAQ
+      REAL (KIND=R8SIZE) :: DIV1,DIV2,DIV3,DIV4,DEL1IN,DEL2IN,DEL1AD,DEL2AD
+      REAL (KIND=R4SIZE) :: DEL_BB,DEL_BBN,DEL_BBR, TTA_r
+      REAL (KIND=R4SIZE) :: FACTZ,CONCCCN_XZ,CONCDROP
+      REAL (KIND=R4SIZE) :: SUPICE(KTE),AR1,AR2, &
+      					& DERIVT_X,DERIVT_Y,DERIVT_Z,DERIVS_X,DERIVS_Y,DERIVS_Z, &
+      					& ES2NPLSX,ES2NPLSY,EW1NPLSX,EW1NPLSY,UX,VX, &
+      					& DEL2INPLSX,DEL2INPLSY,DZZ(KTE)
+ 	 INTEGER KRR,I_START,I_END,J_START,J_END
+      REAL (KIND=R4SIZE) :: DTFREEZ_XYZ(ITE,KTE,JTE),DSUPICE_XYZ(ITE,KTE,JTE)
+
+      REAL (KIND=R4SIZE) :: DXHUCM,DYHUCM
+      REAL (KIND=R4SIZE) :: FMAX1,FMAX2(ICEMAX),FMAX3,FMAX4,FMAX5
+ 	INTEGER ISYM1,ISYM2(ICEMAX),ISYM3,ISYM4,ISYM5
+ 	INTEGER DIFFU
+ 	REAL (KIND=R4SIZE) :: DELTAW
+ 	REAL (KIND=R4SIZE) :: zcgs_z(kts:kte),pcgs_z(kts:kte),rhocgs_z(kts:kte),ffx_z(kts:kte,nkr)
+ 	REAL (KIND=R4SIZE) :: z_full
+ 	REAL (KIND=R4SIZE) :: VRX(kts:kte,NKR)
+
+ 	REAL (KIND=R4SIZE) :: VR1_Z(NKR,KTS:KTE), FACTOR_P
+ 	REAL (KIND=R4SIZE) :: VR2_ZC(NKR,KTS:KTE), VR2_Z(NKR,ICEMAX)
+ 	REAL (KIND=R4SIZE) :: VR2_ZP(NKR,KTS:KTE)
+ 	REAL (KIND=R4SIZE) :: VR2_ZD(NKR,KTS:KTE)
+ 	REAL (KIND=R4SIZE) :: VR3_Z(NKR,KTS:KTE), VR3_Z3D(NKR,ITS:ITE,KTS:KTE,JTS:JTE)
+ 	REAL (KIND=R4SIZE) :: VR4_Z(NKR,KTS:KTE), VR4_Z3D(NKR,ITS:ITE,KTS:KTE,JTS:JTE)
+ 	REAL (KIND=R4SIZE) :: VR5_Z(NKR,KTS:KTE), VR5_Z3D(NKR,ITS:ITE,KTS:KTE,JTS:JTE)
+ 	REAL (KIND=R4SIZE) :: BulkDen_Snow(NKR,ITS:ITE,KTS:KTE,JTS:JTE) ! Local array for snow density
+
+ 	REAL (KIND=R4SIZE), PARAMETER :: RON=8.E6, GON=5.E7,PI=3.14159265359
+ 	REAL (KIND=R4SIZE) :: EFF_N,EFF_D
+     REAL (KIND=R4SIZE) :: EFF_NI(its:ite,kts:kte,jts:jte),eff_di(its:ite,kts:kte,jts:jte)
+ 	REAL (KIND=R4SIZE) :: EFF_NQIC,eff_DQIC
+ 	REAL (KIND=R4SIZE) :: EFF_NQIP,eff_DQIP
+ 	REAL (KIND=R4SIZE) :: EFF_NQID,eff_DQID
+ 	REAL (KIND=R4SIZE) :: lambda,chi0,xi1,xi2,xi3,xi4,xi5,r_e,chi_3,f1,f2,volume,surface_area,xi6,ft,chi_e,ft_bin
+ 	REAL (KIND=R4SIZE), DIMENSION(kts:kte)::                            &
+ 						  qv1d, qr1d, nr1d, qs1d, ns1d, qg1d, ng1d, t1d, p1d
+ 	REAL (KIND=R4SIZE), DIMENSION(kts:kte):: dBZ
+
+ 	REAL (KIND=R4SIZE) :: nzero,son,nzero_less
+ 	parameter (son=2.E7)
+ 	REAL (KIND=R4SIZE) :: raddumb(nkr),massdumb(nkr)
+ 	REAL (KIND=R4SIZE) :: hydrosum
+
+ 	integer imax,kmax,jmax
+ 	REAL (KIND=R4SIZE) :: gmax,tmax,qmax,divmax,rainmax,qnmax,inmax,knmax,hydro,difmax, tdif, tt_old, w_stag, w_stag_my, qq_old,teten,es
+ 	integer  print_int
+ 	parameter (print_int=300)
+
+ 	integer t_print,i_print,j_print,k_print
+ 	REAL (KIND=R8SIZE), DIMENSION(kts:kte):: zmks_1d
+ 	REAL (KIND=R8SIZE) :: dx_dbl, dy_dbl
+ 	INTEGER,DIMENSION (nkr) :: melt_snow,melt_graupel,melt_hail,melt_ice
+ 	!DOUBLE PRECISION,DIMENSION (nkr) :: dmelt_snow,dmelt_graupel,dmelt_hail,dmelt_ice
+ 	INTEGER ihucm_flag
+ 	REAL (KIND=R4SIZE) :: NSNOW_ADD
+
+ 	! ... Polar-HUCM
+ 	INTEGER,PARAMETER :: n_radar = 10
+ 	integer :: ijk, Mod_Flag
+ 	REAL (KIND=R8SIZE),PARAMETER :: wavelength = 11.0D0 ! ### (KS) - Rhyzkov uses this wavelength (NEXRAD)
+ 	INTEGER :: IWL
+ 	REAL (KIND=R4SIZE) :: DIST_SING
+ 	REAL (KIND=R8SIZE) :: BKDEN_Snow(NKR)
+ 	REAL (KIND=R8SIZE) ::  DISTANCE,FL1_FD(NKR),BULK(NKR), BulkDens_Snow(NKR)
+ 	REAL (KIND=R8SIZE) ::  FF1_FD(NKR),FFL_FD(NKR),OUT1(n_radar),OUT2(n_radar),OUT3(n_radar),OUT4(n_radar),OUT5(n_radar), &
+ 						   OUT6(n_radar),OUT7(n_radar),OUT8(n_radar),OUT9(n_radar), FL1R_FD(NKR)
+ 	REAL (KIND=R8SIZE) :: rate_shed_per_grau_grampersec(NKR), rate_shed_per_hail_grampersec(NKR), rhoair_max
+
+ 	integer :: count_H, count_G, count_S_l, count_S_r
+
+ 	REAL (KIND=R8SIZE) :: RMin_G
+ 	integer :: KR_GRAUP_MAX_BLAHAK, KR_G_TO_H
+
+ 	! ... Cloud Base .........................................................
+ 	REAL (KIND=R8SIZE) ::	SUP_WATER, ES1N_KS, ES1N_dummy, ES2N_dummy
+ 	logical :: K_found
+ 	integer ::	KZ_Cloud_Base(its:ite,jts:jte), IS_THIS_CLOUDBASE,KR_Small_Ice
+ 	! ........................................................................
+ 	REAL (KIND=R4SIZE) :: qna0(its:ite,kts:kte,jts:jte), fr_hom, w_stagm, CollEff_out, FACT
+ 	REAL (KIND=R4SIZE) :: FACTZ_new(KMS:KME,NKR), TT_r
+ ! ### (KS) ............................................................................................
+ 	INTEGER :: NZ,NZZ,II,JJ
+
+  XS_d = XS
+
+  if (itimestep.eq.1)then
+    if (iceprocs.eq.1) call wrf_message(" FAST SBM: ICE PROCESES ACTIVE ")
+    if (iceprocs.eq.0) call wrf_message(" FAST SBM: LIQUID PROCESES ONLY")
+  end if
+
+  NCOND = 3
+  NCOLL = 1
+  DTCOND = DT/REAL(NCOND)
+  DTCOLL = DT/REAL(NCOLL)
+  dt_coll = DTCOLL
+
+  DEL_BB=BB2_MY-BB1_MY
+  DEL_BBN=BB2_MYN-BB1_MYN
+  DEL_BBR=BB1_MYN/DEL_BBN
+
+ if (conserv)then
+    DO j = jts,jte
+       DO i = its,ite
+          DO k = kts,kte
+
+            rhocgs(I,K,J)=rho_phy(I,K,J)*0.001
+ 				! ... Drops
+   				  KRR=0
+   				  DO KR=p_ff1i01,p_ff1i33
+			        KRR=KRR+1
+		          chem_new(I,K,J,KR)=chem_new(I,K,J,KR)*RHOCGS(I,K,J)/COL/XL(KRR)/XL(KRR)/3.0
+   				  END DO
+ 				! ... Snow
+   				  KRR=0
+   				  DO KR=p_ff5i01,p_ff5i33
+  			      KRR=KRR+1
+  			      chem_new(I,K,J,KR)=chem_new(I,K,J,KR)*RHOCGS(I,K,J)/COL/XS(KRR)/XS(KRR)/3.0
+   				  END DO
+ 				! ... Aerosols
+   				  KRR=0
+   				  DO KR=p_ff8i01,p_ff8i43
+  		          KRR=KRR+1
+   					    chem_new(I,K,J,KR) = chem_new(I,K,J,KR)*RHOCGS(I,K,J)/1000.
+   													       ! chem_new (input) is #/kg
+   				  END DO
+ 				!  ... Hail or Graupel [same registry adresses]
+           if(hail_opt == 1) then
+             KRR=0
+             DO KR=p_ff6i01,p_ff6i33
+                 KRR=KRR+1
+                 chem_new(I,K,J,KR)=chem_new(I,K,J,KR)*RHOCGS(I,K,J)/COL/XH(KRR)/XH(KRR)/3.0
+             END DO
+
+           else
+             KRR=0
+             DO KR=p_ff6i01,p_ff6i33
+                 KRR=KRR+1
+                 chem_new(I,K,J,KR)=chem_new(I,K,J,KR)*RHOCGS(I,K,J)/COL/XG(KRR)/XG(KRR)/3.0
+             END DO
+           endif
+
+ 				END DO ! K
+ 			END DO	! I
+ 		END DO ! J
+  end if
 
-      INTEGER NKR,ICEMAX
-      REAL    COL,VR2(NKR,ICEMAX),VR3(NKR),VR4(NKR) &
-     &           ,VR5(NKR),PSINGLE &
-     &       ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
-     &       ,DTCOND
-
-      REAL C1_MEY,C2_MEY
-      INTEGER I_MIXCOND,I_MIXEVAP,I_ABERGERON,I_BERGERON, &
-     & KR,ICE,ITIME,ICM,KCOND,NR,NRM,INUC, &
-     & ISYM2,ISYM3,ISYM4,ISYM5,KP,KLIMIT, &
-     & KM,ITER,KLIMITL,KLIMITG,KLIMITH,KLIMITI_1,KLIMITI_2,KLIMITI_3, &
-     & NCRITI
-      REAL AL1,AL2,D,GAM,POD, &
-     & RV_MY,CF_MY,D_MYIN,AL1_MY,AL2_MY,ALC,DT0LREF,DTLREF, &
-     & A1_MYN, BB1_MYN, A2_MYN, BB2_MYN,DT,DTT,XRAD, &
-     & TPC1, TPC2, TPC3, TPC4, TPC5, &
-     & EPSDEL, DT0L, DT0I, &
-     & ROR, &
-     & DEL1NUC,DEL2NUC, &
-     & CWHUCM,B6,B8L,B8I,RMASSGL,RMASSGI, &
-     & DEL1,DEL2,DEL1S,DEL2S, &
-     & TIMENEW,TIMEREV,SFN11,SFN12, &
-     & SFNL,SFNI,B5L,B5I,B7L,B7I,DOPL,DOPI,OPERQ,RW,RI,QW,PW, &
-     & PI,QI,D1N0,D2N0,DTNEWL,DTNEWL1,D1N,D2N, &
-     & DEL_R1,DT0L0,DT0I0,SFN31,SFN32,SFN52, &
-     & SFNII1,SFN21,SFN22,DTNEWI3,DTNEWI4,DTNEWI5,DTNEWI2_1, &
-     & DTNEWI2_2,DTNEWI1,DEL_R2,DEL_R4,DEL_R5,SFN41,SFN42, &
-     & SNF51,DTNEWI2_3,DTNEWI2,DTNEWI_1,DTNEWI_2, &
-     & DTNEWL0,DTNEWG1,DTNEWH1,DTNEWI_3, &
-     & DTNEWL2,SFN51,SFNII2,DEL_R3,DTNEWI  
-       REAL DT_WATER_COND,DT_WATER_EVAP,DT_ICE_COND,DT_ICE_EVAP, &
-     &  DT_MIX_COND,DT_MIX_EVAP,DT_MIX_BERGERON,DT_MIX_ANTIBERGERON
+  DXHUCM=100.*DX
+  DYHUCM=100.*DY
 
-       INTEGER K
+  I_START=MAX(1,ITS-1)
+  J_START=MAX(1,JTS-1)
+  I_END=MIN(IDE-1,ITE+1)
+  J_END=MIN(JDE-1,JTE+1)
+
+   DO j = j_start,j_end
+      DO i = i_start,i_end
+         z_full=0.
+         DO k = kts,kte
+            pcgs(I,K,J)=P_PHY(I,K,J)*10.
+            rhocgs(I,K,J)=rho_phy(I,K,J)*0.001
+            zcgs(I,K,J)=z_full+0.5*dz8w(I,K,J)*100
+            !height(i,k,j) = 1.0e-2*zcgs(i,k,j) ! in [m]
+            z_full=z_full+dz8w(i,k,j)*100.
+         ENDDO
+      ENDDO
+   ENDDO
+
+ ! +---------------------------------------+
+ ! ... Initial Aerosol distribution
+ ! +---------------------------------------+
+ 	  if (itimestep == 1)then
+ 	   FACTZ_new = 0.0
+ 	   DO j = jts,jte
+ 		  DO i = its,ite
+ 			DO k = kts,kte
+ 			   rhoair_max = rhocgs(i,1,j) ! [g/cm3]
+ 			   if(ILogNormal_modes_Aerosol == 1)then
+ 				  IF (zcgs(I,K,J) .LE. ZMIN)THEN
+ 					  FACTZ = 1.0
+ 				  ELSE
+ 					  FACTZ=EXP(-(zcgs(I,K,J)-ZMIN)/Z0IN)
+ 				  END IF
+ 				  ! ... CCN
+ 				  KRR = 0
+ 				  DO KR = p_ff8i01,p_ff8i43
+ 					KRR = KRR + 1
+   					if (xland(i,j) == 1)then
+   						! chem_new(I,K,J,KR)=FCCNR_CON(KRR)*FACTZ
+   						chem_new(I,K,J,KR) = (FCCNR_CON(KRR)/rhoair_max)*rhocgs(i,k,j) ! ... distributed vertically as [#/g]
+   					else
+   						chem_new(I,K,J,KR) = (FCCNR_MAR(KRR)/rhoair_max)*rhocgs(i,k,j) ! ... distributed vertically as [#/g]
+   					endif
+ 				  END DO
+ 				endif
+ 			end do
+ 		  end do
+ 	   end do
+ 	 end if
+
+ ! +--------------------------------------------+
+ ! ... Aerosols boundary conditions
+ ! +--------------------------------------------+
+    if (itimestep > 1 .and. dx > dx_bound)then
+        DO j = jts,jte
+         DO k = kts,kte
+           DO i = its,ite
+		          rhoair_max = rhocgs(i,1,j) ! [g/cm3]
+              if (i <= 5 .or. i >= IDE-5 .OR. &
+                  & j <= 5 .or. j >= JDE-5)THEN
+                  if(ILogNormal_modes_Aerosol == 1)then
+                    IF (zcgs(I,K,J).LE.ZMIN) THEN
+                       FACTZ = 1.0
+                    ELSE
+                       FACTZ=EXP(-(zcgs(I,K,J)-ZMIN)/Z0IN)
+                    END IF
+                    ! ... CCN
+	                  KRR = 0
+                    DO kr = p_ff8i01,p_ff8i43
+                      KRR = KRR + 1
+           						if (xland(i,j) == 1)then
+           							! chem_new(I,K,J,KR)=FCCNR_CON(KRR)*FACTZ
+           							chem_new(I,K,J,KR) = (FCCNR_CON(KRR)/rhoair_max)*rhocgs(i,k,j)
+                   		else
+           							chem_new(I,K,J,KR) = (FCCNR_MAR(KRR)/rhoair_max)*rhocgs(i,k,j)
+           						endif
+                   END DO
+	               endif
+              end if
+           end do
+         end do
+       end do
+     end if
+
+     if (itimestep == 1)then
+        DO j = j_start,j_end
+           DO k = kts,kte
+             DO i = i_start,i_end
+                th_old(i,k,j)=th_phy(i,k,j)
+                qv_old(i,k,j)=qv(i,k,j)
+              END DO
+     	     END DO
+        END DO
+     end if
+
+     DO j = j_start,j_end
+        DO k = kts,kte
+           DO i = i_start,i_end
+              t_new(i,k,j) = th_phy(i,k,j)*pi_phy(i,k,j)
+              !tempc(i,k,j)= t_new(i,k,j)-273.16
+              t_old(i,k,j) = th_old(i,k,j)*pi_phy(i,k,j)
+           END DO
+        END DO
+     END DO
+
+     KZ_Cloud_Base = 0
+     DO j = jts,jte
+        DO i = its,ite
+    	     K_found = .FALSE.
+           DO k = kts,kte
+
+       		 	ES1N = AA1_MY*EXP(-BB1_MY/T_NEW(I,K,J))
+       		 	EW1N = QV(I,K,J)*pcgs(I,K,J)/(0.622+0.378*QV(I,K,J))
+       		 	SUP_WATER = EW1N/ES1N - 1.0
+       		 	if(k.lt.kte)then
+       		    	w_stag_my 	= 50.*(w(i,k,j)+w(i,k+1,j))
+       		    else
+       		    	w_stag_my = 100*w(i,k,j)
+       		 	end if
+       			if(SUP_WATER > 0.0D0 .and. w_stag_my > 0.1*1.0D2 .and. K_found == .FALSE. .and. K > 2 .and. zcgs(I,K,J) < 3.0*1.0D5)then
+       				KZ_Cloud_Base(I,J) = K ! K-level index of cloud base
+       				K_found = .TRUE.
+       			endif
+
+            IF(K.EQ.KTE)THEN
+              DZZ(K)=(zcgs(I,K,J)-zcgs(I,K-1,J))
+              ELSE IF(K.EQ.1)THEN
+              DZZ(K)=(zcgs(I,K+1,J)-zcgs(I,K,J))
+            ELSE
+              DZZ(K)=(zcgs(I,K+1,J)-zcgs(I,K-1,J))
+            END IF
+            ES2N=AA2_MY*EXP(-BB2_MY/T_OLD(I,K,J))
+            EW1N=QV_OLD(I,K,J)*pcgs(I,K,J)/(0.622+0.378*QV_OLD(I,K,J))
+            SUPICE(K)=EW1N/ES2N-1.
+            IF(SUPICE(K).GT.0.5) SUPICE(K)=.5
+          END DO
+          DO k = kts,kte
+            IF(T_OLD(I,K,J).GE.238.15.AND.T_OLD(I,K,J).LT.274.15) THEN
+            if (k.lt.kte)then
+                w_stag=50.*(w(i,k,j)+w(i,k+1,j))
+            else
+                w_stag=100*w(i,k,j)
+            end if
+            IF (I.LT.IDE-1.AND.J.LT.JDE-1)THEN
+               UX=25.*(U(I,K,J)+U(I+1,K,J)+U(I,K,J+1)+U(I+1,K,J+1))
+               VX=25.*(V(I,K,J)+V(I+1,K,J)+V(I,K,J+1)+V(I+1,K,J+1))
+            ELSE
+               UX=U(I,K,J)*100.
+               VX=V(I,K,J)*100.
+            END IF
+            IF(K.EQ.1) DERIVT_Z=(T_OLD(I,K+1,J)-T_OLD(I,K,J))/DZZ(K)
+            IF(K.EQ.KTE) DERIVT_Z=(T_OLD(I,K,J)-T_OLD(I,K-1,J))/DZZ(K)
+            IF(K.GT.1.AND.K.LT.KTE) DERIVT_Z= &
+                                   (T_OLD(I,K+1,J)-T_OLD(I,K-1,J))/DZZ(K)
+            IF (I.EQ.1)THEN
+               DERIVT_X=(T_OLD(I+1,K,J)-T_OLD(I,K,J))/(DXHUCM)
+            ELSE IF (I.EQ.IDE-1)THEN
+               DERIVT_X=(T_OLD(I,K,J)-T_OLD(I-1,K,J))/(DXHUCM)
+            ELSE
+               DERIVT_X=(T_OLD(I+1,K,J)-T_OLD(I-1,K,J))/(2.*DXHUCM)
+            END IF
+            IF (J.EQ.1)THEN
+               DERIVT_Y=(T_OLD(I,K,J+1)-T_OLD(I,K,J))/(DYHUCM)
+            ELSE IF (J.EQ.JDE-1)THEN
+                DERIVT_Y=(T_OLD(I,K,J)-T_OLD(I,K,J-1))/(DYHUCM)
+            ELSE
+                DERIVT_Y=(T_OLD(I,K,J+1)-T_OLD(I,K,J-1))/(2.*DYHUCM)
+            END IF
+              DTFREEZ_XYZ(I,K,J) = DT*(VX*DERIVT_Y+ &
+                                 UX*DERIVT_X+w_stag*DERIVT_Z)
+            ELSE ! IF(T_OLD(I,K,J).GE.238.15.AND.T_OLD(I,K,J).LT.274.15)
+              DTFREEZ_XYZ(I,K,J)=0.
+            ENDIF
+            IF(SUPICE(K).GE.0.02.AND.T_OLD(I,K,J).LT.268.15) THEN
+              IF (I.LT.IDE-1)THEN
+                  ES2NPLSX=AA2_MY*EXP(-BB2_MY/T_OLD(I+1,K,J))
+                  EW1NPLSX=QV_OLD(I+1,K,J)*pcgs(I+1,K,J)/ &
+                            (0.622+0.378*QV_OLD(I+1,K,J))
+              ELSE
+                  ES2NPLSX = AA2_MY*EXP(-BB2_MY/T_OLD(I,K,J))
+                  EW1NPLSX = QV_OLD(I,K,J)*pcgs(I,K,J)/ &
+                            (0.622+0.378*QV_OLD(I,K,J))
+              END IF
+              IF (ES2NPLSX.EQ.0)THEN
+                 DEL2INPLSX=0.5
+              ELSE
+                 DEL2INPLSX=EW1NPLSX/ES2NPLSX-1.
+              END IF
+              IF(DEL2INPLSX.GT.0.5) DEL2INPLSX=.5
+              IF (I.GT.1)THEN
+                 ES2N=AA2_MY*EXP(-BB2_MY/T_OLD(I-1,K,J))
+                 EW1N=QV_OLD(I-1,K,J)*pcgs(I-1,K,J)/(0.622+0.378*QV_OLD(I-1,K,J))
+              ELSE
+                 ES2N=AA2_MY*EXP(-BB2_MY/T_OLD(I,K,J))
+                 EW1N=QV_OLD(I,K,J)*pcgs(I,K,J)/(0.622+0.378*QV_OLD(I,K,J))
+              END IF
+              DEL2IN=EW1N/ES2N-1.
+              IF(DEL2IN.GT.0.5) DEL2IN=.5
+              IF (I.GT.1.AND.I.LT.IDE-1)THEN
+                  DERIVS_X=(DEL2INPLSX-DEL2IN)/(2.*DXHUCM)
+              ELSE
+                  DERIVS_X=(DEL2INPLSX-DEL2IN)/(DXHUCM)
+              END IF
+              IF (J.LT.JDE-1)THEN
+                 ES2NPLSY=AA2_MY*EXP(-BB2_MY/T_OLD(I,K,J+1))
+                 EW1NPLSY=QV_OLD(I,K,J+1)*pcgs(I,K,J+1)/(0.622+0.378*QV_OLD(I,K,J+1))
+              ELSE
+                 ES2NPLSY=AA2_MY*EXP(-BB2_MY/T_OLD(I,K,J))
+                 EW1NPLSY=QV_OLD(I,K,J)*pcgs(I,K,J)/(0.622+0.378*QV_OLD(I,K,J))
+              END IF
+              DEL2INPLSY=EW1NPLSY/ES2NPLSY-1.
+              IF(DEL2INPLSY.GT.0.5) DEL2INPLSY=.5
+              IF (J.GT.1)THEN
+                 ES2N=AA2_MY*EXP(-BB2_MY/T_OLD(I,K,J-1))
+                 EW1N=QV_OLD(I,K,J-1)*pcgs(I,K,J-1)/(0.622+0.378*QV_OLD(I,K,J-1))
+              ELSE
+                 ES2N=AA2_MY*EXP(-BB2_MY/T_OLD(I,K,J))
+                 EW1N=QV_OLD(I,K,J)*pcgs(I,K,J)/(0.622+0.378*QV_OLD(I,K,J))
+              END IF
+              DEL2IN=EW1N/ES2N-1.
+              IF(DEL2IN.GT.0.5) DEL2IN=.5
+              IF (J.GT.1.AND.J.LT.JDE-1)THEN
+                  DERIVS_Y=(DEL2INPLSY-DEL2IN)/(2.*DYHUCM)
+              ELSE
+                  DERIVS_Y=(DEL2INPLSY-DEL2IN)/(DYHUCM)
+              END IF
+              IF (K.EQ.1)DERIVS_Z=(SUPICE(K+1)-SUPICE(K))/DZZ(K)
+              IF (K.EQ.KTE)DERIVS_Z=(SUPICE(K)-SUPICE(K-1))/DZZ(K)
+              IF(K.GT.1.and.K.LT.KTE) DERIVS_Z=(SUPICE(K+1)-SUPICE(K-1))/DZZ(K)
+              IF (I.LT.IDE-1.AND.J.LT.JDE-1)THEN
+               UX=25.*(U(I,K,J)+U(I+1,K,J)+U(I,K,J+1)+U(I+1,K,J+1))
+               VX=25.*(V(I,K,J)+V(I+1,K,J)+V(I,K,J+1)+V(I+1,K,J+1))
+             ELSE
+               UX=U(I,K,J)*100.
+               VX=V(I,K,J)*100.
+             END IF
+             DSUPICE_XYZ(I,K,J)=(UX*DERIVS_X+VX*DERIVS_Y+ &
+                                w_stag*DERIVS_Z)*DTCOND
+            ELSE
+              DSUPICE_XYZ(I,K,J)=0.0
+            END IF
+            END DO
+          END DO
+        END DO
 
-! NEW ALGORITHM OF CONDENSATION (12.01.00)
+       do j = jts,jte
+          do k = kts,kte
+             do i = its,ite
+
+            ! ... correcting Look-up-table Terminal velocities
+            FACTOR_P = DSQRT(1.0D6/PCGS(I,K,J))
+            VR2_ZC(1:nkr,K) = VR2(1:nkr,1)*FACTOR_P
+            VR2_ZP(1:nkr,K) = VR2(1:nkr,2)*FACTOR_P
+            VR2_ZD(1:nkr,K) = VR2(1:nkr,3)*FACTOR_P
+            VR1_Z(1:nkr,K) =  VR1(1:nkr)*FACTOR_P
+            VR3_Z(1:nkr,K) = VR3(1:nkr)*FACTOR_P
+            VR4_Z(1:nkr,K) = VR4(1:nkr)*FACTOR_P
+            VR5_Z(1:nkr,k) = VR5(1:nkr)*FACTOR_P
+            VR3_Z3D(1:nkr,I,K,J) = VR3(1:nkr)*FACTOR_P
+            VR4_Z3D(1:nkr,I,K,J) = VR4(1:nkr)*FACTOR_P
+            VR5_Z3D(1:nkr,I,K,J) = VR5(1:nkr)*FACTOR_P
+
+     			! ... Liquid
+     			  KRR = 0
+     			  DO kr = p_ff1i01,p_ff1i33
+     				 KRR = KRR + 1
+     				 FF1R(KRR) = chem_new(I,K,J,KR)
+     				 IF (FF1R(KRR) < 0.0)FF1R(KRR) = 0.0
+     			  END DO
+     			! ... CCN
+     			  KRR = 0
+     			  DO kr=p_ff8i01,p_ff8i43
+     				 KRR = KRR + 1
+     				 FCCN(KRR) = chem_new(I,K,J,KR)
+     				 if (fccn(krr) < 0.0)fccn(krr) = 0.0
+     			  END DO
+
+   				! no explicit Ice Crystals in FSBM
+   				 FF2R(:,1) = 0.0
+   				 FF2R(:,2) = 0.0
+   				 FF2R(:,3) = 0.0
+
+   				! ... Snow
+   				KRR=0
+   				DO kr=p_ff5i01,p_ff5i33
+   					KRR=KRR+1
+   					FF3R(KRR)=chem_new(I,K,J,KR)
+   					if (ff3r(krr) < 0.0)ff3r(krr) = 0.0
+   				END DO
+
+          ! ... Hail or Graupel
+          if(hail_opt == 1)then
+           KRR=0
+           DO kr=p_ff6i01,p_ff6i33
+               KRR=KRR+1
+               FF5R(KRR) = chem_new(I,K,J,KR)
+               if (ff5r(krr) < 0.0)ff5r(krr) = 0.0
+               FF4R(KRR) = 0.0
+           ENDDO
+          else
+           KRR=0
+           DO kr=p_ff6i01,p_ff6i33
+               KRR=KRR+1
+               FF4R(KRR) = chem_new(I,K,J,KR)
+               if (ff4r(krr) < 0.0)ff4r(krr) = 0.0
+               FF5R(KRR) = 0.0
+           ENDDO
+          endif
 
-      DOUBLE PRECISION DD1N,DB11_MY,DAL1,DAL2
-      DOUBLE PRECISION COL3,RORI,TPN,TPS,QPN,QPS,TOLD,QOLD &
-     &                  ,FI1_K,FI2_K,FI3_K,FI4_K,FI5_K &
-     &                  ,R1_K,R2_K,R3_K,R4_K,R5_K &
-     &                  ,FI1R1,FI2R2,FI3R3,FI4R4,FI5R5 &
-     &                  ,RMASSLAA,RMASSLBB,RMASSIAA,RMASSIBB &
-     &                  ,ES1N,ES2N,EW1N,ARGEXP &
-     &                  ,TT,QQ,PP &
-     &                  ,DEL1N,DEL2N,DIV1,DIV2 &
-     &                  ,OPER2,OPER3,AR1,AR2  
-
-       DOUBLE PRECISION DELTAQ1,DELMASSI1,DELMASSL1
-
-! CONTROL OF DROP SPECTRUM IN SUBROUTINE ONECOND
-
-        CHARACTER*70 CPRINT
-
-
-
-
-
-
-
-! CRYSTALS
-                                                                       
-	REAL R2(NKR,ICEMAX) &
-     &           ,RIEC(NKR,ICEMAX) &
-     &           ,RO2BL(NKR,ICEMAX) &
-     &           ,FI2(NKR,ICEMAX),PSI2(NKR,ICEMAX) &
-     &           ,FF2(NKR,ICEMAX) &
-     &           ,B21_MY(NKR,ICEMAX),B22_MY(NKR,ICEMAX)
-
-! SNOW                                                                          
-        REAL R3(NKR) &
-     &           ,RSEC(NKR),RO3BL(NKR) &
-     &           ,FI3(NKR),FF3(NKR),PSI3(NKR) &
-     &           ,B31_MY(NKR),B32_MY(NKR)
-
-! GRAUPELS 
-                                                                       
-        REAL R4(NKR) &
-     &           ,RGEC(NKR),RO4BL(NKR) &
-     &           ,FI4(NKR),FF4(NKR),PSI4(NKR) &
-     &           ,B41_MY(NKR),B42_MY(NKR)  
-
-! HAIL                                                                          
-        REAL R5(NKR) &
-     &           ,RHEC(NKR),RO5BL(NKR) &
-     &           ,FI5(NKR),FF5(NKR),PSI5(NKR) &
-     &           ,B51_MY(NKR),B52_MY(NKR)  
-
-! CCN                                                                       
-
-! WORK ARRAYS 
-
-! NEW ALGORITHM OF MIXED PHASE FOR EVAPORATION
-
-	REAL DTIMEG(NKR),DTIMEH(NKR) 
-       
-	REAL DEL2D(ICEMAX),DTIMEO(NKR),DTIMEL(NKR) &
-
-! NEW ALGORITHM (NO TYPE OF ICE)
-
-     &           ,DTIMEI_1(NKR),DTIMEI_2(NKR),DTIMEI_3(NKR) &
-     &           ,SFNI1(ICEMAX),SFNI2(ICEMAX) &
-     &           ,TIMESTEPD(NKR) &
-     &           ,FI1REF(NKR),PSI1REF(NKR) &
-     &           ,FI2REF(NKR,ICEMAX),PSI2REF(NKR,ICEMAX)&
-     &           ,FCCNRREF(NKR)
-
-
-	OPER2(AR1)=0.622/(0.622+0.378*AR1)/AR1
-	OPER3(AR1,AR2)=AR1*AR2/(0.622+0.378*AR1)
-
-        DATA AL1 /2500./, AL2 /2834./, D /0.211/ &
-     &      ,GAM /1.E-4/, POD /10./ 
-           
-	DATA RV_MY,CF_MY,D_MYIN,AL1_MY,AL2_MY &
-     &      /461.5,0.24E-1,0.211E-4,2.5E6,2.834E6/
-
-	DATA A1_MYN, BB1_MYN, A2_MYN, BB2_MYN &
-     &      /2.53,5.42,3.41E1,6.13/
-
-	DATA TPC1, TPC2, TPC3, TPC4, TPC5 &
-     &      /-4.0,-8.1,-12.7,-17.8,-22.4/ 
+! +---------------------------------------------+
+! Neucliation, Condensation, Collisions
+! +---------------------------------------------+
+          IF (T_OLD(I,K,J).GT.213.15)THEN
+             TT=T_OLD(I,K,J)
+             QQ=QV_OLD(I,K,J)
+             IF(QQ.LE.0.0) QQ = 1.D-10
+             PP=pcgs(I,K,J)
+             TTA=T_NEW(I,K,J)
+             QQA=QV(I,K,J)
+
+             IF (QQA.LE.0) call wrf_message("WARNING: FAST SBM, QQA < 0")
+             IF (QQA.LE.0) print*,'I,J,K,Told,Tnew,QQA = ',I,J,K,TT,TTA,QQA
+             IF (QQA.LE.0) QQA = 1.0D-10
+
+             ES1N = AA1_MY*DEXP(-BB1_MY/TT)
+             ES2N = AA2_MY*DEXP(-BB2_MY/TT)
+             EW1N=QQ*PP/(0.622+0.378*QQ)
+             DIV1=EW1N/ES1N
+             DEL1IN=EW1N/ES1N-1.
+             DIV2=EW1N/ES2N
+             DEL2IN=EW1N/ES2N-1.
 
+            CALL Relaxation_Time(TT,QQ,PP,rhocgs(I,K,J),DEL1IN,DEL2IN, &
+                                  XL,VR1_Z(:,K),FF1R,RLEC,RO1BL, &
+                                  XI,VR2_Z,FF2R,RIEC,RO2BL, &
+                                  XS,VR3_Z(:,K),FF3R,RSEC,RO3BL, &
+                                  XG,VR4_Z(:,K),FF4R,RGEC,RO4BL, &
+                                  XH,VR5_Z(:,k),FF5R,RHEC,RO5BL, &
+                                  NKR,ICEMAX,COL,DT,NCOND,DTCOND)
+
+           ES1N=AA1_MY*DEXP(-BB1_MY/TTA)
+           ES2N=AA2_MY*DEXP(-BB2_MY/TTA)
+           EW1N=QQA*PP/(0.622+0.378*QQA)
+           DIV3=EW1N/ES1N
+           DEL1AD=EW1N/ES1N-1.
+           DIV4=EW1N/ES2N
+           DEL2AD=EW1N/ES2N-1.
+           SUP2_OLD=DEL2IN
+           DELSUP1=(DEL1AD-DEL1IN)/NCOND
+           DELSUP2=(DEL2AD-DEL2IN)/NCOND
+           DELDIV1=(DIV3-DIV1)/NCOND
+           DELDIV2=(DIV4-DIV2)/NCOND
+           DELTATEMP = 0
+           DELTAQ = 0
+           tt_old = TT
+           qq_old = qq
+           DIFFU=1
+
+           IF (DIV1.EQ.DIV3)DIFFU=0
+           IF (DIV2.EQ.DIV4)DIFFU=0
+
+           DTNEW = 0.0
+           DO IKL=1,NCOND
+             DTCOND = min(DT-DTNEW,DTCOND)
+             DTNEW = DTNEW + DTCOND
+
+             IF (DIFFU.NE.0)THEN
+               IF (DIFFU.NE.0)THEN
+                   DEL1IN = DEL1IN+DELSUP1
+                   DEL2IN = DEL2IN+DELSUP2
+                   DIV1 = DIV1+DELDIV1
+                   DIV2 = DIV2+DELDIV2
+               END IF
+               IF (DIV1.GT.DIV2.AND.TT.LE.265)THEN
+                 DIFFU=0
+               END IF
+               IF (DIFFU == 1)THEN
+                 DEL1NR=A1_MYN*(100.*DIV1)
+                 DEL2NR=A2_MYN*(100.*DIV2)
+                 IF (DEL2NR.EQ.0)print*,'ikl = ',ikl
+                 IF (DEL2NR.EQ.0)print*,'div1,div2 = ',div1,div2
+                 IF (DEL2NR.EQ.0)print*,'i,j,k = ',i,j,k
+                 IF (DEL2NR.EQ.0)call wrf_error_fatal("fatal error in module_mp_fast_sbm (DEL2NR.EQ.0) , model stop ")
+                 DEL12R=DEL1NR/DEL2NR
+                 DEL12RD=DEL12R**DEL_BBR
+                 EW1PN=AA1_MY*100.*DIV1*DEL12RD/100.
+                 TT=-DEL_BB/DLOG(DEL12R)
+                 QQ=0.622*EW1PN/(PP-0.378*EW1PN)
+
+                 DO KR=1,NKR
+                 FF1IN(KR)=FF1R(KR)
+                   DO ICE=1,ICEMAX
+                    FF2IN(KR,ICE)=FF2R(KR,ICE)
+                  ENDDO
+                 ENDDO
 
-        DATA EPSDEL/0.1E-03/
-    
-	DATA DT0L, DT0I /1.E20,1.E20/
+                 IF(DEL1IN .GT. 0.0 .OR. DEL2IN .GT. 0.0)THEN
+! +------------------------------------------+
+! Droplet nucleation :
+! +------------------------------------------+
+                     Is_This_CloudBase = 0
+                     IF(KZ_Cloud_Base(I,J) == K .and. col*sum(FF1IN*XL) < 5.0) Is_This_CloudBase = 1
+                     if (k.lt.kte)then
+                       w_stag_my 	= 50.*(w(i,k,j)+w(i,k+1,j))
+                     else
+                       w_stag_my = 100*w(i,k,j)
+                     end if
+                     CALL JERNUCL01_KS(FF1IN,FF2IN,FCCN 		  &
+                                       ,XL,XI,TT,QQ       					    &
+                                       ,rhocgs(I,K,J),pcgs(I,K,J) 			&
+                                       ,DEL1IN,DEL2IN     			        &
+                                       ,COL 								            &
+                                       ,SUP2_OLD,DSUPICE_XYZ(I,K,J) 		&
+                                       ,RCCN,DROPRADII,NKR,NKR_aerosol,ICEMAX,ICEPROCS &
+                                       ,W_Stag_My,Is_This_CloudBase,RO_SOLUTE,IONS,MWAERO &
+                                       ,I,J,K)
+                  END IF
+
+                  DO KR=1,NKR
+                   FF1R(KR)=FF1IN(KR)
+                     DO ICE=1,ICEMAX
+                       FF3R(KR) = FF3R(KR) + FF2IN(KR,ICE)
+                       FF2IN(KR,ICE) = 0.0
+                       FF2R(KR,ICE) = 0.0
+                     END DO
+                  END DO
+
+                  FMAX1=0.
+                  FMAX2=0.
+                  FMAX3=0.
+                  FMAX4=0.
+                  FMAX5=0.
+                  DO KR=1,NKR
+                     FF1IN(KR)=FF1R(KR)
+                     FMAX1=AMAX1(FF1R(KR),FMAX1)
+                     FF3IN(KR)=FF3R(KR)
+                     FMAX3=AMAX1(FF3R(KR),FMAX3)
+                     FF4IN(KR)=FF4R(KR)
+                     FMAX4=AMAX1(FF4R(KR),FMAX4)
+                     FF5IN(KR)=FF5R(KR)
+                     FMAX5=AMAX1(FF5R(KR),FMAX5)
+                     DO ICE=1,ICEMAX
+                       FF2IN(KR,ICE)=FF2R(KR,ICE)
+                       FMAX2(ICE)=AMAX1(FF2R(KR,ICE),FMAX2(ICE)) ! ### (KS) FMAX2(3)
+                     END DO
+                  END DO
+                 ISYM1=0
+                 ISYM2=0
+                 ISYM3=0
+                 ISYM4=0
+                 ISYM5=0
+                 IF(FMAX1 > 0)ISYM1 = 1
+                 IF (ICEPROCS == 1)THEN
+                   IF(FMAX2(1) > 1.E-10)ISYM2(1) = 1
+                   IF(FMAX2(2) > 1.E-10)ISYM2(2) = 1
+                   IF(FMAX2(3) > 1.E-10)ISYM2(3) = 1
+                   IF(FMAX3 > 1.E-10)ISYM3 = 1
+                   IF(FMAX4 > 1.E-10)ISYM4 = 1
+                   IF(FMAX5 > 1.E-10)ISYM5 = 1
+                 END IF
 
-! CONTROL OF DROP SPECTRUM IN SUBROUTINE ONECOND
+                 IF(ISYM1==1 .AND. ((TT-273.15)>-0.187 .OR.(sum(ISYM2)==0 .AND. &
+                     ISYM3==0 .AND. ISYM4==0 .AND. ISYM5==0)))THEN
+
+                     ! ... only warm phase
+                     CALL ONECOND1(TT,QQ,PP,rhocgs(I,K,J) &
+                                   ,VR1_Z(:,K),pcgs(I,K,J) &
+                                   ,DEL1IN,DEL2IN,DIV1,DIV2 &
+                                   ,FF1R,FF1IN,XL,RLEC,RO1BL &
+                                   ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+                                   ,C1_MEY,C2_MEY &
+                                   ,COL,DTCOND,ICEMAX,NKR,ISYM1 &
+                                   ,ISYM2,ISYM3,ISYM4,ISYM5,I,J,K,W(i,k,j),DX,Itimestep)
+
+                  ELSE IF(ISYM1==0 .AND. (TT-273.15)<-0.187 .AND. &
+                          (sum(ISYM2)>1 .OR. ISYM3==1 .OR. ISYM4==1 .OR. ISYM5==1))THEN
+                            IF (T_OLD(I,K,J).GT.213.15)THEN
+                               VR2_Z(:,1) = VR2_ZC(:,K)
+                               VR2_Z(:,2) = VR2_ZP(:,K)
+                               VR2_Z(:,3) = VR2_ZD(:,K)
+                               CALL ONECOND2(TT,QQ,PP,rhocgs(I,K,J) &
+                               ,VR2_Z,VR3_Z(:,K),VR4_Z(:,K),VR5_Z(:,K),pcgs(I,K,J) &
+                               ,DEL1IN,DEL2IN,DIV1,DIV2 &
+                               ,FF2R,FF2IN,XI,RIEC,RO2BL &
+                               ,FF3R,FF3IN,XS,RSEC,RO3BL &
+                               ,FF4R,FF4IN,XG,RGEC,RO4BL &
+                               ,FF5R,FF5IN,XH,RHEC,RO5BL &
+                               ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+                               ,C1_MEY,C2_MEY &
+                               ,COL,DTCOND,ICEMAX,NKR &
+                               ,ISYM1,ISYM2,ISYM3,ISYM4,ISYM5,I,J,K,W(i,k,j),DX,Itimestep)
+                           END IF
+                    ELSE IF(ISYM1==1 .AND. (TT-273.15)<-0.187 .AND. &
+                         (sum(ISYM2)>1 .OR. ISYM3==1 .OR. ISYM4==1 .OR. ISYM5==1))THEN
+                         IF (T_OLD(I,K,J).GT.233.15)THEN
+                           VR2_Z(:,1) = VR2_ZC(:,K)
+                           VR2_Z(:,2) = VR2_ZP(:,K)
+                           VR2_Z(:,3) = VR2_ZD(:,K)
+                           CALL ONECOND3(TT,QQ,PP,rhocgs(I,K,J) &
+                           ,VR1_Z(:,K),VR2_Z,VR3_Z(:,K),VR4_Z(:,K),VR5_Z(:,K),pcgs(I,K,J) &
+                           ,DEL1IN,DEL2IN,DIV1,DIV2 &
+                           ,FF1R,FF1IN,XL,RLEC,RO1BL &
+                           ,FF2R,FF2IN,XI,RIEC,RO2BL &
+                           ,FF3R,FF3IN,XS,RSEC,RO3BL &
+                           ,FF4R,FF4IN,XG,RGEC,RO4BL &
+                           ,FF5R,FF5IN,XH,RHEC,RO5BL &
+                           ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+                           ,C1_MEY,C2_MEY &
+                           ,COL,DTCOND,ICEMAX,NKR &
+                           ,ISYM1,ISYM2,ISYM3,ISYM4,ISYM5,I,J,K,W(i,k,j),DX,Itimestep)
+                        ENDIF
+                      END IF
+                    END IF ! DIFF.NE.0
+                END IF 	! DIFFU.NE.0
+            END DO ! NCOND - end of NCOND loop
+! +----------------------------------+
+! Collision-Coallescnce
+! +----------------------------------+
+           DO IKL = 1,NCOLL
+             IF ( TT >= 233.15 ) THEN
+               FLIQFR_SD = 0.0
+               FLIQFR_GD = 0.0
+               FLIQFR_HD = 0.0
+               FRIMFR_SD = 0.0
+               CALL COAL_BOTT_NEW (FF1R,FF2R,FF3R,     				    &
+                         FF4R,FF5R,TT,QQ,PP, 					            &
+                         rhocgs(I,K,J),dt_coll,TCRIT,TTCOAL, 	    &
+                         FLIQFR_SD,FLIQFR_GD,FLIQFR_HD,FRIMFR_SD,  &
+                         DEL1IN, DEL2IN, 			        	          &
+                         I,J,K,CollEff_out)
 
+             END IF
+           END DO ! NCOLL - end of NCOLL loop
+
+           IF (DIFFU == 0)THEN
+             T_new(i,k,j) = tt_old
+             qv(i,k,j) = qq_old
+           ELSE
+             T_new(i,k,j) = tt
+             qv(i,k,j) = qq
+           END IF
 
-! CONTROL OF TIMESTEP ITERATIONS IN MIXED PHASE: EVAPORATION
-        
-        I_MIXCOND=0
-        I_MIXEVAP=0
-        I_ABERGERON=0
-        I_BERGERON=0
-! SOME CONSTANTS 
-        COL3=3.0*COL
-        ICM=ICEMAX
-        ITIME=0
-        KCOND=0
-        DT_WATER_COND=0.4
-        DT_WATER_EVAP=0.4
-        DT_ICE_COND=0.4
-        DT_ICE_EVAP=0.4
-        DT_MIX_COND=0.4
-        DT_MIX_EVAP=0.4
-        DT_MIX_BERGERON=0.4
-        DT_MIX_ANTIBERGERON=0.4
-	ICM=ICEMAX
-	ITIME=0
-	KCOND=0
-        DT0LREF=0.2
-        DTLREF=0.4
+        ! in case T_OLD(I,K,J).GT.213.15
+        END IF
+ ! +-------------------------------- +
+ ! Immediate Freezing
+ ! +---------------------------------+
+ 				IF(T_NEW(i,k,j) < 273.15)THEN
+ 					CALL FREEZ &
+ 							(FF1R,XL,FF2R,XI,FF3R,XS,FF4R,XG,FF5R,XH, &
+ 							 T_NEW(I,K,J),DT,rhocgs(I,K,J), 			  &
+ 							 COL,AFREEZMY,BFREEZMY,BFREEZMAX, 		  &
+ 							 KRFREEZ,ICEMAX,NKR)
+ 				ENDIF
+! --------------------------------------------------------------+
+! Jiwen Fan Melting (melting along a constant time scale)
+! --------------------------------------------------------------+
+		    IF (JIWEN_FAN_MELT == 1 .and. T_NEW(i,k,j) > 273.15) THEN
+				   CALL J_W_MELT(FF1R,XL,FF2R,XI,FF3R,XS,FF4R,XG,FF5R,XH, &
+						             T_NEW(I,K,J),DT,rhocgs(I,K,J),COL,ICEMAX,NKR)
+        END IF
 
-	NR=NKR
-	NRM=NKR-1
-	DT=DTCOND
-	DTT=DTCOND
-	XRAD=0.
-
-!     BARRY
-	CWHUCM=0.
-	XRAD=0.
-	B6=CWHUCM*GAM-XRAD
-	B8L=1./ROR
-	B8I=1./ROR
-        RORI=1./ROR
-
-! INITIALIZATION OF SOME ARRAYS
-
-!       BARRY
-        TPN=TT
-        QPN=QQ
-
-
-! TYPE OF ICE IN DIFFUSIONAL GROWTH 
-
-	      DO ICE=1,ICEMAX
-	         SFNI1(ICE)=0.
-	         SFNI2(ICE)=0.
-	         DEL2D(ICE)=0.
-	      ENDDO
-
-! TIME SPLITTING 
-
-	      TIMENEW=0.
-	      ITIME=0
-
-! ONLY ICE (CONDENSATION OR EVAPORATION) :
-
-   46         ITIME=ITIME+1
-
-	      TIMEREV=DT-TIMENEW
-
-	      DEL1=DEL1N
-	      DEL2=DEL2N
-	      DEL1S=DEL1N
-	      DEL2S=DEL2N
-	      DEL2D(1)=DEL2N
-	      DEL2D(2)=DEL2N
-	      DEL2D(3)=DEL2N
-	      TPS=TPN
-	      QPS=QPN
-              DO KR=1,NKR
-                 FI3(KR)=PSI3(KR)
-                 FI4(KR)=PSI4(KR)
-                 FI5(KR)=PSI5(KR)
-                 DO ICE=1,ICEMAX
-                    FI2(KR,ICE)=PSI2(KR,ICE)
-                 ENDDO
-              ENDDO
-! TIME-STEP GROWTH RATE: 
-! ONLY ICE (CONDENSATION OR EVAPORATION)
-              CALL JERRATE(R2,TPS,PP,ROR,VR2,PSINGLE &
-     &                    ,RIEC,RO2BL,B21_MY,B22_MY,3,2,ICEMAX,NKR)   
-              CALL JERRATE(R3,TPS,PP,ROR,VR3,PSINGLE &
-     &                    ,RSEC,RO3BL,B31_MY,B32_MY,1,2,ICEMAX,NKR)
-              CALL JERRATE(R4,TPS,PP,ROR,VR4,PSINGLE &
-     &                    ,RGEC,RO4BL,B41_MY,B42_MY,1,2,ICEMAX,NKR)
-              CALL JERRATE(R5,TPS,PP,ROR,VR5,PSINGLE &
-     &                    ,RHEC,RO5BL,B51_MY,B52_MY,1,2,ICEMAX,NKR)
-
-
-! INTEGRALS IN DELTA EQUATION
-
-! CALL JERTIMESC CRYSTAL - 1 (ONLY ICE)
-              CALL JERTIMESC_ICE  &
-     &       (FI2,R2,SFNI1,SFNI2,B21_MY,B22_MY,RIEC,B8I,ICM,COL,NKR) 
-              CALL JERTIMESC &
-     &       (FI3,R3,SFN31,SFN32,B31_MY,B32_MY,RSEC,B8I,1,COL,NKR)  
-              CALL JERTIMESC &
-     &       (FI4,R4,SFN41,SFN42,B41_MY,B42_MY,RGEC,B8I,1,COL,NKR) 
-              CALL JERTIMESC &
-     &       (FI5,R5,SFN51,SFN52,B51_MY,B52_MY,RHEC,B8I,1,COL,NKR)
-	      SFNII1=SFNI1(1)+SFNI1(2)+SFNI1(3)
-	      SFNII2=SFNI2(1)+SFNI2(2)+SFNI2(3)
-	      SFN21=SFNII1+SFN31+SFN41+SFN51        
-	      SFN22=SFNII2+SFN32+SFN42+SFN52 
-	      SFNL=0.
-	      SFNI=SFN21+SFN22       
-! SOME CONSTANTS 
-	      B5L=BB1_MY/TPS/TPS
-	      B5I=BB2_MY/TPS/TPS
-              B7L=B5L*B6                                                     
-              B7I=B5I*B6
-	      DOPL=1.+DEL1S                                                     
-	      DOPI=1.+DEL2S                                                     
-	      OPERQ=OPER2(QPS)  
-              RW=(OPERQ+B5L*AL1)*DOPL*SFNL                                      
-              QW=B7L*DOPL
-              PW=(OPERQ+B5I*AL1)*DOPI*SFNL
-              RI=(OPERQ+B5L*AL2)*DOPL*SFNI
-              PI=(OPERQ+B5I*AL2)*DOPI*SFNI
-              QI=B7I*DOPI
-	      KCOND=20
-	      IF(DEL2.GT.0) KCOND=21
-
-! PROCESS'S TYPE (ONLY ICE) 
-
-	      IF(KCOND.EQ.21)  THEN
-
-! ONLY_ICE: CONDENSATION
-
-	      
-                DT0I=1.E20
-	        DTNEWI1=DTCOND
-	        DTNEWL=DTNEWI1
-	        IF(ITIME.GE.NKR) THEN
-                call wrf_error_fatal("fatal error in module_mp_fast_sbm (ITIME.GE.NKR), model stop")
-	        ENDIF
-	        TIMESTEPD(ITIME)=DTNEWL
-! NEW TIME STEP (ONLY_ICE: CONDENSATION)
-	        IF(DTNEWL.GT.DT) DTNEWL=DT
-	        IF((TIMENEW+DTNEWL).GT.DT.AND.ITIME.LT.(NKR-1))  &
-     &          DTNEWL=DT-TIMENEW
-                IF(ITIME.EQ.(NKR-1)) DTNEWL=DT-TIMENEW
-	        TIMESTEPD(ITIME)=DTNEWL
-	        TIMENEW=TIMENEW+DTNEWL
-	        DTT=DTNEWL
-! SOLVING FOR SUPERSATURATION (ONLY ICE: CONDENSATION) 
-
-! CALL JERSUPSAT - 4 (ONLY ICE: CONDENSATION)
-
-	        CALL JERSUPSAT(DEL1,DEL2,DEL1N,DEL2N &
-     &                        ,RW,PW,RI,PI,QW,QI &
-     &                        ,DTT,D1N,D2N,DT0L0,DT0I0)
-
-! END OF "NEW SUPERSATURATION" (ONLY ICE: CONDENSATION)
-
-
-! CRYSTALS (ONLY ICE: CONDENSATION) 
-
-	        IF(ISYM2.NE.0) THEN
-
-! CRYSTAL DTRIBUTION FUNCTION (ONLY ICE: CONDENSATION) 
- 
-! CALL JERDFUN CRYSTAL - 1 (ONLY ICE: CONDENSATION)
-
-! NEW ALGORITHM (NO TYPE ICE)
-	          CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                        ,FI2,PSI2,D2N &
-     &                        ,ICM,1,COL,NKR,TPN)
-
-	          CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                        ,FI2,PSI2,D2N &
-     &                        ,ICM,2,COL,NKR,TPN)
-
-	          CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                        ,FI2,PSI2,D2N &
-     &                        ,ICM,3,COL,NKR,TPN)
-! IN CASE : ISYM2.NE.0
-
-	        ENDIF
-! SNOW 
-	        IF(ISYM3.NE.0) THEN
-
-! SNOW DTRIBUTION FUNCTION (ONLY ICE: CONDENSATION) 
-                                                         
-
-! CALL JERDFUN SNOW - 1 (ONLY ICE: CONDENSATION)
-                  CALL JERDFUN(R3,B31_MY,B32_MY &
-     &                        ,FI3,PSI3,D2N &
-     &                        ,1,3,COL,NKR,TPN)
-
-	        ENDIF
-! IN CASE : ISYM4.NE.0
-! GRAUPELS (ONLY_ICE: EVAPORATION)
-
-                IF(ISYM4.NE.0) THEN
-
-! GRAUPEL DISTRIBUTION FUNCTION (ONLY_ICE: EVAPORATION)
-
-                  CALL JERDFUN(R4,B41_MY,B42_MY &
-     &                        ,FI4,PSI4,D2N &
-     &                        ,1,4,COL,NKR,TPN)
-! IN CASE : ISYM4.NE.0
+        DO KR=1,NKR
+          DO ICE=1,ICEMAX
+            FF3R(KR)=FF3R(KR) + FF2R(KR,ICE)
+            FF2R(KR,ICE)=0.
+          END DO
+          if(hail_opt == 1)then
+            FF5R(KR) = FF5R(KR) + FF4R(KR)
+            FF4R(KR) = 0.0
+          else
+            FF4R(KR) = FF4R(KR) + FF5R(KR)
+            FF5R(KR) = 0.0
+          endif
+        END DO
 
-                ENDIF
+ ! +---------------------------+
+ ! Spontanaous Rain Breakup
+! +----------------------------+
+ 			IF (Spont_Rain_BreakUp_On == 1 .AND. (SUM(FF1R) > 43.0*1.0D-30) )THEN
+ 					FF1R_D(:) = FF1R(:)
+ 					XL_D(:) = XL(:)
+ 					CALL Spont_Rain_BreakUp (DT ,FF1R_D, XL_D, Prob, Gain_Var_New, NND, NKR, ikr_spon_break)
+		      FF1R(:) = FF1R_D(:)
+ 			END IF
+
+ ! -----------------------------------------------------------+
+ ! ... Snow BreakUp
+ ! -----------------------------------------------------------+
+ 		IF (Snow_BreakUp_On == 1 .AND. sum(FF3R(KR_SNOW_MIN:NKR))> (NKR-KR_SNOW_MIN)*1.0D-30)THEN
+
+ 			DO KR=1,NKR
+ 				FF3R_D(KR) = FF3R(KR)
+ 			END DO
+			IF (KR_SNOW_MAX <= NKR) CALL BreakUp_Snow (TT_r,FF3R_D,FLIQFR_SD,xs_d,FRIMFR_SD,NKR)
+ 					DO KR=1,NKR
+ 						FF3R(KR) = FF3R_D(KR)
+ 					END DO
+ 		END IF
+
+    ! Update temperature at the end of MP
+  	th_phy(i,k,j) = t_new(i,k,j)/pi_phy(i,k,j)
+
+    ! ... Drops
+	  KRR = 0
+	  DO kr = p_ff1i01,p_ff1i33
+		 KRR = KRR+1
+		 chem_new(I,K,J,KR) = FF1R(KRR)
+	  END DO
+	  ! ... CCN
+	  KRR = 0
+	  DO kr=p_ff8i01,p_ff8i43
+		  KRR=KRR+1
+		  chem_new(I,K,J,KR)=FCCN(KRR)
+	  END DO
+	  IF (ICEPROCS == 1)THEN
+	  ! ... Snow
+		  KRR = 0
+		  DO kr=p_ff5i01,p_ff5i33
+			  KRR=KRR+1
+			  chem_new(I,K,J,KR)=FF3R(KRR)
+		  END DO
+     ! ... Hail/ Graupel
+      if(hail_opt == 1)then
+       KRR = 0
+       DO KR=p_ff6i01,p_ff6i33
+           KRR=KRR+1
+           chem_new(I,K,J,KR) = FF5R(KRR)
+       END DO
+      else
+       KRR = 0
+       DO KR=p_ff6i01,p_ff6i33
+           KRR=KRR+1
+           chem_new(I,K,J,KR) = FF4R(KRR)
+       END DO
+      endif
+      ! ICEPROCS == 1
+ 		   END IF
 
+       END DO
+      END DO
+     END DO
+
+! +-----------------------------+
+! Hydrometeor Sedimentation
+! +-----------------------------+
+       do j = jts,jte
+       	do i = its,ite
+ ! ... Drops ...
+ 			    do k = kts,kte
+            rhocgs_z(k)=rhocgs(i,k,j)
+            pcgs_z(k)=pcgs(i,k,j)
+            zcgs_z(k)=zcgs(i,k,j)
+            vrx(k,:)=vr1_z(:,k)
+            krr=0
+            do kr=p_ff1i01,p_ff1i33
+              krr=krr+1
+              ffx_z(k,krr)=chem_new(i,k,j,kr)/rhocgs(i,k,j)
+            end do
+          end do
+          call FALFLUXHUCM_Z(ffx_z,VRX,RHOCGS_z,PCGS_z,ZCGS_z,DT,kts,kte,nkr)
+          do k = kts,kte
+            krr=0
+            do kr=p_ff1i01,p_ff1i33
+              krr=krr+1
+              chem_new(i,k,j,kr)=ffx_z(k,krr)*rhocgs(i,k,j)
+            end do
+          end do
+       		if(iceprocs == 1)then
+ ! ... Snow ...
+          do k = kts,kte
+            rhocgs_z(k)=rhocgs(i,k,j)
+            pcgs_z(k)=pcgs(i,k,j)
+            zcgs_z(k)=zcgs(i,k,j)
+            vrx(k,:)=vr3_z3D(:,i,k,j)
+            krr=0
+            do kr=p_ff5i01,p_ff5i33
+              krr=krr+1
+              ffx_z(k,krr)=chem_new(i,k,j,kr)/rhocgs(i,k,j)
+            end do
+          end do
+          call FALFLUXHUCM_Z(ffx_z,VRX,RHOCGS_z,PCGS_z,ZCGS_z,DT,kts,kte,nkr)
+          do k = kts,kte
+            krr=0
+            do kr=p_ff5i01,p_ff5i33
+              krr=krr+1
+              chem_new(i,k,j,kr)=ffx_z(k,krr)*rhocgs(i,k,j)
+            end do
+          end do
+ ! ... Hail or Graupel ...
+          do k = kts,kte
+            rhocgs_z(k)=rhocgs(i,k,j)
+            pcgs_z(k)=pcgs(i,k,j)
+            zcgs_z(k)=zcgs(i,k,j)
+            if(hail_opt == 1)then
+              vrx(k,:) = vr5_z3D(:,i,k,j)
+            else
+              vrx(k,:) = vr4_z3D(:,i,k,j)
+            endif
+            krr=0
+            do kr=p_ff6i01,p_ff6i33
+              krr=krr+1
+              ffx_z(k,krr)=chem_new(i,k,j,kr)/rhocgs(i,k,j)
+            end do
+          end do
+          call FALFLUXHUCM_Z(ffx_z,VRX,RHOCGS_z,PCGS_z,ZCGS_z,DT,kts,kte,nkr)
+          do k = kts,kte
+            krr=0
+            do kr=p_ff6i01,p_ff6i33
+              krr=krr+1
+              chem_new(i,k,j,kr)=ffx_z(k,krr)*rhocgs(i,k,j)
+            end do
+          end do
+ 			end if ! if (iceprocs == 1)
+   	end do
+   end do
+
+    gmax=0
+    qmax=0
+    imax=0
+    kmax=0
+    qnmax=0
+    inmax=0
+    knmax=0
+    DO j = jts,jte
+      DO k = kts,kte
+        DO i = its,ite
+          QC(I,K,J) = 0.0
+          QR(I,K,J) = 0.0
+          QI(I,K,J) = 0.0
+          QS(I,K,J) = 0.0
+          QG(I,K,J) = 0.0
+          QNC(I,K,J) = 0.0
+          QNR(I,K,J) = 0.0
+          QNI(I,K,J) = 0.0
+          QNS(I,K,J) = 0.0
+          QNG(I,K,J) = 0.0
+          QNA(I,K,J) = 0.0
+
+          tt= th_phy(i,k,j)*pi_phy(i,k,j)
+
+          ! ... Drop output
+          KRR = 0
+          DO KR = p_ff1i01,p_ff1i33
+            KRR=KRR+1
+            IF (KRR < KRDROP)THEN
+              QC(I,K,J) = QC(I,K,J) &
+              + (1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XL(KRR)*XL(KRR)*3
+              QNC(I,K,J) = QNC(I,K,J) &
+              + COL*chem_new(I,K,J,KR)*XL(KRR)*3.0/rhocgs(I,K,J)*1000.0 ! #/kg
+            ELSE
+              QR(I,K,J) = QR(I,K,J) &
+              + (1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XL(KRR)*XL(KRR)*3.0
+              QNR(I,K,J) = QNR(I,K,J) &
+              + COL*chem_new(I,K,J,KR)*XL(KRR)*3/rhocgs(I,K,J)*1000.0 ! #/kg
+            END IF
+          END DO
 
+ 			  KRR=0
+ 			  IF (ICEPROCS == 1)THEN
+ 			  ! ... Snow output
+ 			   	KRR=0
+ 			   	DO  KR=p_ff5i01,p_ff5i33
+ 					KRR=KRR+1
+ 					 if (KRR <= KRICE)THEN
+ 						 QI(I,K,J) = QI(I,K,J) &
+ 					                 +(1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XS(KRR)*XS(KRR)*3
+ 						 QNI(I,K,J) = QNI(I,K,J) &
+         				  			  + COL*chem_new(I,K,J,KR)*XS(KRR)*3/rhocgs(I,K,J)*1000. ! #/kg
+ 					 else
+ 						 QS(I,K,J) = QS(I,K,J) &
+ 									+ (1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XS(KRR)*XS(KRR)*3
+ 						 QNS(I,K,J) = QNS(I,K,J) &
+ 								 	+ COL*chem_new(I,K,J,KR)*XS(KRR)*3/rhocgs(I,K,J)*1000. ! #/kg
+ 					endif
+ 			   END DO
+
+ 			   ! ... Hail / Graupel output
+          KRR=0
+          DO  KR=p_ff6i01,p_ff6i33
+            KRR=KRR+1
+            ! ... Hail or Graupel
+            if(hail_opt == 1)then
+              QG(I,K,J)=QG(I,K,J) &
+              +(1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XH(KRR)*XH(KRR)*3
+              QNG(I,K,J)=QNG(I,K,J) &
+              +COL*chem_new(I,K,J,KR)*XH(KRR)*3/rhocgs(I,K,J)*1000. ! #/kg
+            else
+              QG(I,K,J)=QG(I,K,J) &
+              +(1./RHOCGS(I,K,J))*COL*chem_new(I,K,J,KR)*XG(KRR)*XG(KRR)*3
+              QNG(I,K,J)=QNG(I,K,J) &
+              +COL*chem_new(I,K,J,KR)*XG(KRR)*3/rhocgs(I,K,J)*1000. ! #/kg
+            endif
+          END DO
+   		END IF !IF (ICEPROCS.EQ.1)THEN
 
-! HAIL (ONLY ICE: CONDENSATION) 
+      KRR = 0
+      DO  KR = p_ff8i01,p_ff8i43
+      	KRR = KRR + 1
+      	QNA(I,K,J) = QNA(I,K,J) &
+      			   	+ COL*chem_new(I,K,J,KR)/rhocgs(I,K,J)*1000.   ! #/kg
+      END DO
 
-	        IF(ISYM5.NE.0) THEN
+ 		END DO
+   END DO
+  END DO
 
-! HAIL DTRIBUTION FUNCTION (ONLY ICE: CONDENSATION) 
-                                                         
-! CALL JERDFUN HAIL - 1 (ONLY ICE: CONDENSATION) 
-	          CALL JERDFUN(R5,B51_MY,B52_MY &
-     &                        ,FI5,PSI5,D2N &
-     &                        ,1,5,COL,NKR,TPN)
-! IN CASE : ISYM5.NE.0
+ 998   format(' ',10(f10.1,1x))
 
-	        ENDIF
+  DO j = jts,jte
+    DO i = its,ite
+      RAINNCV(I,J) = 0.0
+      SNOWNCV(I,J) = 0.0
+      GRAUPELNCV(I,J) = 0.0
+      krr=0
+      DO KR=p_ff1i01,p_ff1i33
+        krr=krr+1
+        DELTAW = VR1_Z(KRR,1)
+        RAINNC(I,J) = RAINNC(I,J) &
+          +10.0*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+          chem_new(I,1,J,KR)*XL(KRR)*XL(KRR)
+        RAINNCV(I,J) = RAINNCV(I,J) &
+          +10.0*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+          chem_new(I,1,J,KR)*XL(KRR)*XL(KRR)
+      END DO
+      KRR=0
+      DO KR=p_ff5i01,p_ff5i33
+        KRR=KRR+1
+        DELTAW = VR3_Z(KRR,1)
+        RAINNC(I,J)=RAINNC(I,J) &
+          +10.0*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+          chem_new(I,1,J,KR)*XS(KRR)*XS(KRR)
+        RAINNCV(I,J)=RAINNCV(I,J) &
+          +10.0*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+          chem_new(I,1,J,KR)*XS(KRR)*XS(KRR)
+        SNOWNC(I,J) = SNOWNC(I,J) &
+        + 10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+        chem_new(I,1,J,KR)*XS(KRR)*XS(KRR)
+       SNOWNCV(I,J) = SNOWNCV(I,J) &
+       + 10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+       chem_new(I,1,J,KR)*XS(KRR)*XS(KRR)
+     END DO
+     KRR=0
+     DO KR=p_ff6i01,p_ff6i33
+       KRR=KRR+1
+       if(hail_opt == 1)then
+         DELTAW = VR5_Z(KRR,1)
+         RAINNC(I,J) = RAINNC(I,J) &
+         +10.0*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+         chem_new(I,1,J,KR)*XH(KRR)*XH(KRR)
+       RAINNCV(I,J) = RAINNCV(I,J) &
+         +10.0*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+         chem_new(I,1,J,KR)*XH(KRR)*XH(KRR)
+       GRAUPELNC(I,J) = GRAUPELNC(I,J) &
+       + 10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+       chem_new(I,1,J,KR)*XH(KRR)*XH(KRR)
+     GRAUPELNCV(I,J) = GRAUPELNCV(I,J) &
+     + 10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+     chem_new(I,1,J,KR)*XH(KRR)*XH(KRR)
+   else
+     DELTAW = VR4_Z(KRR,1)
+     RAINNC(I,J) = RAINNC(I,J) &
+      +10.0*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+      chem_new(I,1,J,KR)*XG(KRR)*XG(KRR)
+    RAINNCV(I,J) = RAINNCV(I,J) &
+      +10.0*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+      chem_new(I,1,J,KR)*XG(KRR)*XG(KRR)
+    GRAUPELNC(I,J) = GRAUPELNC(I,J) &
+      + 10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+      chem_new(I,1,J,KR)*XG(KRR)*XG(KRR)
+    GRAUPELNCV(I,J) = GRAUPELNCV(I,J) &
+      + 10*(3./RO1BL(KRR))*COL*DT*DELTAW* &
+      chem_new(I,1,J,KR)*XG(KRR)*XG(KRR)
+  endif
+  END DO
+! ..........................................
+! ... Polarimetric Forward Radar Operator
+! ..........................................
+  if ( PRESENT (diagflag) ) then
+    if( diagflag .and. IPolar_HUCM ) then
+
+      dx_dbl = dx
+      dy_dbl = dy
+      do k = kts,kte
+      zmks_1d(k) = zcgs(i,k,j)*0.01
+      end do
+      DIST_SING = ((i-ide/2)**2+(j-jde/2)**2)**(0.5)
+      DISTANCE = 1.D5
 
-	        IF((DEL2.GT.0.AND.DEL2N.LT.0) &
-     &         .AND.ABS(DEL2N).GT.EPSDEL) THEN
-               call wrf_error_fatal("fatal error in module_mp_fast_sbm (DEL2.GT.0.AND.DEL2N.LT.0), model stop")
-                ENDIF
+      do k=kts,kte
+        FF2R_d = 0.0 	 	! [KS] >> No IC or liquid fraction in the FAST version
+        FLIQFR_SD = 0.0
+        FLIQFR_GD = 0.0
+        FLIQFR_HD = 0.0
+        FF1_FD = 0.0
+        FL1_FD = 0.0
+        BKDEN_Snow(:) = RO3BL(:)
+        RO2BL_D(:,:) = RO2BL(:,:)
+        RO2BL_D(:,:) = RO2BL(:,:)
+
+! ... Drops
+        KRR=0
+        do kr = p_ff1i01,p_ff1i33     ! [KS] >> erased the COL factor ; Here DSDs input to Polar_HUCM is in units [g/g/dln(r)]
+          KRR=KRR+1
+          FF1R_D(KRR) = (1./RHOCGS(I,K,J))*chem_new(I,K,J,KR)*XL(KRR)*XL(KRR)*3
+          if (FF1R_D(KRR) < 1.0D-20) FF1R_D(KRR) = 0.0
+        end do
+        if (ICEPROCS == 1)then
+! ... SNOW
+          KRR=0
+          do kr=p_ff5i01,p_ff5i33
+            KRR=KRR+1
+            FF3R_D(KRR)=(1./RHOCGS(I,K,J))*chem_new(I,K,J,KR)*XS(KRR)*XS(KRR)*3
+            FF3R (KRR) = chem_new(I,K,J,KR)
+            if (ff3r_D(krr) < 1.0D-20) ff3r_D(krr) = 0.0
+          end do
+! ... Graupel or Hail
+          KRR=0
+          if(hail_opt == 0)then
+            do kr = p_ff6i01,p_ff6i33
+              KRR=KRR+1
+              FF4R_D(KRR) = (1./RHOCGS(I,K,J))*chem_new(I,K,J,KR)*XG(KRR)*XG(KRR)*3
+              FF4R(KRR) = chem_new(I,K,J,KR)
+              if (FF4R_D(KRR) < 1.0D-20) FF4R_D(KRR)= 0.0
+              FF5R_d(KRR) = 0.0
+            end do
+          else
+            do kr=p_ff6i01,p_ff6i33
+              KRR=KRR+1
+              FF5R_D(KRR)=(1./RHOCGS(I,K,J))*chem_new(I,K,J,KR)*XH(KRR)*XH(KRR)*3
+              FF5R(KRR)=chem_new(I,K,J,KR)
+              if (ff5r_d(krr) < 1.0D-20) ff5r_d(krr)=0.0
+              FF4R_d(KRR) = 0.0
+            end do
+          endif
+        ! in caseICEPROCS.EQ.1
+        end if
 
-	      ELSE
+        rhocgs_d = rhocgs(I,K,J)
+        T_NEW_D = T_NEW(I,K,J)
+
+        IWL = 1
+        ICLOUD = 0
+
+ 			  CALL polar_hucm &
+                 				(FF1R_D, FF2R_D, FF3R_D, FF4R_D, FF5R_D, FF1_FD, 		    &
+                 				FLIQFR_SD, FLIQFR_GD, FLIQFR_HD, FL1_FD, 				        &
+                 				BKDEN_Snow, T_NEW_D, rhocgs_D, wavelength, iwl,         &
+                 				distance, dx_dbl, dy_dbl, zmks_1d, 					            &
+                 				out1, out2, out3, out4, out5, out6, out7, out8, out9,   &
+                 				bin_mass, tab_colum, tab_dendr, tab_snow, bin_log, 		  &
+                 				ijk, i, j, k, kts, kte, NKR, ICEMAX, icloud, itimestep, &
+                 				faf1,fbf1,fab1,fbb1, 									    &
+                 				faf3,fbf3,fab3,fbb3,         							&
+                 				faf4,fbf4,fab4,fbb4,         							&
+                 				faf5,fbf5,fab5,fbb5,         							&
+                 				temps_water,temps_fd,temps_crystals,  	  &
+                 				temps_snow,temps_graupel,temps_hail,  		&
+                 				fws_fd,fws_crystals,fws_snow,		  				&
+                 				fws_graupel,fws_hail,usetables)
+
+
+   			KRR=0
+   			DO KR=r_p_ff1i01,r_p_ff1i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR) = out1(KRR)
+   			END DO
+   			KRR=0
+   			DO KR=r_p_ff2i01,r_p_ff2i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR)=out2(KRR)
+   			END DO
+   			KRR=0
+   			DO KR=r_p_ff3i01,r_p_ff3i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR)=out3(KRR)
+   			END DO
+   			KRR=0
+   			DO KR=r_p_ff4i01,r_p_ff4i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR)=out4(KRR)
+   			END DO
+   			KRR=0
+   			DO KR=r_p_ff5i01,r_p_ff5i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR)=out5(KRR)
+   			END DO
+   			KRR=0
+   			DO KR=r_p_ff6i01,r_p_ff6i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR)=out6(KRR)
+   			END DO
+   			KRR=0
+   			DO KR=r_p_ff7i01,r_p_ff7i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR)=out7(KRR)
+   			END DO
+   			KRR=0
+   			DO KR=r_p_ff8i01,r_p_ff8i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR)=out8(KRR)
+   			END DO
+   			KRR=0
+   			DO KR=r_p_ff9i01,r_p_ff9i06
+   				KRR=KRR+1
+   				sbmradar(I,K,J,KR)=out9(KRR)
+   			END DO
+
+ 		 ! cycle by K
+ 		 end do
+ 		! diagflag .and. IPolar_HUCM
+ 		endif
+ 	! PRESENT(diagflag)
+ 	endif
+
+   ! cycle by I
+   END DO
+ ! cycle by J
+ END DO
+
+   do j=jts,jte
+   do k=kts,kte
+   do i=its,ite
+      th_old(i,k,j)=th_phy(i,k,j)
+      qv_old(i,k,j)=qv(i,k,j)
+   end do
+   end do
+   end do
+
+   if (conserv)then
+ 		  DO j = jts,jte
+ 		     DO i = its,ite
+ 		        DO k = kts,kte
+         		  rhocgs(I,K,J)=rho_phy(I,K,J)*0.001
+         		  krr=0
+         		  DO KR=p_ff1i01,p_ff1i33
+         			    krr=krr+1
+         		       chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*COL*XL(KRR)*XL(KRR)*3.0
+         		        if (qc(i,k,j)+qr(i,k,j).lt.1.e-13)chem_new(I,K,J,KR)=0.
+         		  END DO
+         		  KRR=0
+         		  DO KR=p_ff5i01,p_ff5i33
+         		   KRR=KRR+1
+         		   chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*COL*XS(KRR)*XS(KRR)*3.0
+         		   if (qs(i,k,j).lt.1.e-13)chem_new(I,K,J,KR)=0.
+         		  END DO
+         		  ! ... CCN
+         		  KRR=0
+         		  DO KR=p_ff8i01,p_ff8i43
+         		   KRR=KRR+1
+         		   chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*1000.0
+         		  END DO
+              ! ... Hail / Graupel
+              if(hail_opt == 1)then
+                 KRR=0
+                 DO KR=p_ff6i01,p_ff6i33
+                     KRR=KRR+1
+                     chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*COL*XH(KRR)*XH(KRR)*3.0
+                     if (qg(i,k,j) < 1.e-13) chem_new(I,K,J,KR) = 0.0
+                 END DO
+               else
+                 KRR=0
+                 DO KR=p_ff6i01,p_ff6i33
+                     KRR=KRR+1
+                     chem_new(I,K,J,KR)=chem_new(I,K,J,KR)/RHOCGS(I,K,J)*COL*XG(KRR)*XG(KRR)*3.0
+                     if (qg(i,k,j) < 1.e-13) chem_new(I,K,J,KR) = 0.0
+                 END DO
+               endif
 
-! IN CASE KCOND.NE.21 
+ 		          END DO
+ 		         END DO
+ 		        END DO
+       END IF
 
-! ONLY ICE: EVAPORATION  
+   RETURN
+   END SUBROUTINE FAST_SBM
+ ! +-------------------------------------------------------------+
+   SUBROUTINE FALFLUXHUCM_Z(chem_new,VR1,RHOCGS,PCGS,ZCGS,DT, &
+   						               kts,kte,nkr)
+
+     IMPLICIT NONE
+
+ 	   integer,intent(in) :: kts,kte,nkr
+ 	   real(kind=r4size),intent(inout) :: chem_new(:,:)
+ 	   real(kind=r4size),intent(in) :: rhocgs(:),pcgs(:),zcgs(:),VR1(:,:),DT
+
+ 	  ! ... Locals
+ 	  integer :: I,J,K,KR
+    real(kind=r4size) :: TFALL,DTFALL,VFALL(KTE),DWFLUX(KTE)
+    integer :: IFALL,N,NSUB
+
+ ! FALLING FLUXES FOR EACH KIND OF CLOUD PARTICLES: C.G.S. UNIT
+ ! ADAPTED FROM GSFC CODE FOR HUCM
+ !  The flux at k=1 is assumed to be the ground so FLUX(1) is the
+ ! flux into the ground. DWFLUX(1) is at the lowest half level where
+ ! Q(1) etc are defined. The formula for FLUX(1) uses Q(1) etc which
+ ! is actually half a grid level above it. This is what is meant by
+ ! an upstream method. Upstream in this case is above because the
+ ! velocity is downwards.
+ ! USE UPSTREAM METHOD (VFALL IS POSITIVE)
+
+       DO KR=1,NKR
+        IFALL=0
+        DO k = kts,kte
+           IF(chem_new(K,KR).GE.1.E-20)IFALL=1
+        END DO
+        IF (IFALL.EQ.1)THEN
+         TFALL=1.E10
+         DO K=kts,kte
+          ! [KS] VFALL(K) = VR1(K,KR)*SQRT(1.E6/PCGS(K))
+ 		       VFALL(K) = VR1(K,KR) ! ... [KS] : The pressure effect is taken into account at the beggining of the calculations
+           TFALL=AMIN1(TFALL,ZCGS(K)/(VFALL(K)+1.E-20))
+         END DO
+         IF(TFALL.GE.1.E10)STOP
+         NSUB=(INT(2.0*DT/TFALL)+1)
+         DTFALL=DT/NSUB
+
+         DO N=1,NSUB
+           DO K=KTS,KTE-1
+             DWFLUX(K)=-(RHOCGS(K)*VFALL(K)*chem_new(k,kr)- &
+             RHOCGS(K+1)* &
+             VFALL(K+1)*chem_new(K+1,KR))/(RHOCGS(K)*(ZCGS(K+1)- &
+             ZCGS(K)))
+           END DO
+ ! NO Z ABOVE TOP, SO USE THE SAME DELTAZ
+           DWFLUX(KTE)=-(RHOCGS(KTE)*VFALL(KTE)* &
+      &                 chem_new(kte,kr))/(RHOCGS(KTE)*(ZCGS(KTE)-ZCGS(KTE-1)))
+           DO K=kts,kte
+            chem_new(k,kr)=chem_new(k,kr)+DWFLUX(K)*DTFALL
+           END DO
+         END DO
+        END IF
+       END DO
 
-! NEW TREATMENT OF TIME STEP (ONLY ICE: EVAPORATION) 
+       RETURN
+       END SUBROUTINE FALFLUXHUCM_Z
+ ! +----------------------------------+
+   SUBROUTINE FAST_HUCMINIT(DT)
+
+    USE module_mp_SBM_BreakUp,ONLY:Spontanous_Init
+ 	  USE module_mp_SBM_Collision,ONLY:courant_bott_KS
+ 	  USE module_domain
+ 	  USE module_dm
+
+ 	  IMPLICIT NONE
+
+    real(kind=r4size),intent(in) :: DT
+
+    LOGICAL , EXTERNAL      :: wrf_dm_on_monitor
+    LOGICAL :: opened
+    CHARACTER*80 errmess
+    integer :: I,J,KR,IType,HUJISBM_UNIT1
+    real(kind=r4size) :: dlnr,ax,deg01,CONCCCNIN,CONTCCNIN
+
+ 	  character(len=256),parameter :: dir_43 = "SBM_input_43", dir_33 = "SBM_input_33"
+ 	  character(len=256) :: input_dir,Fname
+
+ 	 if(nkr == 33) input_dir = trim(dir_33)
+ 	 if(nkr == 43) input_dir = trim(dir_43)
+
+     call wrf_message(" FAST SBM: INITIALIZING WRF_HUJISBM ")
+     call wrf_message(" FAST SBM: ****** WRF_HUJISBM ******* ")
+
+ ! LookUpTable #1
+ ! +-------------------------------------------------------+
+ 	if (.NOT. ALLOCATED(bin_mass)) ALLOCATE(bin_mass(nkr))
+ 	if (.NOT. ALLOCATED(tab_colum)) ALLOCATE(tab_colum(nkr))
+ 	if (.NOT. ALLOCATED(tab_dendr)) ALLOCATE(tab_dendr(nkr))
+ 	if (.NOT. ALLOCATED(tab_snow)) ALLOCATE(tab_snow(nkr))
+ 	if (.NOT. ALLOCATED(bin_log)) ALLOCATE(bin_log(nkr))
+
+ 	dlnr=dlog(2.d0)/(3.d0)
+
+ 	hujisbm_unit1 = -1
+ 	IF ( wrf_dm_on_monitor() ) THEN
+ 		DO i = 20,99
+ 			INQUIRE ( i , OPENED = opened )
+ 			IF ( .NOT. opened ) THEN
+ 				hujisbm_unit1 = i
+ 				GOTO 2060
+ 			ENDIF
+ 		ENDDO
+ 	2060  CONTINUE
+ 	ENDIF
+
+ 	#if defined(DM_PARALLEL)
+ 		CALL wrf_dm_bcast_bytes( hujisbm_unit1 , IWORDSIZE )
+ 	#endif
+ 	IF ( hujisbm_unit1 < 0 ) THEN
+     	CALL wrf_error_fatal ( 'module_mp_FAST-SBM: Table-1 -- FAST_SBM_INIT: '// 			&
+ 							              'Can not find unused fortran unit to read in lookup table, model stop' )
+ 	ENDIF
+
+ 	IF ( wrf_dm_on_monitor() ) THEN
+ 			WRITE(errmess, '(A,I2)') 'module_mp_FAST-SBM : Table-1 -- opening "BLKD_SDC.dat" on unit',hujisbm_unit1
+ 			CALL wrf_debug(150, errmess)
+ 			OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/BLKD_SDC.dat",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 			DO kr=1,NKR
+ 				READ(hujisbm_unit1,*) bin_mass(kr),tab_colum(kr),tab_dendr(kr), &
+ 									            tab_snow(kr)
+ 				bin_log(kr) = log10(bin_mass(kr))
+ 			ENDDO
+ 	ENDIF
+
+#define DM_BCAST_MACRO_R4(A) CALL wrf_dm_bcast_bytes(A, size(A)*R4SIZE)
+#define DM_BCAST_MACRO_R8(A) CALL wrf_dm_bcast_bytes(A, size(A)*R8SIZE)
+#define DM_BCAST_MACRO_R16(A) CALL wrf_dm_bcast_bytes(A, size(A)*R16SIZE)
+
+#if defined(DM_PARALLEL)
+    DM_BCAST_MACRO_R8(bin_mass)
+ 	  DM_BCAST_MACRO_R8(tab_colum)
+ 	  DM_BCAST_MACRO_R8(tab_dendr)
+ 	  DM_BCAST_MACRO_R8(tab_snow)
+ 	  DM_BCAST_MACRO_R8(bin_log)
+#endif
+
+     WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-1'
+     print*,errmess
+     CALL wrf_debug(000, errmess)
+ ! +-----------------------------------------------------------------------+
+
+ ! LookUpTable #2
+ ! +----------------------------------------------+
+     if (.NOT. ALLOCATED(RLEC)) ALLOCATE(RLEC(nkr))
+     if (.NOT. ALLOCATED(RIEC)) ALLOCATE(RIEC(nkr,icemax))
+     if (.NOT. ALLOCATED(RSEC)) ALLOCATE(RSEC(nkr))
+     if (.NOT. ALLOCATED(RGEC)) ALLOCATE(RGEC(nkr))
+     if (.NOT. ALLOCATED(RHEC)) ALLOCATE(RHEC(nkr))
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+         DO i = 31,99
+             INQUIRE ( i , OPENED = opened )
+             IF ( .NOT. opened ) THEN
+                 hujisbm_unit1 = i
+                 GOTO 2061
+             ENDIF
+         ENDDO
+     2061  CONTINUE
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+ 	CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
+ #endif
+     IF ( hujisbm_unit1 < 0 ) THEN
+         CALL wrf_error_fatal ( 'module_mp_FAST-SBM: Table-2 -- FAST_SBM_INIT: '// 			&
+                               'Can not find unused fortran unit to read in lookup table,model stop' )
+     ENDIF
+
+ IF ( wrf_dm_on_monitor() ) THEN
+ 	WRITE(errmess, '(A,I2)') 'module_mp_FAST-SBM : Table-2 -- opening capacity.asc on unit',hujisbm_unit1
+ 	CALL wrf_debug(150, errmess)
+ 	OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/capacity33.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/capacity43.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	900	FORMAT(6E13.5)
+ 	READ(hujisbm_unit1,900) RLEC,RIEC,RSEC,RGEC,RHEC
+ END IF
+
+ #if defined(DM_PARALLEL)
+     DM_BCAST_MACRO_R4(RLEC)
+     DM_BCAST_MACRO_R4(RIEC)
+     DM_BCAST_MACRO_R4(RSEC)
+     DM_BCAST_MACRO_R4(RGEC)
+     DM_BCAST_MACRO_R4(RHEC)
+ #endif
+
+     WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-2'
+     print*,errmess
+     CALL wrf_debug(000, errmess)
+ ! +----------------------------------------------------------------------+
+
+ ! LookUpTable #3
+ ! +-----------------------------------------------+
+     if (.NOT. ALLOCATED(XL)) ALLOCATE(XL(nkr))
+     if (.NOT. ALLOCATED(XI)) ALLOCATE(XI(nkr,icemax))
+     if (.NOT. ALLOCATED(XS)) ALLOCATE(XS(nkr))
+     if (.NOT. ALLOCATED(XG)) ALLOCATE(XG(nkr))
+     if (.NOT. ALLOCATED(XH)) ALLOCATE(XH(nkr))
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+       DO i = 31,99
+         INQUIRE ( i , OPENED = opened )
+         IF ( .NOT. opened ) THEN
+           hujisbm_unit1 = i
+           GOTO 2062
+         ENDIF
+       ENDDO
+     2062 CONTINUE
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+     CALL wrf_dm_bcast_bytes ( hujisbm_unit1, IWORDSIZE )
+ #endif
+
+     IF ( hujisbm_unit1 < 0 ) THEN
+         CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-3 -- FAST_SBM_INIT: '// 		&
+                              'Can not find unused fortran unit to read in lookup table,model stop' )
+     ENDIF
+     IF ( wrf_dm_on_monitor() ) THEN
+         WRITE(errmess, '(A,I2)') 'module_mp_FAST_SBM : Table-3 -- opening masses.asc on unit ',hujisbm_unit1
+         CALL wrf_debug(150, errmess)
+         OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/masses33.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         !OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/masses43.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         READ(hujisbm_unit1,900) XL,XI,XS,XG,XH
+         CLOSE(hujisbm_unit1)
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+   	DM_BCAST_MACRO_R4(XL)
+     DM_BCAST_MACRO_R4(XI)
+     DM_BCAST_MACRO_R4(XS)
+     DM_BCAST_MACRO_R4(XG)
+     DM_BCAST_MACRO_R4(XH)
+ #endif
+
+      WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-3'
+      print*,errmess
+      CALL wrf_debug(000, errmess)
+ ! +-------------------------------------------------------------------------+
+
+ ! LookUpTable #4
+ ! TERMINAL VELOSITY :
+ ! +---------------------------------------------------+
+     if (.NOT. ALLOCATED(VR1)) ALLOCATE(VR1(nkr))
+     if (.NOT. ALLOCATED(VR2)) ALLOCATE(VR2(nkr,icemax))
+     if (.NOT. ALLOCATED(VR3)) ALLOCATE(VR3(nkr))
+     if (.NOT. ALLOCATED(VR4)) ALLOCATE(VR4(nkr))
+     if (.NOT. ALLOCATED(VR5)) ALLOCATE(VR5(nkr))
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+       DO i = 31,99
+         INQUIRE ( i , OPENED = opened )
+         IF ( .NOT. opened ) THEN
+           hujisbm_unit1 = i
+           GOTO 2063
+         ENDIF
+       ENDDO
+     2063   CONTINUE
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+     CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
+ #endif
+     IF ( hujisbm_unit1 < 0 ) THEN
+         CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-4 -- FAST_SBM_INIT: '// 										&
+                                 'Can not find unused fortran unit to read in lookup table,model stop' )
+     ENDIF
+
+     IF ( wrf_dm_on_monitor() ) THEN
+         WRITE(errmess, '(A,I2)') 'module_mp_FAST_SBM : Table-4 -- opening termvels.asc on unit ',hujisbm_unit1
+         CALL wrf_debug(150, errmess)
+         OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/termvels33_corrected.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         !OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/termvels43_corrected.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         READ(hujisbm_unit1,900) VR1,VR2,VR3,VR4,VR5
+        CLOSE(hujisbm_unit1)
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+ 	DM_BCAST_MACRO_R4(VR1)
+     DM_BCAST_MACRO_R4(VR2)
+     DM_BCAST_MACRO_R4(VR3)
+     DM_BCAST_MACRO_R4(VR4)
+     DM_BCAST_MACRO_R4(VR5)
+ #endif
+     WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-4'
+     CALL wrf_debug(000, errmess)
+ ! +----------------------------------------------------------------------+
+
+
+ ! LookUpTable #5
+ ! CONSTANTS :
+ ! +---------------------------------------------------+
+     if (.NOT. ALLOCATED(SLIC)) ALLOCATE(SLIC(nkr,6))
+     if (.NOT. ALLOCATED(TLIC)) ALLOCATE(TLIC(nkr,2))
+     if (.NOT. ALLOCATED(COEFIN)) ALLOCATE(COEFIN(nkr))
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+       DO i = 31,99
+         INQUIRE ( i , OPENED = opened )
+         IF ( .NOT. opened ) THEN
+           hujisbm_unit1 = i
+           GOTO 2065
+         ENDIF
+       ENDDO
+       hujisbm_unit1 = -1
+     2065     CONTINUE
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+ 		CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
+ #endif
+
+     IF ( hujisbm_unit1 < 0 ) THEN
+         CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-5 -- FAST_SBM_INIT: '// 										&
+                                'Can not find unused fortran unit to read in lookup table,model stop' )
+     ENDIF
+
+     IF ( wrf_dm_on_monitor() ) THEN
+         WRITE(errmess, '(A,I2)') 'module_mp_FAST_SBM : Table-5 -- opening constants.asc on unit  ',hujisbm_unit1
+         CALL wrf_debug(150, errmess)
+         OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/constants33.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         !OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/constants43.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         READ(hujisbm_unit1,900) SLIC,TLIC,COEFIN
+      CLOSE(hujisbm_unit1)
+     END IF
+
+ #if defined(DM_PARALLEL)
+ 	  DM_BCAST_MACRO_R4(SLIC)
+    DM_BCAST_MACRO_R4(TLIC)
+    DM_BCAST_MACRO_R4(COEFIN)
+ #endif
+     WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-5'
+     CALL wrf_debug(000, errmess)
+ ! +----------------------------------------------------------------------+
+
+ ! LookUpTable #6
+ ! KERNELS DEPENDING ON PRESSURE :
+ ! +------------------------------------------------------------------+
+     if (.NOT. ALLOCATED(YWLL_1000MB)) ALLOCATE(YWLL_1000MB(nkr,nkr))
+     if (.NOT. ALLOCATED(YWLL_750MB)) ALLOCATE(YWLL_750MB(nkr,nkr))
+     if (.NOT. ALLOCATED(YWLL_500MB)) ALLOCATE(YWLL_500MB(nkr,nkr))
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+       DO i = 31,99
+         INQUIRE ( i , OPENED = opened )
+         IF ( .NOT. opened ) THEN
+           hujisbm_unit1 = i
+           GOTO 2066
+         ENDIF
+       ENDDO
+       hujisbm_unit1 = -1
+     2066     CONTINUE
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+ 		CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
+ #endif
+     IF ( hujisbm_unit1 < 0 ) THEN
+         CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-6 -- FAST_SBM_INIT: '// 			&
+                                 'Can not find unused fortran unit to read in lookup table,model stop' )
+     ENDIF
+     IF ( wrf_dm_on_monitor() ) THEN
+         WRITE(errmess, '(A,I2)') 'module_mp_FAST_SBM : Table-6 -- opening kernels_z.asc on unit  ',hujisbm_unit1
+         CALL wrf_debug(150, errmess)
+         Fname = trim(input_dir)//'/kernLL_z33.asc'
+         !Fname = trim(input_dir)//'/kernLL_z43.asc'
+         OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         READ(hujisbm_unit1,900) YWLL_1000MB,YWLL_750MB,YWLL_500MB
+         CLOSE(hujisbm_unit1)
+     END IF
+
+   	DO I=1,NKR
+   		DO J=1,NKR
+   			IF(I > 33 .OR. J > 33) THEN
+   				YWLL_1000MB(I,J) = 0.0
+   				YWLL_750MB(I,J) =  0.0
+   				YWLL_500MB(I,J) =  0.0
+   			ENDIF
+   		ENDDO
+   	ENDDO
+
+ #if defined(DM_PARALLEL)
+ 	DM_BCAST_MACRO_R4(YWLL_1000MB)
+     DM_BCAST_MACRO_R4(YWLL_750MB)
+     DM_BCAST_MACRO_R4(YWLL_500MB)
+ #endif
+
+     WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-6'
+     CALL wrf_debug(000, errmess)
+ ! +-----------------------------------------------------------------------+
+
+ ! LookUpTable #7
+ ! COLLISIONS KERNELS :
+ ! +-----------------------------------------------------------------------+
+ ! ... Drops - IC
+ if (.NOT. ALLOCATED(YWLI_300MB)) ALLOCATE(YWLI_300MB(nkr,nkr,icemax))
+ if (.NOT. ALLOCATED(YWLI_500MB)) ALLOCATE(YWLI_500MB(nkr,nkr,icemax))
+ if (.NOT. ALLOCATED(YWLI_750MB)) ALLOCATE(YWLI_750MB(nkr,nkr,icemax))
+
+ ! ... Drops - Graupel
+ if (.NOT. ALLOCATED(YWLG_300MB)) ALLOCATE(YWLG_300MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWLG_500MB)) ALLOCATE(YWLG_500MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWLG_750MB)) ALLOCATE(YWLG_750MB(nkr,nkr))
+ !if (.NOT. ALLOCATED(YWLG)) ALLOCATE(YWLG(nkr,nkr))
+
+ ! ... Drops - Hail
+ if (.NOT. ALLOCATED(YWLH_300MB)) ALLOCATE(YWLH_300MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWLH_500MB)) ALLOCATE(YWLH_500MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWLH_750MB)) ALLOCATE(YWLH_750MB(nkr,nkr))
+
+ ! ... Drops - Snow
+ if (.NOT. ALLOCATED(YWLS_300MB)) ALLOCATE(YWLS_300MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWLS_500MB)) ALLOCATE(YWLS_500MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWLS_750MB)) ALLOCATE(YWLS_750MB(nkr,nkr))
+
+ ! ... IC - IC
+ if (.NOT. ALLOCATED(YWII_300MB)) ALLOCATE(YWII_300MB(nkr,nkr,icemax,icemax))
+ if (.NOT. ALLOCATED(YWII_500MB)) ALLOCATE(YWII_500MB(nkr,nkr,icemax,icemax))
+ if (.NOT. ALLOCATED(YWII_750MB)) ALLOCATE(YWII_750MB(nkr,nkr,icemax,icemax))
+
+ ! ... IC - SNow
+ if (.NOT. ALLOCATED(YWIS_300MB)) ALLOCATE(YWIS_300MB(nkr,nkr,icemax))
+ if (.NOT. ALLOCATED(YWIS_500MB)) ALLOCATE(YWIS_500MB(nkr,nkr,icemax))
+ if (.NOT. ALLOCATED(YWIS_750MB)) ALLOCATE(YWIS_750MB(nkr,nkr,icemax))
+
+ ! ... Snow - Graupel
+ if (.NOT. ALLOCATED(YWSG_300MB)) ALLOCATE(YWSG_300MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWSG_500MB)) ALLOCATE(YWSG_500MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWSG_750MB)) ALLOCATE(YWSG_750MB(nkr,nkr))
+
+ ! ... Snow - SNow
+ if (.NOT. ALLOCATED(YWSS_300MB)) ALLOCATE(YWSS_300MB(nkr,nkr))
+ if (.NOT. ALLOCATED(YWSS_500MB)) ALLOCATE(YWSS_500MB(nkr,nkR))
+ if (.NOT. ALLOCATED(YWSS_750MB)) ALLOCATE(YWSS_750MB(nkr,nkr))
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+     DO i = 31,99
+     INQUIRE ( i , OPENED = opened )
+     IF ( .NOT. opened ) THEN
+       hujisbm_unit1 = i
+       GOTO 2067
+     ENDIF
+     ENDDO
+     2067     CONTINUE
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+     CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
+ #endif
+ IF ( hujisbm_unit1 < 0 ) THEN
+ 	CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-7 -- FAST_SBM_INIT: '// 			&
+ 											'Can not find unused fortran unit to read in lookup table,model stop' )
+ ENDIF
+ ! ... KERNELS DEPENDING ON PRESSURE :
+ IF ( wrf_dm_on_monitor() ) THEN
+ 	WRITE(errmess, '(A,I2)') 'module_mp_WRFsbm : Table-7 -- opening kernels33.asc on unit',hujisbm_unit1
+ 	CALL wrf_debug(150, errmess)
+
+ 	! ... Drop - IC
+ 	!Fname = trim(input_dir)//'/ckli_300mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLI_300MB
+ 	!Fname = trim(input_dir)//'/ckli_500mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLI_500MB
+ 	!Fname = trim(input_dir)//'/ckli_750mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLI_750MB
+
+ 	Fname = trim(input_dir)//'/ckli_33_300mb_500mb_750mb.asc'
+ 	OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	READ(hujisbm_unit1,900) YWLI_300MB,YWLI_500MB,YWLI_750MB
+ 	CLOSE(hujisbm_unit1)
+
+ 	! ... Drop - Graupel
+ 	!Fname = trim(input_dir)//'/cklg_300mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLG_300MB
+ 	!Fname = trim(input_dir)//'/cklg_500mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLG_500MB
+ 	!Fname = trim(input_dir)//'/cklg_750mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLG_750MB
+
+ 	Fname = trim(input_dir)//'/cklg_33_300mb_500mb_750mb.asc'
+ 	OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	READ(hujisbm_unit1,900) YWLG_300MB,YWLG_500MB,YWLG_750MB
+ 	CLOSE(hujisbm_unit1)
+
+ 	! ... Drop - Hail
+ 	!Fname = trim(input_dir)//'/cklh_300mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLH_300MB
+ 	!Fname = trim(input_dir)//'/cklh_500mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLH_500MB
+ 	!Fname = trim(input_dir)//'/cklh_750mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLH_750MB
+
+ 	Fname = trim(input_dir)//'/cklh_33_300mb_500mb_750mb.asc'
+ 	OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	READ(hujisbm_unit1,900) YWLH_300MB,YWLH_500MB,YWLH_750MB
+ 	CLOSE(hujisbm_unit1)
+
+ 	! ... Drop - Snow
+ 	!Fname = trim(input_dir)//'/ckls_300mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLS_300MB
+ 	!Fname = trim(input_dir)//'/ckls_500mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLS_500MB
+ 	!Fname = trim(input_dir)//'/ckls_750mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWLS_750MB
+
+ 	Fname = trim(input_dir)//'/ckls_33_300mb_500mb_750mb.asc'
+ 	OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	READ(hujisbm_unit1,900) YWLS_300MB,YWLS_500MB,YWLS_750MB
+ 	CLOSE(hujisbm_unit1)
+
+ 	! ... IC - IC
+  !Fname = trim(input_dir)//'/ckii_300mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWII_300MB
+ 	!Fname = trim(input_dir)//'/ckii_500mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWII_500MB
+ 	!Fname = trim(input_dir)//'/ckii_750mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWII_750MB
+ 	!CLOSE(hujisbm_unit1)
+
+ 	Fname = trim(input_dir)//'/ckii_33_300mb_500mb_750mb.asc'
+ 	OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	READ(hujisbm_unit1,900) YWII_300MB,YWII_500MB,YWII_750MB
+ 	CLOSE(hujisbm_unit1)
+
+ 	! ... IC - SNow
+ 	!Fname = trim(input_dir)//'/ckis_300mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWIS_300MB
+ 	!Fname = trim(input_dir)//'/ckis_500mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWIS_500MB
+ 	!Fname = trim(input_dir)//'/ckis_750mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWIS_750MB
+
+ 	Fname = trim(input_dir)//'/ckis_33_300mb_500mb_750mb.asc'
+ 	OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	READ(hujisbm_unit1,900) YWIS_300MB,YWIS_500MB,YWIS_750MB
+ 	CLOSE(hujisbm_unit1)
+
+ 	! ... Snow - Graupel
+ 	!Fname = trim(input_dir)//'/cksg_300mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWSG_300MB
+ 	!Fname = trim(input_dir)//'/cksg_500mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWSG_500MB
+ 	!Fname = trim(input_dir)//'/cksg_750mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWSG_750MB
+
+ 	Fname = trim(input_dir)//'/cksg_33_300mb_500mb_750mb.asc'
+ 	OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	READ(hujisbm_unit1,900) YWSG_300MB,YWSG_500MB,YWSG_750MB
+ 	CLOSE(hujisbm_unit1)
+
+ 	! ... Snow - Snow
+ 	!Fname = trim(input_dir)//'/ckss_300mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWSS_300MB
+ 	!Fname = trim(input_dir)//'/ckss_500mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWSS_500MB
+ 	!Fname = trim(input_dir)//'/ckss_750mb_As'
+ 	!OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	!READ(hujisbm_unit1,900) YWSS_750MB
+
+ 	Fname = trim(input_dir)//'/ckss_33_300mb_500mb_750mb.asc'
+ 	OPEN(UNIT=hujisbm_unit1,FILE=Fname,FORM="FORMATTED",STATUS="OLD",ERR=2070)
+ 	READ(hujisbm_unit1,900) YWSS_300MB,YWSS_500MB,YWSS_750MB
+  CLOSE(hujisbm_unit1)
+ END IF
+
+ #if defined(DM_PARALLEL)
+	   DM_BCAST_MACRO_R4(YWLI_300MB)
+     DM_BCAST_MACRO_R4(YWLI_500MB)
+     DM_BCAST_MACRO_R4(YWLI_750MB)
+
+     DM_BCAST_MACRO_R4(YWLG_300MB)
+     DM_BCAST_MACRO_R4(YWLG_500MB)
+     DM_BCAST_MACRO_R4(YWLG_750MB)
+     !DM_BCAST_MACRO(YWLG)
+
+     DM_BCAST_MACRO_R4(YWLH_300MB)
+     DM_BCAST_MACRO_R4(YWLH_500MB)
+     DM_BCAST_MACRO_R4(YWLH_750MB)
+
+     DM_BCAST_MACRO_R4(YWLS_300MB)
+     DM_BCAST_MACRO_R4(YWLS_500MB)
+     DM_BCAST_MACRO_R4(YWLS_750MB)
+
+     DM_BCAST_MACRO_R4(YWII_300MB)
+     DM_BCAST_MACRO_R4(YWII_500MB)
+     DM_BCAST_MACRO_R4(YWII_750MB)
+
+     DM_BCAST_MACRO_R4(YWIS_300MB)
+     DM_BCAST_MACRO_R4(YWIS_500MB)
+     DM_BCAST_MACRO_R4(YWIS_750MB)
+
+     DM_BCAST_MACRO_R4(YWSG_300MB)
+     DM_BCAST_MACRO_R4(YWSG_500MB)
+     DM_BCAST_MACRO_R4(YWSG_750MB)
+
+     DM_BCAST_MACRO_R4(YWSS_300MB)
+     DM_BCAST_MACRO_R4(YWSS_500MB)
+     DM_BCAST_MACRO_R4(YWSS_750MB)
+ #endif
+
+     WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-7'
+     CALL wrf_debug(000, errmess)
+ ! +-----------------------------------------------------------------------+
+
+ ! LookUpTable #8
+ ! BULKDENSITY:
+ ! +--------------------------------------------------------------+
+     if (.NOT. ALLOCATED(RO1BL)) ALLOCATE(RO1BL(nkr))
+     if (.NOT. ALLOCATED(RO2BL)) ALLOCATE(RO2BL(nkr,icemax))
+     if (.NOT. ALLOCATED(RO3BL)) ALLOCATE(RO3BL(nkr))
+     if (.NOT. ALLOCATED(RO4BL)) ALLOCATE(RO4BL(nkr))
+     if (.NOT. ALLOCATED(RO5BL)) ALLOCATE(RO5BL(nkr))
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+       DO i = 31,99
+         INQUIRE ( i , OPENED = opened )
+         IF ( .NOT. opened ) THEN
+           hujisbm_unit1 = i
+           GOTO 2068
+         ENDIF
+       ENDDO
+     2068     CONTINUE
+     ENDIF
+
+ #if defined(DM_PARALLEL)
+     CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
+ #endif
+     IF ( hujisbm_unit1 < 0 ) THEN
+         CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-8 -- FAST_SBM_INIT: '// 			&
+                                 'Can not find unused fortran unit to read in lookup table,model stop' )
+     ENDIF
+     IF ( wrf_dm_on_monitor() ) THEN
+         WRITE(errmess, '(A,I2)') 'module_mp_WRFsbm : Table-8 -- opening bulkdens.asc on unit ',hujisbm_unit1
+         CALL wrf_debug(150, errmess)
+         OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/bulkdens33.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         !OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/bulkdens43.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         READ(hujisbm_unit1,900) RO1BL,RO2BL,RO3BL,RO4BL,RO5BL
+         CLOSE(hujisbm_unit1)
+     END IF
+
+ #if defined(DM_PARALLEL)
+ 	    DM_BCAST_MACRO_R4(RO1BL)
+      DM_BCAST_MACRO_R4(RO2BL)
+      DM_BCAST_MACRO_R4(RO3BL)
+      DM_BCAST_MACRO_R4(RO4BL)
+      DM_BCAST_MACRO_R4(RO5BL)
+ #endif
+     WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-8'
+     CALL wrf_debug(000, errmess)
+ ! +----------------------------------------------------------------------+
+
+ ! LookUpTable #9
+ ! BULKRADII:
+ ! +-----------------------------------------------------------+
+     if (.NOT. ALLOCATED(RADXXO)) ALLOCATE(RADXXO(nkr,nhydro))
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+       DO i = 31,99
+         INQUIRE ( i , OPENED = opened )
+         IF ( .NOT. opened ) THEN
+           hujisbm_unit1 = i
+           GOTO 2069
+         ENDIF
+       ENDDO
+     2069     CONTINUE
+     ENDIF
+ #if defined(DM_PARALLEL)
+ 		CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
+ #endif
+     IF ( hujisbm_unit1 < 0 ) THEN
+      CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-9 -- FAST_SBM_INIT: '// 			&
+                                 'Can not find unused fortran unit to read in lookup table,model stop' )
+     ENDIF
+     IF ( wrf_dm_on_monitor() ) THEN
+         WRITE(errmess, '(A,I2)') 'module_mp_FAST_SBM : Table-9 -- opening bulkradii.asc on unit',hujisbm_unit1
+         CALL wrf_debug(150, errmess)
+         OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/bulkradii33.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         !OPEN(UNIT=hujisbm_unit1,FILE=trim(input_dir)//"/bulkradii43.asc",FORM="FORMATTED",STATUS="OLD",ERR=2070)
+         READ(hujisbm_unit1,*) RADXXO
+         CLOSE(hujisbm_unit1)
+     END IF
+
+ #if defined(DM_PARALLEL)
+       DM_BCAST_MACRO_R4(RADXXO)
+ #endif
+     WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-9'
+     CALL wrf_debug(000, errmess)
+ ! +-----------------------------------------------------------------------+
+
+ ! LookUpTable #10
+ ! Polar-HUCM Scattering Amplitudes Look-up table :
+ ! +-----------------------------------------------------------------------+
+  CALL LOAD_TABLES(NKR)  ! (KS) - Loading the scattering look-up-table
+
+ ! ... (KS) - Broadcating Liquid drops
+ #if defined(DM_PARALLEL)
+   	DM_BCAST_MACRO_R16 ( FAF1 )
+   	DM_BCAST_MACRO_R16 ( FBF1 )
+   	DM_BCAST_MACRO_R16 ( FAB1 )
+   	DM_BCAST_MACRO_R16 ( FBB1 )
+   ! ... (KS) - Broadcating Snow
+   	DM_BCAST_MACRO_R16 ( FAF3 )
+   	DM_BCAST_MACRO_R16 ( FBF3 )
+   	DM_BCAST_MACRO_R16 ( FAB3 )
+   	DM_BCAST_MACRO_R16 ( FBB3 )
+   ! ... (KS) - Broadcating Graupel
+   	DM_BCAST_MACRO_R16 ( FAF4 )
+   	DM_BCAST_MACRO_R16 ( FBF4 )
+   	DM_BCAST_MACRO_R16 ( FAB4 )
+   	DM_BCAST_MACRO_R16 ( FBB4 )
+   ! ### (KS) - Broadcating Hail
+   	DM_BCAST_MACRO_R16 ( FAF5 )
+   	DM_BCAST_MACRO_R16 ( FBF5 )
+   	DM_BCAST_MACRO_R16 ( FAB5 )
+   	DM_BCAST_MACRO_R16 ( FBB5 )
+ ! ### (KS) - Broadcating Temperature intervals
+   	CALL wrf_dm_bcast_integer ( temps_water , size ( temps_water ) )
+   	CALL wrf_dm_bcast_integer ( temps_fd , size ( temps_fd ) )
+   	CALL wrf_dm_bcast_integer ( temps_crystals , size ( temps_crystals ) )
+   	CALL wrf_dm_bcast_integer ( temps_snow , size ( temps_snow ) )
+   	CALL wrf_dm_bcast_integer ( temps_graupel , size ( temps_graupel ) )
+   	CALL wrf_dm_bcast_integer ( temps_hail , size ( temps_hail ) )
+ ! ### (KS) - Broadcating Liquid fraction intervals
+   	DM_BCAST_MACRO_R4 ( fws_fd )
+   	DM_BCAST_MACRO_R4 ( fws_crystals )
+   	DM_BCAST_MACRO_R4 ( fws_snow )
+   	DM_BCAST_MACRO_R4 ( fws_graupel )
+   	DM_BCAST_MACRO_R4 ( fws_hail )
+ ! ### (KS) - Broadcating Usetables array
+ 	  CALL wrf_dm_bcast_integer ( usetables , size ( usetables ) * IWORDSIZE )
+ #endif
+  WRITE(errmess, '(A,I2)') 'module_mp_WRFsbm : succesfull reading Table-10'
+  call wrf_message(errmess)
+ ! +-----------------------------------------------------------------------+
+
+ ! calculation of the mass(in mg) for categories boundaries :
+   ax=2.d0**(1.0)
+
+   do i=1,nkr
+   	 xl_mg(i) = xl(i)*1.e3
+      xs_mg(i) = xs(i)*1.e3
+      xg_mg(i) = xg(i)*1.e3
+      xh_mg(i) = xh(i)*1.e3
+      xi1_mg(i) = xi(i,1)*1.e3
+      xi2_mg(i) = xi(i,2)*1.e3
+      xi3_mg(i) = xi(i,3)*1.e3
+   enddo
+
+   if (.NOT. ALLOCATED(IMA)) ALLOCATE(IMA(nkr,nkr))
+   if (.NOT. ALLOCATED(CHUCM)) ALLOCATE(CHUCM(nkr,nkr))
+   chucm  = 0.0d0
+   ima = 0
+   CALL courant_bott_KS(xl, nkr, chucm, ima, scal) ! ### (KS) : New courant_bott_KS (without XL_MG(0:nkr))
+   WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading "courant_bott_KS" '
+   CALL wrf_debug(000, errmess)
+
+  DEG01=1./3.
+  CONCCCNIN=0.
+  CONTCCNIN=0.
+  if (.NOT. ALLOCATED(DROPRADII)) ALLOCATE(DROPRADII(NKR))
+  DO KR=1,NKR
+  DROPRADII(KR)=(3.0*XL(KR)/4.0/3.141593/1.0)**DEG01
+  ENDDO
+
+ ! +-------------------------------------------------------------+
+ ! Allocating Aerosols Array
+ ! +-------------------------+
+ if (.NOT. ALLOCATED(FCCNR_MAR)) ALLOCATE(FCCNR_MAR(NKR_aerosol))
+ if (.NOT. ALLOCATED(FCCNR_CON)) ALLOCATE(FCCNR_CON(NKR_aerosol))
+ if (.NOT. ALLOCATED(XCCN)) ALLOCATE(XCCN(NKR_aerosol))
+ if (.NOT. ALLOCATED(RCCN)) ALLOCATE(RCCN(NKR_aerosol))
+ if (.NOT. ALLOCATED(Scale_CCN_Factor)) ALLOCATE(Scale_CCN_Factor)
+ if (.NOT. ALLOCATED(FCCN)) ALLOCATE(FCCN(NKR_aerosol))
+
+ 	IF(ILogNormal_modes_Aerosol == 1)THEN
+ 		! ... Initializing the FCCNR_MAR and FCCNR_CON
+ 		FCCNR_CON = 0.0
+ 		FCCNR_MAR = 0.0
+ 		Scale_CCN_Factor = 1.0
+ 		XCCN = 0.0
+ 		RCCN = 0.0
+ 		CALL LogNormal_modes_Aerosol(FCCNR_CON,FCCNR_MAR,NKR_aerosol,COL,XL,XCCN,RCCN,RO_SOLUTE,Scale_CCN_Factor,1)
+ 		CALL LogNormal_modes_Aerosol(FCCNR_CON,FCCNR_MAR,NKR_aerosol,COL,XL,XCCN,RCCN,RO_SOLUTE,Scale_CCN_Factor,2)
+ 		WRITE(errmess, '(A,I2)') 'module_mp_WRFsbm : succesfull reading "LogNormal_modes_Aerosol" '
+ 		CALL wrf_debug(000, errmess)
+ 	ENDIF
+ ! +-------------------------------------------------------------+
+
+ 	 if (.NOT. ALLOCATED(PKIJ)) ALLOCATE(PKIJ(JBREAK,JBREAK,JBREAK))
+ 	 if (.NOT. ALLOCATED(QKJ)) ALLOCATE(QKJ(JBREAK,JBREAK))
+ 	 if (.NOT. ALLOCATED(ECOALMASSM)) ALLOCATE(ECOALMASSM(NKR,NKR))
+ 	 if (.NOT. ALLOCATED(BRKWEIGHT)) ALLOCATE(BRKWEIGHT(JBREAK))
+    PKIJ = 0.0e0
+    QKJ = 0.0e0
+    ECOALMASSM = 0.0d0
+    BRKWEIGHT = 0.0d0
+ 	 CALL BREAKINIT_KS(PKIJ,QKJ,ECOALMASSM,BRKWEIGHT,XL,DROPRADII,BR_MAX,JBREAK,JMAX,NKR,VR1) ! Rain Spontanous Breakup
+ #if defined(DM_PARALLEL)
+ 	 	DM_BCAST_MACRO_R4 (PKIJ)
+    DM_BCAST_MACRO_R4 (QKJ)
+ #endif
+ 	  WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading BREAKINIT_KS" '
+    CALL wrf_debug(000, errmess)
+  ! +--------------------------------------------------------------------------------------------------------------------+
+
+   100	FORMAT(10I4)
+   101   FORMAT(3X,F7.5,E13.5)
+   102	FORMAT(4E12.4)
+   105	FORMAT(A48)
+   106	FORMAT(A80)
+   123	FORMAT(3E12.4,3I4)
+   200	FORMAT(6E13.5)
+   201   FORMAT(6D13.5)
+   300	FORMAT(8E14.6)
+   301   FORMAT(3X,F8.3,3X,E13.5)
+   302   FORMAT(5E13.5)
+
+ if (.NOT. ALLOCATED(cwll)) ALLOCATE(cwll(nkr,nkr))
+
+ if (.NOT. ALLOCATED(cwli_1)) ALLOCATE(cwli_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwli_2)) ALLOCATE(cwli_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwli_3)) ALLOCATE(cwli_3(nkr,nkr))
+
+ if (.NOT. ALLOCATED(cwil_1)) ALLOCATE(cwil_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwil_2)) ALLOCATE(cwil_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwil_3)) ALLOCATE(cwil_3(nkr,nkr))
+
+ if (.NOT. ALLOCATED(cwlg)) ALLOCATE(cwlg(nkr,nkr))
+ if (.NOT. ALLOCATED(cwlh)) ALLOCATE(cwlh(nkr,nkr))
+ if (.NOT. ALLOCATED(cwls)) ALLOCATE(cwls(nkr,nkr))
+ if (.NOT. ALLOCATED(cwgl)) ALLOCATE(cwgl(nkr,nkr))
+ if (.NOT. ALLOCATED(cwhl)) ALLOCATE(cwhl(nkr,nkr))
+ if (.NOT. ALLOCATED(cwsl)) ALLOCATE(cwsl(nkr,nkr))
+
+ if (.NOT. ALLOCATED(cwii_1_1)) ALLOCATE(cwii_1_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwii_1_2)) ALLOCATE(cwii_1_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwii_1_3)) ALLOCATE(cwii_1_3(nkr,nkr))
+ if (.NOT. ALLOCATED(cwii_2_1)) ALLOCATE(cwii_2_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwii_2_2)) ALLOCATE(cwii_2_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwii_2_3)) ALLOCATE(cwii_2_3(nkr,nkr))
+ if (.NOT. ALLOCATED(cwii_3_1)) ALLOCATE(cwii_3_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwii_3_2)) ALLOCATE(cwii_3_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwii_3_3)) ALLOCATE(cwii_3_3(nkr,nkr))
+
+ if (.NOT. ALLOCATED(cwis_1)) ALLOCATE(cwis_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwis_2)) ALLOCATE(cwis_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwis_3)) ALLOCATE(cwis_3(nkr,nkr))
+ if (.NOT. ALLOCATED(cwsi_1)) ALLOCATE(cwsi_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwsi_2)) ALLOCATE(cwsi_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwsi_3)) ALLOCATE(cwsi_3(nkr,nkr))
+
+ if (.NOT. ALLOCATED(cwig_1)) ALLOCATE(cwig_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwig_2)) ALLOCATE(cwig_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwig_3)) ALLOCATE(cwig_3(nkr,nkr))
+
+ if (.NOT. ALLOCATED(cwih_1)) ALLOCATE(cwih_1(nkr,nkr))
+ if (.NOT. ALLOCATED(cwih_2)) ALLOCATE(cwih_2(nkr,nkr))
+ if (.NOT. ALLOCATED(cwih_3)) ALLOCATE(cwih_3(nkr,nkr))
+
+ if (.NOT. ALLOCATED(cwsg)) ALLOCATE(cwsg(nkr,nkr))
+ if (.NOT. ALLOCATED(cwss)) ALLOCATE(cwss(nkr,nkr))
+
+   cwll(:,:) = 0.0e0
+   cwli_1(:,:) = 0.0e0 ; cwli_2(:,:) = 0.0e0 ; cwli_3(:,:) = 0.0e0
+   cwil_1(:,:) = 0.0e0 ; cwil_2(:,:) = 0.0e0 ; cwil_3(:,:) = 0.0e0
+   cwlg(:,:) = 0.0e0 ; cwlh(:,:) = 0.0e0 ; cwls(:,:) = 0.0e0
+   cwgl(:,:) = 0.0e0 ; cwhl(:,:) = 0.0e0 ; cwsl(:,:) = 0.0e0
+   cwii_1_1(:,:) = 0.0e0 ; cwii_1_2(:,:) = 0.0e0 ; cwii_1_3(:,:) = 0.0e0
+   cwii_2_1(:,:) = 0.0e0 ; cwii_2_2(:,:) = 0.0e0 ; cwii_2_3(:,:) = 0.0e0
+   cwii_3_1(:,:) = 0.0e0 ; cwii_3_2(:,:) = 0.0e0 ; cwii_3_3(:,:) = 0.0e0
+   cwis_1(:,:) = 0.0e0 ; cwis_2(:,:) = 0.0e0 ; cwis_3(:,:) = 0.0e0
+   cwsi_1(:,:) = 0.0e0 ; cwsi_2(:,:) = 0.0e0 ; cwsi_3(:,:) = 0.0e0
+   cwig_1(:,:) = 0.0e0 ; cwig_2(:,:) = 0.0e0 ; cwig_3(:,:) = 0.0e0
+   cwih_1(:,:) = 0.0e0 ; cwih_2(:,:) = 0.0e0 ; cwih_3(:,:) = 0.0e0
+   cwsg(:,:) = 0.0e0 ; cwss(:,:) = 0.0e0
+
+   call Kernals_KS(dt,nkr,7.6E6)
+
+ !+---+-----------------------------------------+
+ if (.NOT. ALLOCATED( Prob)) ALLOCATE( Prob(NKR))
+ if (.NOT. ALLOCATED(Gain_Var_New)) ALLOCATE(Gain_Var_New(NKR,NKR))
+ if (.NOT. ALLOCATED(NND)) ALLOCATE(NND(NKR,NKR))
+  Prob = 0.0
+  Gain_Var_New = 0.0
+  NND = 0.0
+  call Spontanous_Init(dt, XL, DROPRADII, Prob, Gain_Var_New, NND, NKR, ikr_spon_break)
+  WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading "Spontanous_Init" '
+  CALL wrf_debug(000, errmess)
+
+  return
+  2070  continue
+
+      WRITE( errmess , '(A,I4)' )                                          &
+                 'module_mp_FAST_SBM_INIT: error opening hujisbm_DATA on unit,model stop ' &
+                 &, hujisbm_unit1
+      CALL wrf_error_fatal(errmess)
 
-	        DT0I=1.E20
-                IF (DEL2N.EQ.0)THEN
-	          DTNEWL=DT
+  END SUBROUTINE FAST_HUCMINIT
+ ! -----------------------------------------------------------------+
+  subroutine Kernals_KS(dtime_coal,nkr,p_z)
+
+  implicit none
+
+  integer :: nkr
+  real(kind=r4size),intent(in) :: dtime_coal,p_z
+
+  ! ### Locals
+  integer :: i,j
+  real(kind=r4size),parameter :: p1=1.0e6,p2=0.75e6,p3=0.50e6,p4=0.3e6
+  real(kind=r4size) :: dlnr, scal, dtimelnr, pdm, p_1, p_2, p_3, ckern_1, ckern_2, &
+  					  ckern_3
+
+ ! p1=1.00D6 dynes/cm^2 = 1000.0 mb
+ ! p2=0.75D6 dynes/cm^2 =  750.0 mb
+ ! p3=0.50D6 dynes/cm^2 =  500.0 mb
+ ! p4=0.30D6 dynes/cm^2 =  300.0 mb
+
+  scal = 1.0
+ 	dlnr = dlog(2.0d0)/(3.0d0*scal)
+ 	dtimelnr = dtime_coal*dlnr
+
+ 	p_1=p1
+ 	p_2=p2
+ 	p_3=p3
+ 	do i=1,nkr
+ 		do j=1,nkr
+ 			! 1. water - water
+ 			ckern_1 = YWLL_1000mb(i,j)
+ 			ckern_2 = YWLL_750mb(i,j)
+ 			ckern_3 = YWLL_500mb(i,j)
+ 			cwll(i,j) = ckern_z(p_z,p_1,p_2,p_3,ckern_1,ckern_2,ckern_3)*dtime_coal*dlnr
+ 		end do
+ 	end do
+
+ 	! ... ECOALMASSM is from "BreakIniit_KS"
+ 	DO I=1,NKR
+ 	 DO J=1,NKR
+ 		CWLL(I,J) = ECOALMASSM(I,J)*CWLL(I,J)
+ 	 END DO
+  END DO
+
+ 	p_1=p2
+ 	p_2=p3
+ 	p_3=p4
+
+ 	if(p_z >= p_1) then
+ 		do j=1,nkr
+ 	  		do i=1,nkr
+ 				cwli_1(i,j) = ywli_750mb(i,j,1)*dtimelnr
+ 				cwli_2(i,j) = ywli_750mb(i,j,2)*dtimelnr
+ 				cwli_3(i,j) = ywli_750mb(i,j,3)*dtimelnr
+ 				cwlg(i,j) = ywlg_750mb(i,j)*dtimelnr
+ 				cwlh(i,j) = ywlh_750mb(i,j)*dtimelnr
+ 				cwls(i,j) = ywls_750mb(i,j)*dtimelnr
+ 				cwii_1_1(i,j) = ywii_750mb(i,j,1,1)*dtimelnr
+ 				cwii_1_2(i,j) = ywii_750mb(i,j,1,2)*dtimelnr
+ 				cwii_1_3(i,j) = ywii_750mb(i,j,1,3)*dtimelnr
+ 				cwii_2_1(i,j) = ywii_750mb(i,j,2,1)*dtimelnr
+ 				cwii_2_2(i,j) = ywii_750mb(i,j,2,2)*dtimelnr
+ 				cwii_2_3(i,j) = ywii_750mb(i,j,2,3)*dtimelnr
+ 				cwii_3_1(i,j) = ywii_750mb(i,j,3,1)*dtimelnr
+ 				cwii_3_2(i,j) = ywii_750mb(i,j,3,2)*dtimelnr
+ 				cwii_3_3(i,j) = ywii_750mb(i,j,3,3)*dtimelnr
+ 				cwis_1(i,j) = ywis_750mb(i,j,1)*dtimelnr
+ 				cwis_2(i,j) = ywis_750mb(i,j,2)*dtimelnr
+ 				cwis_3(i,j) = ywis_750mb(i,j,3)*dtimelnr
+ 				cwsg(i,j) = ywsg_750mb(i,j)*dtimelnr
+ 				cwss(i,j) = ywss_750mb(i,j)*dtimelnr
+ 	  		end do
+ 		end do
+ 	endif
+
+ 	if (p_z <= p_3) then
+ 		do j=1,nkr
+ 		  do i=1,nkr
+ 			cwli_1(i,j) = ywli_300mb(i,j,1)*dtimelnr
+ 			cwli_2(i,j) = ywli_300mb(i,j,2)*dtimelnr
+ 			cwli_3(i,j) = ywli_300mb(i,j,3)*dtimelnr
+ 			cwlg(i,j) = ywlg_300mb(i,j)*dtimelnr
+ 			cwlh(i,j) = ywlh_300mb(i,j)*dtimelnr
+ 			cwls(i,j) = ywls_300mb(i,j)*dtimelnr
+ 			cwii_1_1(i,j) = ywii_300mb(i,j,1,1)*dtimelnr
+ 			cwii_1_2(i,j) = ywii_300mb(i,j,1,2)*dtimelnr
+ 			cwii_1_3(i,j) = ywii_300mb(i,j,1,3)*dtimelnr
+ 			cwii_2_1(i,j) = ywii_300mb(i,j,2,1)*dtimelnr
+ 			cwii_2_2(i,j) = ywii_300mb(i,j,2,2)*dtimelnr
+ 			cwii_2_3(i,j) = ywii_300mb(i,j,2,3)*dtimelnr
+ 			cwii_3_1(i,j) = ywii_300mb(i,j,3,1)*dtimelnr
+ 			cwii_3_2(i,j) = ywii_300mb(i,j,3,2)*dtimelnr
+ 			cwii_3_3(i,j) = ywii_300mb(i,j,3,3)*dtimelnr
+ 			cwis_1(i,j) = ywis_300mb(i,j,1)*dtimelnr
+ 			cwis_2(i,j) = ywis_300mb(i,j,2)*dtimelnr
+ 			cwis_3(i,j) = ywis_300mb(i,j,3)*dtimelnr
+ 			cwsg(i,j) = ywsg_300mb(i,j)*dtimelnr
+ 			cwss(i,j) = ywss_300mb(i,j)*dtimelnr
+ 		  end do
+ 		end do
+ 	  endif
+
+ 	  if (p_z <  p_1  .and. p_z >= p_2) then
+ 		pdm = (p_z-p_2)/(p_1-p_2)
+ 		do j=1,nkr
+ 		  do i=1,nkr
+ 		  	ckern_1=ywli_750mb(i,j,1)
+ 			ckern_2=ywli_500mb(i,j,1)
+ 			cwli_1(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywli_750mb(i,j,2)
+ 			ckern_2=ywli_500mb(i,j,2)
+ 			cwli_2(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywli_750mb(i,j,3)
+ 			ckern_2=ywli_500mb(i,j,3)
+ 			cwli_3(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywlg_750mb(i,j)
+ 			ckern_2=ywlg_500mb(i,j)
+ 			cwlg(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywlh_750mb(i,j)
+ 			ckern_2=ywlh_500mb(i,j)
+ 			cwlh(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywls_750mb(i,j)
+ 			ckern_2=ywls_500mb(i,j)
+ 			cwls(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywii_750mb(i,j,1,1)
+ 			ckern_2=ywii_500mb(i,j,1,1)
+ 			cwii_1_1(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywii_750mb(i,j,1,2)
+ 			ckern_2=ywii_500mb(i,j,1,2)
+ 			cwii_1_2(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywii_750mb(i,j,1,3)
+ 			ckern_2=ywii_500mb(i,j,1,3)
+ 			cwii_1_3(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywii_750mb(i,j,2,1)
+ 			ckern_2=ywii_500mb(i,j,2,1)
+ 			cwii_2_1(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+
+ 			ckern_1=ywii_750mb(i,j,2,2)
+ 			ckern_2=ywii_500mb(i,j,2,2)
+ 			cwii_2_2(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywii_750mb(i,j,2,3)
+ 			ckern_2=ywii_500mb(i,j,2,3)
+ 			cwii_2_3(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywii_750mb(i,j,3,1)
+ 			ckern_2=ywii_500mb(i,j,3,1)
+ 			cwii_3_1(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywii_750mb(i,j,3,2)
+ 			ckern_2=ywii_500mb(i,j,3,2)
+ 			cwii_3_2(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywii_750mb(i,j,3,3)
+ 			ckern_2=ywii_500mb(i,j,3,3)
+ 			cwii_3_3(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywis_750mb(i,j,1)
+ 			ckern_2=ywis_500mb(i,j,1)
+ 			cwis_1(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywis_750mb(i,j,2)
+ 			ckern_2=ywis_500mb(i,j,2)
+ 			cwis_2(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywis_750mb(i,j,3)
+ 			ckern_2=ywis_500mb(i,j,3)
+ 			cwis_3(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywsg_750mb(i,j)
+ 			ckern_2=ywsg_500mb(i,j)
+ 			cwsg(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+
+ 			ckern_1=ywss_750mb(i,j)
+ 			ckern_2=ywss_500mb(i,j)
+ 			cwss(i,j)=(ckern_2+(ckern_1-ckern_2)*pdm)*dtimelnr
+ 		   end do
+ 		 end do
+ 	   endif
+
+  		if (p_z <  p_2  .and. p_z >  p_3) then
+ 		   pdm = (p_z-p_3)/(p_2-p_3)
+ 		   do j=1,nkr
+ 		     do i=1,nkr
+
+ 			  ckern_2=ywli_500mb(i,j,1)
+ 			  ckern_3=ywli_300mb(i,j,1)
+ 			  cwli_1(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+ 			  ckern_2=ywli_500mb(i,j,2)
+ 			  ckern_3=ywli_300mb(i,j,2)
+ 			  cwli_2(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+ 			  ckern_2=ywli_500mb(i,j,3)
+ 			  ckern_3=ywli_300mb(i,j,3)
+ 			  cwli_3(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+ 			  ckern_2=ywlg_500mb(i,j)
+ 			  ckern_3=ywlg_300mb(i,j)
+ 			  cwlg(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywlh_500mb(i,j)
+   			ckern_3=ywlh_300mb(i,j)
+   			cwlh(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywls_500mb(i,j)
+   			ckern_3=ywls_300mb(i,j)
+   			cwls(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,1,1)
+   			ckern_3=ywii_300mb(i,j,1,1)
+   			cwii_1_1(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,1,2)
+   			ckern_3=ywii_300mb(i,j,1,2)
+   			cwii_1_2(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,1,3)
+   			ckern_3=ywii_300mb(i,j,1,3)
+   			cwii_1_3(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,2,1)
+   			ckern_3=ywii_300mb(i,j,2,1)
+   			cwii_2_1(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,2,2)
+   			ckern_3=ywii_300mb(i,j,2,2)
+   			cwii_2_2(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,2,3)
+   			ckern_3=ywii_300mb(i,j,2,3)
+   			cwii_2_3(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,3,1)
+   			ckern_3=ywii_300mb(i,j,3,1)
+   			cwii_3_1(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,3,2)
+   			ckern_3=ywii_300mb(i,j,3,2)
+   			cwii_3_2(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywii_500mb(i,j,3,3)
+   			ckern_3=ywii_300mb(i,j,3,3)
+   			cwii_3_3(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywis_500mb(i,j,1)
+   			ckern_3=ywis_300mb(i,j,1)
+   			cwis_1(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywis_500mb(i,j,2)
+   			ckern_3=ywis_300mb(i,j,2)
+   			cwis_2(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywis_500mb(i,j,3)
+   			ckern_3=ywis_300mb(i,j,3)
+   			cwis_3(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywsg_500mb(i,j)
+   			ckern_3=ywsg_300mb(i,j)
+   			cwsg(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+   			ckern_2=ywss_500mb(i,j)
+   			ckern_3=ywss_300mb(i,j)
+   			cwss(i,j)=(ckern_3+(ckern_2-ckern_3)*pdm)*dtimelnr
+
+ 		   end do
+ 		 end do
+   endif
+
+ 		do i=1,nkr
+ 		 do j=1,nkr
+ ! columns - water
+ 		  cwil_1(i,j)=cwli_1(j,i)
+ ! plates - water
+ 		  cwil_2(i,j)=cwli_2(j,i)
+ ! dendrites - water
+ 		  cwil_3(i,j)=cwli_3(j,i)
+ ! 3. graupel - water
+ 		  cwgl(i,j)=cwlg(j,i)
+ ! 4. hail - water
+ 		  cwhl(i,j)=cwlh(j,i)
+ ! 5. snow - water
+ 		  cwsl(i,j)=cwls(j,i)
+ ! 7.snow - crystals :
+ ! snow - columns
+ 		  cwsi_1(i,j)=cwis_1(j,i)
+ ! snow - plates
+ 		  cwsi_2(i,j)=cwis_2(j,i)
+ ! snow - dendrites
+ 		  cwsi_3(i,j)=cwis_3(j,i)
+ 		 end do
+ 	  end do
+
+
+  return
+  end subroutine Kernals_KS
+
+ ! ------------------------------------------------------------+
+  real function ckern_z (p_z,p_1,p_2,p_3,ckern_1,ckern_2,ckern_3)
+
+ 	implicit none
+
+ 	real(kind=r4size),intent(in) :: p_z,p_1,p_2,p_3,ckern_1, &
+ 									ckern_2,ckern_3
+
+ 	if(p_z>=p_1) ckern_z = ckern_1
+ 	!if(p_z==p_2) ckern_z=ckern_2
+ 	if(p_z<=p_3) ckern_z = ckern_3
+ 	if(p_z=p_2) ckern_z = ckern_2 + (ckern_1-ckern_2)*(p_z-p_2)/(p_1-p_2)
+ 	if(p_zp_3) ckern_z = ckern_3 + (ckern_2-ckern_3)*(p_z-p_3)/(p_2-p_3)
+
+  return
+  end function ckern_z
+ ! -------------------------------------------------------------+
+  SUBROUTINE FREEZ(FF1,XL,FF2,XI,FF3,XS,FF4,XG,FF5,XH, &
+      					   TIN,DT,RO,COL,AFREEZMY,BFREEZMY,    &
+			             BFREEZMAX,KRFREEZ,ICEMAX,NKR)
+
+ 	  IMPLICIT NONE
+
+ 	    INTEGER KR,ICE,ICE_TYPE
+      REAL COL,AFREEZMY,BFREEZMY,BFREEZMAX
+      INTEGER KRFREEZ,ICEMAX,NKR
+      REAL DT,RO,YKK,PF,PF_1,DEL_T,TT_DROP,ARG_1,YK2,DF1,BF,ARG_M, &
+      	   TT_DROP_AFTER_FREEZ,CFREEZ,SUM_ICE,TIN,TTIN,AF,FF_MAX,F1_MAX, &
+      	   F2_MAX,F3_MAX,F4_MAX,F5_MAX
+
+      REAL FF1(NKR),XL(NKR),FF2(NKR,ICEMAX) &
+           ,XI(NKR,ICEMAX),FF3(NKR),XS(NKR),FF4(NKR) &
+           ,XG(NKR),FF5(NKR),XH(NKR)
+
+ 	TTIN=TIN
+ 	DEL_T	=TTIN-273.15
+ 	ICE_TYPE=2
+ 	F1_MAX=0.
+ 	F2_MAX=0.
+ 	F3_MAX=0.
+ 	F4_MAX=0.
+ 	F5_MAX=0.
+ 	DO KR=1,NKR
+   	F1_MAX=AMAX1(F1_MAX,FF1(KR))
+   	F3_MAX=AMAX1(F3_MAX,FF3(KR))
+   	F4_MAX=AMAX1(F4_MAX,FF4(KR))
+   	F5_MAX=AMAX1(F5_MAX,FF5(KR))
+   	DO ICE=1,ICEMAX
+        	F2_MAX=AMAX1(F2_MAX,FF2(KR,ICE))
+    ENDDO
+ 	  FF_MAX=AMAX1(F2_MAX,F3_MAX,F4_MAX,F5_MAX)
+  ENDDO
+ !
+ !******************************* FREEZING ****************************
+ !
+        IF(DEL_T.LT.0.AND.F1_MAX.NE.0) THEN
+ 			      SUM_ICE=0.
+		        AF	= AFREEZMY
+	          CFREEZ	=(BFREEZMAX-BFREEZMY)/XL(NKR)
+ !
+ !***************************** MASS LOOP **************************
+ !
+          	DO  KR	=1,NKR
+ 	 			        ARG_M	=XL(KR)
+ 			          BF	=BFREEZMY+CFREEZ*ARG_M
+        		    PF_1	=AF*EXP(-BF*DEL_T)
+        		    PF	=ARG_M*PF_1
+ 			          YKK	=EXP(-PF*DT)
+        		    DF1	=FF1(KR)*(1.-YKK)
+ 			          YK2	=DF1
+        		    FF1(KR)=FF1(KR)*YKK
+ 			          IF(KR.LE.KRFREEZ)  THEN
+ 				           FF2(KR,ICE_TYPE)=FF2(KR,ICE_TYPE)+YK2
                 ELSE
-	         DTNEWI3=-R3(3)/(B31_MY(3)*DEL2N-B32_MY(3))
-	         DTNEWI4=-R4(3)/(B41_MY(3)*DEL2N-B42_MY(3))
-	         DTNEWI5=-R5(3)/(B51_MY(3)*DEL2N-B52_MY(3))
-! NEW ALGORITHM (NO TYPE OF ICE)
-	         DTNEWI2_1=-R2(3,1)/(B21_MY(1,1)*DEL2N-B22_MY(1,1))
-	         DTNEWI2_2=-R2(3,2)/(B21_MY(1,2)*DEL2N-B22_MY(1,2))
-	         DTNEWI2_3=-R2(3,3)/(B21_MY(1,3)*DEL2N-B22_MY(1,3))
-                 DTNEWI2=AMIN1(DTNEWI2_1,DTNEWI2_2,DTNEWI2_3)
-	         DTNEWI1=AMIN1(DTNEWI2,DTNEWI3,DTNEWI4 &
-     &                       ,DTNEWI5,DT0I,TIMEREV)
-	         DTNEWI1=AMIN1(DTNEWI2,DTNEWI4,DTNEWI5,DT0I,TIMEREV)
-	         DTNEWL=DTNEWI1
-	         IF(DTNEWL.LT.DTLREF) DTNEWL=AMIN1(DTLREF,TIMEREV)
-                END IF
-	        IF(ITIME.GE.NKR) THEN
-                call wrf_error_fatal("fatal error in module_mp_fast_sbm (ITIME.GE.NKR), model stop")
+				           FF5(KR)	=FF5(KR)+YK2
                 ENDIF
-	        TIMESTEPD(ITIME)=DTNEWL
+		            SUM_ICE=SUM_ICE+YK2*3.*XL(KR)*XL(KR)*COL
+ !
+ !************************ END OF "MASS LOOP" **************************
+ !
+ 	 		       ENDDO
+ !
+ !************************** NEW TEMPERATURE *************************
+ !
+	           ARG_1	=333.*SUM_ICE/RO
+       		   TT_DROP_AFTER_FREEZ=TTIN+ARG_1
+		         TIN	=TT_DROP_AFTER_FREEZ
+ !
+ !************************** END OF "FREEZING" ****************************
+ !
+ 		   ENDIF
+ !
+    	RETURN
+ 	END SUBROUTINE FREEZ
+ ! ----------------------------------------------------------------+
+  SUBROUTINE J_W_MELT(FF1,XL,FF2,XI,FF3,XS,FF4,XG,FF5,XH &
+                     ,TIN,DT,RO,COL,ICEMAX,NKR)
+
+ 	  IMPLICIT NONE
+
+ 	  integer,intent(in) :: NKR,ICEMAX
+ 	  real(kind=R4size),intent(in)    :: DT,COL,RO
+ 	  real(kind=R4size),intent(inout) :: FF1(:),XL(:),FF2(:,:),XI(:,:),FF3(:),XS(:),FF4(:),XG(:), &
+ 	  									                 FF5(:),XH(:),Tin
+
+ 	  !  ... Locals
+      integer :: KR,ICE,ICE_TYPE
+      real(kind=R4size) :: ARG_M,TT_DROP,ARG_1,TT_DROP_AFTER_FREEZ,DF1,DN,DN0, &
+       						         A,B,DTFREEZ,SUM_ICE,FF_MAX,F1_MAX,F2_MAX,F3_MAX,F4_MAX,F5_MAX, &
+		                       DEL_T,meltrate,gamma
+ 	  ! ... Locals
+
+    	gamma=4.4
+ 	   	DEL_T = TIN-273.15
+   		ICE_TYPE = 2
+   		F1_MAX=0.
+   		F2_MAX=0.
+   		F3_MAX=0.
+   		F4_MAX=0.
+   		F5_MAX=0.
+   		DO KR=1,NKR
+   			F1_MAX=AMAX1(F1_MAX,FF1(KR))
+   			F3_MAX=AMAX1(F3_MAX,FF3(KR))
+   			F4_MAX=AMAX1(F4_MAX,FF4(KR))
+   			F5_MAX=AMAX1(F5_MAX,FF5(KR))
+   			DO ICE=1,ICEMAX
+   				F2_MAX=AMAX1(F2_MAX,FF2(KR,ICE))
+   		  END DO
+ 				FF_MAX=AMAX1(F2_MAX,F3_MAX,F4_MAX,F5_MAX)
+       END DO
+ 				SUM_ICE=0.
+ 				IF(DEL_T.GE.0.AND.FF_MAX.NE.0) THEN
+   				DO KR = 1,NKR
+          		ARG_M = 0.0
+           		DO ICE = 1,ICEMAX
+        			   IF (ICE ==1) THEN
+              			IF (KR .le. 10) THEN
+                  			ARG_M = ARG_M+FF2(KR,ICE)
+		                    FF2(KR,ICE) = 0.0
+  			            ELSE IF (KR .gt. 10 .and. KR .lt. 18) THEN
+                  			meltrate = 0.5/50.
+                  			FF2(KR,ICE)=FF2(KR,ICE)-FF2(KR,ICE)*(meltrate*dt)
+                  			ARG_M=ARG_M+FF2(KR,ICE)*(meltrate*dt)
+              			ELSE
+                  			meltrate = 0.683/120.
+                  			FF2(KR,ICE)=FF2(KR,ICE)-FF2(KR,ICE)*(meltrate*dt)
+                  			ARG_M=ARG_M+FF2(KR,ICE)*(meltrate*dt)
+              			ENDIF
+            			ENDIF
+            			IF (ICE ==2 .or. ICE ==3) THEN
+               			  IF (kr .le. 12) THEN
+                       			FF2(KR,ICE)=0.
+                       			ARG_M = ARG_M+FF2(KR,ICE)
+             			    ELSE IF (kr .gt. 12 .and. kr .lt. 20) THEN
+                       			meltrate = 0.5/50.
+                       			FF2(KR,ICE)=FF2(KR,ICE)-FF2(KR,ICE)*(meltrate*dt)
+                       			ARG_M=ARG_M+FF2(KR,ICE)*(meltrate*dt)
+                			ELSE
+                        			meltrate = 0.683/120.
+                       			FF2(KR,ICE)=FF2(KR,ICE)-FF2(KR,ICE)*(meltrate*dt)
+                       			ARG_M=ARG_M+FF2(KR,ICE)*(meltrate*dt)
+                			ENDIF
+              			ENDIF
+           		END DO  ! Do ice
+  				         ! ... Snow
+                  IF (kr .le. 14) THEN
+                     ARG_M = ARG_M + FF3(KR)
+  		               FF3(KR) = 0.0
+                  ELSE IF (kr .gt. 14 .and. kr .lt. 22) THEN
+                     meltrate = 0.5/50.
+                     FF3(KR)=FF3(KR)-FF3(KR)*(meltrate*dt)
+                     ARG_M=ARG_M+FF3(KR)*(meltrate*dt)
+                  ELSE
+                     meltrate = 0.683/120.
+                     FF3(KR)=FF3(KR)-FF3(KR)*(meltrate*dt)
+                     ARG_M=ARG_M+FF3(KR)*(meltrate*dt)
+                  ENDIF
+  	             ! ... Graupel/Hail
+                  IF (kr .le. 13) then
+                      ARG_M = ARG_M+FF4(KR)+FF5(KR)
+  		                FF4(KR)=0.
+                      FF5(KR)=0.
+                  ELSE IF (kr .gt. 13 .and. kr .lt. 23) THEN
+                      meltrate = 0.5/50.
+                      FF4(KR)=FF4(KR)-FF4(KR)*(meltrate*dt)
+                      FF5(KR)=FF5(KR)-FF5(KR)*(meltrate*dt)
+                      ARG_M=ARG_M+(FF4(KR)+FF5(KR))*(meltrate*dt)
+                  ELSE
+                      meltrate = 0.683/120.
+                     FF4(KR)=FF4(KR)-FF4(KR)*(meltrate*dt)
+                     FF5(KR)=FF5(KR)-FF5(KR)*(meltrate*dt)
+                     ARG_M=ARG_M+(FF4(KR)+FF5(KR))*(meltrate*dt)
+                  ENDIF
 
-! NEW TIME STEP (ONLY_ICE: EVAPORATION)
+                    FF1(KR) = FF1(KR) + ARG_M
+                    SUM_ICE=SUM_ICE+ARG_M*3.*XL(KR)*XL(KR)*COL
+          	END DO
 
-	        IF(DTNEWL.GT.DT) DTNEWL=DT
-	        IF((TIMENEW+DTNEWL).GT.DT.AND.ITIME.LT.(NKR-1))  &
-     &          DTNEWL=DT-TIMENEW
-                IF(ITIME.EQ.(NKR-1)) DTNEWL=DT-TIMENEW
-	        TIMENEW=TIMENEW+DTNEWL
-	        TIMESTEPD(ITIME)=DTNEWL
-	        DTT=DTNEWL
-! SOLVING FOR SUPERSATURATION (ONLY_ICE: EVAPORATION) 
-	        CALL JERSUPSAT(DEL1,DEL2,DEL1N,DEL2N &
-     &                        ,RW,PW,RI,PI,QW,QI &
-     &                        ,DTT,D1N,D2N,DT0L0,DT0I0)
-! END OF "NEW SUPERSATURATION" (ONLY_ICE: EVAPORATION) 
+            ARG_1=333.*SUM_ICE/RO
+            TIN = TIN - ARG_1
+          ENDIF
 
-! CRYSTALS
-	        IF(ISYM2.NE.0) THEN
+    	RETURN
+ 	END SUBROUTINE J_W_MELT
+ ! +----------------------------------------------------------------------------+
+   SUBROUTINE ONECOND1 &
+				 & (TT,QQ,PP,ROR &
+				 & ,VR1,PSINGLE &
+				 & ,DEL1N,DEL2N,DIV1,DIV2 &
+				 & ,FF1,PSI1,R1,RLEC,RO1BL &
+				 & ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+				 & ,C1_MEY,C2_MEY &
+				 & ,COL,DTCOND,ICEMAX,NKR,ISYM1 &
+				   ,ISYM2,ISYM3,ISYM4,ISYM5,Iin,Jin,Kin,W_in,DX_in,Itimestep)
 
-! CRYSTAL DISTRIBUTION FUNCTION 
+        IMPLICIT NONE
 
-! NEW ALGORITHM (NO TYPE ICE) 
 
-	          CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                         ,FI2,PSI2,D2N &
-     &                         ,ICM,1,COL,NKR,TPN)
+       INTEGER NKR,ICEMAX, ISYM1, ISYM2(ICEMAX),ISYM3,ISYM4,ISYM5, Iin, Jin, Kin, &
+ 	  		  sea_spray_no_temp_change_per_grid, Itimestep
+       REAL    COL,VR1(NKR),PSINGLE &
+      &       ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+      &       ,DTCOND, W_in,DX_in
 
-	          CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                         ,FI2,PSI2,D2N &
-     &                         ,ICM,2,COL,NKR,TPN)
+       REAL C1_MEY,C2_MEY
+       INTEGER I_ABERGERON,I_BERGERON, &
+      & KR,ICE,ITIME,KCOND,NR,NRM, &
+      & KLIMIT, &
+      & KM,KLIMITL
+       REAL AL1,AL2,D,GAM,POD, &
+      & RV_MY,CF_MY,D_MYIN,AL1_MY,AL2_MY,ALC,DT0LREF,DTLREF, &
+      & A1_MYN, BB1_MYN, A2_MYN, BB2_MYN,DT,DTT,XRAD, &
+      & TPC1, TPC2, TPC3, TPC4, TPC5, &
+      & EPSDEL, EPSDEL2,DT0L, DT0I,&
+      & ROR, &
+      & CWHUCM,B6,B8L,B8I, &
+      & DEL1,DEL2,DEL1S,DEL2S, &
+      & TIMENEW,TIMEREV,SFN11,SFN12, &
+      & SFNL,SFNI,B5L,B5I,B7L,B7I,DOPL,DOPI,RW,RI,QW,PW, &
+      & PI,QI,DEL1N0,DEL2N0,D1N0,D2N0,DTNEWL,DTNEWL1,D1N,D2N, &
+      & DEL_R1,DT0L0,DT0I0, &
+      & DTNEWL0, &
+      & DTNEWL2
+        REAL DT_WATER_COND,DT_WATER_EVAP
+
+        INTEGER K
+ ! NEW ALGORITHM OF CONDENSATION (12.01.00)
+
+       REAL  FF1_OLD(NKR),SUPINTW(NKR)
+       DOUBLE PRECISION DSUPINTW(NKR),DD1N,DB11_MY,DAL1,DAL2
+       DOUBLE PRECISION COL3,RORI,TPN,TPS,QPN,QPS,TOLD,QOLD &
+      &                  ,FI1_K,FI2_K,FI3_K,FI4_K,FI5_K &
+      &                  ,R1_K,R2_K,R3_K,R4_K,R5_K &
+      &                  ,FI1R1,FI2R2,FI3R3,FI4R4,FI5R5 &
+      &                  ,RMASSLAA,RMASSLBB,RMASSIAA,RMASSIBB &
+      &                  ,ES1N,ES2N,EW1N,ARGEXP &
+      &                  ,TT,QQ,PP &
+      &                  ,DEL1N,DEL2N,DIV1,DIV2 &
+      &                  ,OPER2,OPER3,AR1,AR2
+
+        DOUBLE PRECISION DELMASSL1
+
+ ! DROPLETS
+
+         REAL R1(NKR) &
+      &           ,RLEC(NKR),RO1BL(NKR) &
+      &           ,FI1(NKR),FF1(NKR),PSI1(NKR) &
+      &           ,B11_MY(NKR),B12_MY(NKR)
+
+ ! WORK ARRAYS
+
+ ! NEW ALGORITHM OF MIXED PHASE FOR EVAPORATION
+
+
+ 	REAL DTIMEO(NKR),DTIMEL(NKR) &
+      &           ,TIMESTEPD(NKR)
+
+ ! NEW ALGORITHM (NO TYPE OF ICE)
+
+ 	REAL :: FL1(NKR), sfndummy(3), R1N(NKR)
+ 	INTEGER :: IDROP
+
+ 	DOUBLE PRECISION :: R1D(NKR),R1ND(NKR)
+
+ 	OPER2(AR1)=0.622/(0.622+0.378*AR1)/AR1
+ 	OPER3(AR1,AR2)=AR1*AR2/(0.622+0.378*AR1)
+
+ 	DATA AL1 /2500./, AL2 /2834./, D /0.211/ &
+      &      ,GAM /1.E-4/, POD /10./
+
+ 	DATA RV_MY,CF_MY,D_MYIN,AL1_MY,AL2_MY &
+      &      /461.5,0.24E-1,0.211E-4,2.5E6,2.834E6/
+
+ 	DATA A1_MYN, BB1_MYN, A2_MYN, BB2_MYN &
+      &      /2.53,5.42,3.41E1,6.13/
+
+ 	DATA TPC1, TPC2, TPC3, TPC4, TPC5 &
+      &      /-4.0,-8.1,-12.7,-17.8,-22.4/
+
+
+ 	DATA EPSDEL, EPSDEL2 /0.1E-03,0.1E-03/
+
+ 	DATA DT0L, DT0I /1.E20,1.E20/
+
+ 	DOUBLE PRECISION :: DEL1_d , DEL2_d, RW_d , PW_d, RI_d, PI_d, D1N_d, D2N_d, &
+ 						VR1_d(NKR)
+
+ sfndummy = 0.0
+ B12_MY = 0.0
+ B11_MY = 0.0
+
+  I_ABERGERON=0
+  I_BERGERON=0
+  COL3=3.0*COL
+ ITIME=0
+ KCOND=0
+ DT_WATER_COND=0.4
+ DT_WATER_EVAP=0.4
+ ITIME=0
+ KCOND=0
+ DT0LREF=0.2
+ DTLREF=0.4
+
+ NR=NKR
+ NRM=NKR-1
+ DT=DTCOND
+ DTT=DTCOND
+ XRAD=0.
+
+  CWHUCM=0.
+ XRAD=0.
+ B6=CWHUCM*GAM-XRAD
+ B8L=1./ROR
+ B8I=1./ROR
+ RORI=1./ROR
+
+ DO KR=1,NKR
+    FF1_OLD(KR)=FF1(KR)
+    SUPINTW(KR)=0.0
+    DSUPINTW(KR)=0.0
+ ENDDO
+
+ TPN=TT
+ QPN=QQ
+ DO KR=1,NKR
+     FI1(KR)=FF1(KR)
+ END DO
+
+ ! WARM MP (CONDENSATION OR EVAPORATION) (BEGIN)
+ TIMENEW=0.
+ ITIME=0
+
+ TOLD = TPN
+ QOLD = QPN
+ R1D = R1
+ R1ND = R1D
+ SFNL = 0.0
+ SFN11 = 0.0
+
+ 56  ITIME = ITIME+1
+ TIMEREV = DT-TIMENEW
+ TIMEREV = DT-TIMENEW
+ DEL1 = DEL1N
+ DEL2 = DEL2N
+ DEL1S = DEL1N
+ DEL2S = DEL2N
+ TPS = TPN
+ QPS = QPN
+
+ IF(ISYM1 == 1)THEN
+ 	FL1 = 0.0
+ 	VR1_d = VR1
+ 	CALL JERRATE_KS &
+ 				(R1D,TPS,PP,VR1_d,RLEC,RO1BL,B11_MY,1,1,fl1,NKR,ICEMAX)
+ 	sfndummy(1)=SFN11
+ 	CALL JERTIMESC_KS(FI1,R1D,SFNDUMMY,B11_MY,B8L,1,NKR,ICEMAX,COL)
+ 	SFN11 = sfndummy(1)
+ ENDIF
+
+ SFN12 = 0.0
+ SFNL = SFN11 + SFN12
+ SFNI = 0.
+
+ B5L=BB1_MY/TPS/TPS
+ B5I=BB2_MY/TPS/TPS
+ B7L=B5L*B6
+ B7I=B5I*B6
+ DOPL=1.+DEL1S
+ DOPI=1.+DEL2S
+ RW=(OPER2(QPS)+B5L*AL1)*DOPL*SFNL
+ RI=(OPER2(QPS)+B5L*AL2)*DOPL*SFNI
+ QW=B7L*DOPL
+ PW=(OPER2(QPS)+B5I*AL1)*DOPI*SFNL
+ PI=(OPER2(QPS)+B5I*AL2)*DOPI*SFNI
+ QI=B7I*DOPI
+
+ IF(RW.NE.RW .or. PW.NE.PW)THEN
+    print*, 'NaN In ONECOND1'
+    call wrf_error_fatal("fatal error in ONECOND1 (RW or PW are NaN), model stop")
+ ENDIF
+
+ KCOND=10
+ IF(DEL1N >= 0.0D0) KCOND=11
+
+   IF(KCOND == 11) THEN
+   	  DTNEWL = DT
+      DTNEWL = DT
+      DTNEWL = AMIN1(DTNEWL,TIMEREV)
+      TIMENEW = TIMENEW + DTNEWL
+      DTT = DTNEWL
+
+   	  IF (DTT < 0.0) call wrf_error_fatal("fatal error in ONECOND1-DEL1N>0:(DTT<0), model stop")
+
+     	DEL1_d = DEL1
+     	DEL2_d = DEL2
+     	RW_d = RW
+     	PW_d = PW
+     	RI_d = RI
+     	PI_d = PI
+
+ 	    CALL JERSUPSAT_KS(DEL1_d,DEL2_d,DEL1N,DEL2N, &
+             					  RW_d,PW_d,RI_d,PI_d, &
+             					  DTT,D1N_d,D2N_d,0.0,0.0, &
+             					  ISYM1,ISYM2,ISYM3,ISYM4,ISYM5)
+     	DEL1 = DEL1_d
+     	DEL2 = DEL2_d
+     	RW = RW_d
+     	PW = PW_d
+     	RI = RI_d
+     	PI = PI_d
+     	D1N = D1N_d
+     	D2N = D2N_d
+
+     	IF(ISYM1 == 1)THEN
+     		IDROP = ISYM1
+     		CALL JERDFUN_KS(R1D, R1ND, B11_MY, FI1, PSI1, fl1, D1N, &
+     						        ISYM1, 1, 1, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 1, Iin, Jin ,Kin, Itimestep)
+     	ENDIF
+
+     	IF((DEL1.GT.0.AND.DEL1N.LT.0) &
+       		&.AND.ABS(DEL1N).GT.EPSDEL) THEN
+             		call wrf_error_fatal("fatal error in ONECOND1-1 (DEL1.GT.0.AND.DEL1N.LT.0), model stop")
+     	ENDIF
+
+    ! IN CASE : KCOND.EQ.11
+    ELSE
+
+ 	    ! EVAPORATION - ONLY WATER
+ 	    ! IN CASE : KCOND.NE.11
+    	DTIMEO = DT
+      DTNEWL = DT
+      DTNEWL = AMIN1(DTNEWL,TIMEREV)
+      TIMENEW = TIMENEW + DTNEWL
+      DTT = DTNEWL
+
+ 	    IF (DTT < 0.0) call wrf_error_fatal("fatal error in ONECOND1-DEL1N<0:(DTT<0), model stop")
+
+ 	    DEL1_d = DEL1
+ 	    DEL2_d = DEL2
+ 	    RW_d = RW
+ 	    PW_d = PW
+ 	    RI_d = RI
+ 	    PI_d = PI
+ 	    CALL JERSUPSAT_KS(DEL1_d,DEL2_d,DEL1N,DEL2N, &
+ 					  RW_d,PW_d,RI_d,PI_d, &
+ 					  DTT,D1N_d,D2N_d,0.0,0.0, &
+ 					  ISYM1,ISYM2,ISYM3,ISYM4,ISYM5)
+     	DEL1 = DEL1_d
+     	DEL2 = DEL2_d
+     	RW = RW_d
+     	PW = PW_d
+     	RI = RI_d
+     	PI = PI_d
+     	D1N = D1N_d
+     	D2N = D2N_d
+
+      IF(ISYM1 == 1)THEN
+ 	      IDROP = ISYM1
+ 	      CALL JERDFUN_KS(R1D, R1ND, B11_MY, &
+				              FI1, PSI1, fl1, D1N, &
+ 					            ISYM1, 1, 1, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 1, Iin, Jin ,Kin, Itimestep)
+      ENDIF
 
-	          CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                         ,FI2,PSI2,D2N &
-     &                         ,ICM,3,COL,NKR,TPN)
-	        ENDIF
-! SNOW 
-	        IF(ISYM3.NE.0) THEN
+      IF((DEL1.LT.0.AND.DEL1N.GT.0) &
+        .AND.ABS(DEL1N).GT.EPSDEL) THEN
+         call wrf_error_fatal("fatal error in ONECOND1-2 (DEL1.LT.0.AND.DEL1N.GT.0), model stop")
+      ENDIF
 
-! SNOW DISTRIBUTION FUNCTION (ONLY_ICE: EVAPORATION) 
-                                                         
+    ENDIF
+
+
+ RMASSLBB=0.
+ RMASSLAA=0.
+
+ ! ... before JERNEWF (ONLY WATER)
+ DO K=1,NKR
+  FI1_K = FI1(K)
+  R1_K = R1(K)
+  FI1R1 = FI1_K*R1_K*R1_K
+  RMASSLBB = RMASSLBB+FI1R1
+ ENDDO
+ RMASSLBB = RMASSLBB*COL3*RORI
+ IF(RMASSLBB.LE.0.) RMASSLBB=0.
+ ! ... after JERNEWF (ONLY WATER)
+ DO K=1,NKR
+  FI1_K=PSI1(K)
+  R1_K=R1(K)
+  FI1R1=FI1_K*R1_K*R1_K
+  RMASSLAA=RMASSLAA+FI1R1
+ END DO
+ RMASSLAA=RMASSLAA*COL3*RORI
+ IF(RMASSLAA.LE.0.) RMASSLAA=0.
+
+ DELMASSL1 = RMASSLAA - RMASSLBB
+ QPN = QPS - DELMASSL1
+ DAL1 = AL1
+ TPN = TPS + DAL1*DELMASSL1
+
+ IF(ABS(DAL1*DELMASSL1) > 3.0 )THEN
+ 	print*,"ONECOND1-in(start)"
+	print*,"I=",Iin,"J=",Jin,"Kin",Kin,"W",w_in,"DX",dx_in
+ 	print*,"DELMASSL1",DELMASSL1,"DT",DTT
+ 	print*,"DEL1N,DEL2N,DEL1,DEL2,D1N,D2N,RW,PW,RI,PI,DT"
+ 	print*,DEL1N,DEL2N,DEL1,DEL2,D1N,D2N,RW,PW,RI,PI,DTT
+ 	print*,"TPS",TPS,"QPS",QPS
+	print*,'FI1 before',FI1,'PSI1 after',PSI1
+ 	print*,"ONECOND1-in(end)"
+ 	call wrf_error_fatal("fatal error in ONECOND1-in (ABS(DAL1*DELMASSL1) > 3.0), model stop")
+ ENDIF
+
+ ! ... SUPERSATURATION (ONLY WATER)
+ ARGEXP=-BB1_MY/TPN
+ ES1N=AA1_MY*DEXP(ARGEXP)
+ ARGEXP=-BB2_MY/TPN
+ ES2N=AA2_MY*DEXP(ARGEXP)
+ EW1N=OPER3(QPN,PP)
+ IF(ES1N == 0.0D0)THEN
+          DEL1N=0.5
+          DIV1=1.5
+ ELSE
+          DIV1 = EW1N/ES1N
+          DEL1N = EW1N/ES1N-1.
+ END IF
+ IF(ES2N == 0.0D0)THEN
+          DEL2N=0.5
+          DIV2=1.5
+ ELSE
+          DEL2N = EW1N/ES2N-1.
+          DIV2 = EW1N/ES2N
+ END IF
+ IF(ISYM1 == 1) THEN
+ 	DO KR=1,NKR
+           SUPINTW(KR)=SUPINTW(KR)+B11_MY(KR)*D1N
+           DD1N=D1N
+           DB11_MY=B11_MY(KR)
+           DSUPINTW(KR)=DSUPINTW(KR)+DB11_MY*DD1N
+ 	ENDDO
+ ENDIF
+
+ ! ... REPEATE TIME STEP (ONLY WATER: CONDENSATION OR EVAPORATION)
+ IF(TIMENEW.LT.DT) GOTO 56
+
+ 57  CONTINUE
+
+ IF(ISYM1 == 1) THEN
+    CALL JERDFUN_NEW_KS (R1D,R1ND,SUPINTW, &
+ 					FF1_OLD,PSI1, &
+ 					TPN,IDROP,FR_LIM, NKR, COL,1,Iin,Jin,Kin,Itimestep)
+ ENDIF ! in case ISYM1/=0
+
+ RMASSLAA=0.0
+ RMASSLBB=0.0
+
+ DO K=1,NKR
+  FI1_K=FF1_OLD(K)
+  R1_K=R1(K)
+  FI1R1=FI1_K*R1_K*R1_K
+  RMASSLBB=RMASSLBB+FI1R1
+ ENDDO
+ RMASSLBB=RMASSLBB*COL3*RORI
+ IF(RMASSLBB.LT.0.0) RMASSLBB=0.0
+
+ DO K=1,NKR
+  FI1_K=PSI1(K)
+  R1_K=R1(K)
+  FI1R1=FI1_K*R1_K*R1_K
+  RMASSLAA=RMASSLAA+FI1R1
+ ENDDO
+ RMASSLAA=RMASSLAA*COL3*RORI
+ IF(RMASSLAA.LT.0.0) RMASSLAA=0.0
+ DELMASSL1 = RMASSLAA-RMASSLBB
+
+ QPN = QOLD - DELMASSL1
+ DAL1 = AL1
+ TPN = TOLD + DAL1*DELMASSL1
+
+ IF(ABS(DAL1*DELMASSL1) > 5.0 )THEN
+ 	print*,"ONECOND1-out (start)"
+ 	print*,"I=",Iin,"J=",Jin,"Kin",Kin,"W",w_in,"DX",dx_in
+ 	print*,"DEL1N,DEL2N,D1N,D2N,RW,PW,RI,PI,DT"
+ 	print*,DEL1N,DEL2N,D1N,D2N,RW,PW,RI,PI,DTT
+ 	print*,"I=",Iin,"J=",Jin,"Kin",Kin
+ 	print*,"TPS=",TPS,"QPS=",QPS,"delmassl1",delmassl1
+ 	print*,"DAL1=",DAL1
+ 	print*,RMASSLBB,RMASSLAA
+ 	print*,"FI1",FI1
+ 	print*,"PSI1",PSI1
+ 	print*,"ONECOND1-out (end)"
+ 	IF(ABS(DAL1*DELMASSL1) > 5.0 )THEN
+ 		call wrf_error_fatal("fatal error in ONECOND1-out (ABS(DAL1*DELMASSL1) > 5.0), model stop")
+ 	ENDIF
+ ENDIF
+
+ ! ... SUPERSATURATION
+ ARGEXP=-BB1_MY/TPN
+ ES1N=AA1_MY*DEXP(ARGEXP)
+ ARGEXP=-BB2_MY/TPN
+ ES2N=AA2_MY*DEXP(ARGEXP)
+ EW1N=OPER3(QPN,PP)
+ IF(ES1N == 0.0D0)THEN
+  	DEL1N=0.5
+  	DIV1=1.5
+ 	call wrf_error_fatal("fatal error in ONECOND1 (ES1N.EQ.0), model stop")
+ ELSE
+    DIV1=EW1N/ES1N
+    DEL1N=EW1N/ES1N-1.
+ END IF
+ IF(ES2N.EQ.0)THEN
+    DEL2N=0.5
+    DIV2=1.5
+   call wrf_error_fatal("fatal error in ONECOND1 (ES2N.EQ.0), model stop")
+ ELSE
+    DEL2N=EW1N/ES2N-1.
+    DIV2=EW1N/ES2N
+ END IF
+
+ TT=TPN
+ QQ=QPN
+ DO KR=1,NKR
+  FF1(KR)=PSI1(KR)
+ ENDDO
+
+ RETURN
+ END SUBROUTINE ONECOND1
+ ! +----------------------------------------------------------------------------+
+ SUBROUTINE ONECOND2 &
+ 					 & (TT,QQ,PP,ROR  &
+ 					 & ,VR2,VR3,VR4,VR5,PSINGLE &
+ 					 & ,DEL1N,DEL2N,DIV1,DIV2 &
+ 					 & ,FF2,PSI2,R2,RIEC,RO2BL &
+ 					 & ,FF3,PSI3,R3,RSEC,RO3BL &
+ 					 & ,FF4,PSI4,R4,RGEC,RO4BL &
+ 					 & ,FF5,PSI5,R5,RHEC,RO5BL &
+ 					 & ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+ 					 & ,C1_MEY,C2_MEY &
+ 					 & ,COL,DTCOND,ICEMAX,NKR &
+ 					 & ,ISYM1,ISYM2,ISYM3,ISYM4,ISYM5, &
+ 					 	Iin,Jin,Kin,W_in,DX_in,Itimestep)
+
+    IMPLICIT NONE
+
+       INTEGER NKR,ICEMAX,ISYM1, Iin, Jin, Kin, Itimestep
+       REAL    COL,VR2(NKR,ICEMAX),VR3(NKR),VR4(NKR) &
+      &           ,VR5(NKR),PSINGLE &
+      &       ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+      &       ,DTCOND,W_in,DX_in
+
+       REAL C1_MEY,C2_MEY
+       INTEGER I_MIXCOND,I_MIXEVAP,I_ABERGERON,I_BERGERON, &
+      & KR,ICE,ITIME,ICM,KCOND,NR,NRM,INUC, &
+      & ISYM2(ICEMAX),ISYM3,ISYM4,ISYM5,KP,KLIMIT, &
+      & KM,ITER,KLIMITL,KLIMITG,KLIMITH,KLIMITI_1,KLIMITI_2,KLIMITI_3, &
+      & NCRITI
+       REAL AL1,AL2,D,GAM,POD, &
+      & RV_MY,CF_MY,D_MYIN,AL1_MY,AL2_MY,ALC,DT0LREF,DTLREF, &
+      & A1_MYN, BB1_MYN, A2_MYN, BB2_MYN,DT,DTT,XRAD, &
+      & TPC1, TPC2, TPC3, TPC4, TPC5, &
+      & EPSDEL, DT0L, DT0I, &
+      & ROR, &
+      & DEL1NUC,DEL2NUC, &
+      & CWHUCM,B6,B8L,B8I,RMASSGL,RMASSGI, &
+      & DEL1,DEL2,DEL1S,DEL2S, &
+      & TIMENEW,TIMEREV,SFN11,SFN12, &
+      & SFNL,SFNI,B5L,B5I,B7L,B7I,DOPL,DOPI,OPERQ,RW,RI,QW,PW, &
+      & PI,QI,D1N0,D2N0,DTNEWL,DTNEWL1,D1N,D2N, &
+      & DEL_R1,DT0L0,DT0I0,SFN31,SFN32,SFN52, &
+      & SFNII1,SFN21,SFN22,DTNEWI3,DTNEWI4,DTNEWI5,DTNEWI2_1, &
+      & DTNEWI2_2,DTNEWI1,DEL_R2,DEL_R4,DEL_R5,SFN41,SFN42, &
+      & SNF51,DTNEWI2_3,DTNEWI2,DTNEWI_1,DTNEWI_2, &
+      & DTNEWL0,DTNEWG1,DTNEWH1,DTNEWI_3, &
+      & DTNEWL2,SFN51,SFNII2,DEL_R3,DTNEWI
+        REAL DT_WATER_COND,DT_WATER_EVAP,DT_ICE_COND,DT_ICE_EVAP, &
+      &  DT_MIX_COND,DT_MIX_EVAP,DT_MIX_BERGERON,DT_MIX_ANTIBERGERON
+
+        INTEGER K
+
+       DOUBLE PRECISION DD1N,DB11_MY,DAL1,DAL2
+       DOUBLE PRECISION COL3,RORI,TPN,TPS,QPN,QPS,TOLD,QOLD &
+      &                  ,FI1_K,FI2_K,FI3_K,FI4_K,FI5_K &
+      &                  ,R1_K,R2_K,R3_K,R4_K,R5_K &
+      &                  ,FI1R1,FI2R2,FI3R3,FI4R4,FI5R5 &
+      &                  ,RMASSLAA,RMASSLBB,RMASSIAA,RMASSIBB &
+      &                  ,ES1N,ES2N,EW1N,ARGEXP &
+      &                  ,TT,QQ,PP &
+      &                  ,DEL1N,DEL2N,DIV1,DIV2 &
+      &                  ,OPER2,OPER3,AR1,AR2
+
+        DOUBLE PRECISION DELTAQ1,DELMASSI1,DELMASSL1
+
+         CHARACTER*70 CPRINT
+
+ ! CRYSTALS
+
+ 	REAL R2(NKR,ICEMAX) &
+      &           ,RIEC(NKR,ICEMAX) &
+      &           ,RO2BL(NKR,ICEMAX) &
+      &           ,FI2(NKR,ICEMAX),PSI2(NKR,ICEMAX) &
+      &           ,FF2(NKR,ICEMAX) &
+      &           ,B21_MY(NKR,ICEMAX),B22_MY(NKR,ICEMAX)
+
+ ! SNOW
+         REAL R3(NKR) &
+      &           ,RSEC(NKR),RO3BL(NKR) &
+      &           ,FI3(NKR),FF3(NKR),PSI3(NKR) &
+      &           ,B31_MY(NKR),B32_MY(NKR)
+
+ ! GRAUPELS
+
+         REAL R4(NKR) &
+      &           ,RGEC(NKR),RO4BL(NKR) &
+      &           ,FI4(NKR),FF4(NKR),PSI4(NKR) &
+      &           ,B41_MY(NKR),B42_MY(NKR)
+
+ ! HAIL
+         REAL R5(NKR) &
+      &           ,RHEC(NKR),RO5BL(NKR) &
+      &           ,FI5(NKR),FF5(NKR),PSI5(NKR) &
+      &           ,B51_MY(NKR),B52_MY(NKR)
+
+ ! CCN
+
+ 	REAL DTIMEG(NKR),DTIMEH(NKR)
+
+ 	REAL DEL2D(ICEMAX),DTIMEO(NKR),DTIMEL(NKR) &
+
+      &           ,DTIMEI_1(NKR),DTIMEI_2(NKR),DTIMEI_3(NKR) &
+      &           ,SFNI1(ICEMAX),SFNI2(ICEMAX) &
+      &           ,TIMESTEPD(NKR) &
+      &           ,FI1REF(NKR),PSI1REF(NKR) &
+      &           ,FI2REF(NKR,ICEMAX),PSI2REF(NKR,ICEMAX)&
+      &           ,FCCNRREF(NKR)
+
+ 	REAL :: FL1(NKR), sfndummy(3), FL3(NKR), FL4(NKR), FL5(NKR), &
+ 					R2N(NKR,ICEMAX), R3N(NKR), R4N(NKR), R5N(NKR)
+ 	INTEGER :: IDROP, ISYMICE
+ 	DOUBLE PRECISION :: R2D(NKR,ICEMAX),R3D(NKR), R4D(NKR), R5D(NKR), &
+ 			    R2ND(NKR,ICEMAX),R3ND(NKR), R4ND(NKR), R5ND(NKR), &
+ 			    VR2_d(NKR,ICEMAX), VR3_d(NKR), VR4_d(NKR), VR5_d(NKR)
+
+ 	OPER2(AR1)=0.622/(0.622+0.378*AR1)/AR1
+ 	OPER3(AR1,AR2)=AR1*AR2/(0.622+0.378*AR1)
+
+ 	DATA AL1 /2500./, AL2 /2834./, D /0.211/ &
+      &      ,GAM /1.E-4/, POD /10./
+
+ 	DATA RV_MY,CF_MY,D_MYIN,AL1_MY,AL2_MY &
+      &      /461.5,0.24E-1,0.211E-4,2.5E6,2.834E6/
+
+ 	DATA A1_MYN, BB1_MYN, A2_MYN, BB2_MYN &
+      &      /2.53,5.42,3.41E1,6.13/
+
+ 	DATA TPC1, TPC2, TPC3, TPC4, TPC5 &
+      &      /-4.0,-8.1,-12.7,-17.8,-22.4/
+
+ 	DATA EPSDEL/0.1E-03/
+
+ 	DATA DT0L, DT0I /1.E20,1.E20/
+
+ 	DOUBLE PRECISION :: DEL1_d, DEL2_d, RW_d, PW_d, RI_d, PI_d, D1N_d, D2N_d
+
+ 	B22_MY = 0.0
+ 	B32_MY = 0.0
+ 	B42_MY = 0.0
+ 	B52_MY = 0.0
+
+ 	B21_MY = 0.0
+ 	B31_MY = 0.0
+ 	B41_MY = 0.0
+ 	B51_MY = 0.0
+
+ 	SFNDUMMY = 0.0
+ 	R2D = R2
+ 	R3D = R3
+ 	R4D = R4
+ 	R5D = R5
+ 	R2ND = R2D
+ 	R3ND = R3D
+ 	R4ND = R4D
+ 	R5ND = R5D
+
+ 	SFNI1 = 0.0
+ 	SFN31 = 0.0
+ 	SFN41 = 0.0
+ 	SFN51 = 0.0
+
+ 	I_MIXCOND=0
+ 	I_MIXEVAP=0
+ 	I_ABERGERON=0
+ 	I_BERGERON=0
+ 	COL3=3.0*COL
+ 	ICM=ICEMAX
+ 	ITIME=0
+ 	KCOND=0
+ 	DT_WATER_COND=0.4
+ 	DT_WATER_EVAP=0.4
+ 	DT_ICE_COND=0.4
+ 	DT_ICE_EVAP=0.4
+ 	DT_MIX_COND=0.4
+ 	DT_MIX_EVAP=0.4
+ 	DT_MIX_BERGERON=0.4
+ 	DT_MIX_ANTIBERGERON=0.4
+ 	ICM=ICEMAX
+ 	ITIME=0
+ 	KCOND=0
+ 	DT0LREF=0.2
+ 	DTLREF=0.4
+
+ 	NR=NKR
+ 	NRM=NKR-1
+ 	DT=DTCOND
+ 	DTT=DTCOND
+ 	XRAD=0.
+
+ 	CWHUCM=0.
+ 	XRAD=0.
+ 	B6=CWHUCM*GAM-XRAD
+ 	B8L=1./ROR
+ 	B8I=1./ROR
+ 	RORI=1./ROR
+
+ 	TPN=TT
+ 	QPN=QQ
+
+   	DO ICE=1,ICEMAX
+ 		 SFNI1(ICE)=0.
+ 		 SFNI2(ICE)=0.
+ 		 DEL2D(ICE)=0.
+   	ENDDO
+
+   	TIMENEW = 0.
+   	ITIME = 0
+
+ ! ONLY ICE (CONDENSATION OR EVAPORATION) :
+
+   46 ITIME = ITIME + 1
+
+ 	  TIMEREV=DT-TIMENEW
+
+ 	  DEL1=DEL1N
+ 	  DEL2=DEL2N
+ 	  DEL1S=DEL1N
+ 	  DEL2S=DEL2N
+ 	  DEL2D(1)=DEL2N
+ 	  DEL2D(2)=DEL2N
+ 	  DEL2D(3)=DEL2N
+ 	  TPS=TPN
+ 	  QPS=QPN
+ 	  DO KR=1,NKR
+ 		 FI3(KR)=PSI3(KR)
+ 		 FI4(KR)=PSI4(KR)
+ 		 FI5(KR)=PSI5(KR)
+ 		 DO ICE=1,ICEMAX
+ 			FI2(KR,ICE)=PSI2(KR,ICE)
+ 		 ENDDO
+ 	  ENDDO
+
+ 	  IF(sum(ISYM2) > 0) THEN
+ 	    FL1 = 0.0
+ 	    VR2_d = VR2
+ 	  ! ... ice crystals
+ 		  CALL JERRATE_KS (R2D,TPS,PP,VR2_d,RIEC,RO2BL,B21_MY,3,2,fl1,NKR,ICEMAX)
+
+ 		  CALL JERTIMESC_KS (FI2,R2D,SFNI1,B21_MY,B8I,ICM,NKR,ICEMAX,COL)
+ 	  ENDIF
+ 	  IF(ISYM3 == 1) THEN
+ 	    FL3 = 0.0
+ 	    VR3_d = VR3
+ 	  ! ... snow
+ 		  CALL JERRATE_KS (R3D,TPS,PP,VR3_d,RSEC,RO3BL,B31_MY,1,3,fl3,NKR,ICEMAX)
+
+ 		  sfndummy(1) = SFN31
+ 		  CALL JERTIMESC_KS(FI3,R3D,SFNDUMMY,B31_MY,B8I,1,NKR,ICEMAX,COL)
+ 	  	  SFN31 = sfndummy(1)
+ 	  ENDIF
+ 	  IF(ISYM4 == 1) THEN
+ 	    FL4 = 0.0
+ 	    VR4_d = VR4
+ 	  ! ... graupel
+ 		  CALL JERRATE_KS(R4D,TPS,PP,VR4_d,RGEC,RO4BL,B41_MY,1,2,fl4,NKR,ICEMAX)
+
+ 		  sfndummy(1) = SFN41
+ 		  CALL JERTIMESC_KS(FI4,R4D,SFNDUMMY,B41_MY,B8I,1,NKR,ICEMAX,COL)
+ 	  	  SFN41 = sfndummy(1)
+ 	  ENDIF
+ 	  IF(ISYM5 == 1) THEN
+ 	    FL5 = 0.0
+ 	    VR5_d = VR5
+ 	  ! ... hail
+ 		  CALL JERRATE_KS(R5D,TPS,PP,VR5_d,RHEC,RO5BL,B51_MY,1,2,fl5,NKR,ICEMAX)
+
+ 		  sfndummy(1) = SFN51
+ 		  CALL JERTIMESC_KS(FI5,R5D,SFNDUMMY,B51_MY,B8I,1,NKR,ICEMAX,COL)
+ 	  	  SFN51 = sfndummy(1)
+ 	  ENDIF
+
+
+ 	  SFNII1 = SFNI1(1) + SFNI1(2) + SFNI1(3)
+ 	  SFN21 = SFNII1 + SFN31 + SFN41 + SFN51
+ 	  SFNL = 0.0
+ 	  SFN22 = 0.0
+ 	  SFNI = SFN21 + SFN22
+
+   	B5L=BB1_MY/TPS/TPS
+   	B5I=BB2_MY/TPS/TPS
+   	B7L=B5L*B6
+   	B7I=B5I*B6
+   	DOPL=1.+DEL1S
+   	DOPI=1.+DEL2S
+   	OPERQ=OPER2(QPS)
+   	RW=(OPERQ+B5L*AL1)*DOPL*SFNL
+   	QW=B7L*DOPL
+   	PW=(OPERQ+B5I*AL1)*DOPI*SFNL
+   	RI=(OPERQ+B5L*AL2)*DOPL*SFNI
+   	PI=(OPERQ+B5I*AL2)*DOPI*SFNI
+   	QI=B7I*DOPI
+
+     KCOND=20
+     IF(DEL2N > 0.0) KCOND=21
+
+   	IF(RW.NE.RW .or. PW.NE.PW)THEN
+ 	    print*, 'NaN In ONECOND2'
+ 	    call wrf_error_fatal("fatal error in ONECOND2 (RW or PW are NaN), model stop")
+   	ENDIF
+
+ ! ... (ONLY ICE)
+   	IF(KCOND == 21)  THEN
+ 			! ... ONLY_ICE: CONDENSATION
+       DTNEWL = DT
+       DTNEWL = AMIN1(DTNEWL,TIMEREV)
+       TIMENEW = TIMENEW + DTNEWL
+       DTT = DTNEWL
+
+ 			IF (DTT < 0.0) call wrf_error_fatal("fatal error in ONECOND2-DEL2N>0:(DTT<0), model stop")
+
+ 			DEL1_d = DEL1
+ 			DEL2_d = DEL2
+ 			RW_d = RW
+ 			PW_d = PW
+ 			RI_d = RI
+ 			PI_d = PI
+ 			CALL JERSUPSAT_KS(DEL1_d,DEL2_d,DEL1N,DEL2N, &
+ 											  RW_d,PW_d,RI_d,PI_d, &
+ 											  DTT,D1N_d,D2N_d,0.0,0.0, &
+ 											  ISYM1,ISYM2,ISYM3,ISYM4,ISYM5)
+ 			DEL1 = DEL1_d
+ 			DEL2 = DEL2_d
+ 			RW = RW_d
+ 			PW = PW_d
+ 			RI = RI_d
+ 			PI = PI_d
+ 			D1N = D1N_d
+ 			D2N = D2N_d
+
+ 			IF(sum(ISYM2) > 0)THEN
+ 				IDROP = 0
+ 				FL1 = 0.0
+ 				IF(ISYM2(1) == 1) THEN
+ 				  CALL JERDFUN_KS(R2D(:,1), R2ND(:,1), B21_MY(:,1), &
+ 								  FI2(:,1), PSI2(:,1), fl1, D2N, &
+ 								  ISYM2(1), ICM, 1, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 21, Iin, Jin ,Kin, Itimestep)
+ 				ENDIF
+ 				IF(ISYM2(2) == 1) THEN
+ 				  CALL JERDFUN_KS(R2D(:,2), R2ND(:,2), B21_MY(:,2), &
+ 								  FI2(:,2), PSI2(:,2), fl1, D2N, &
+ 								  ISYM2(2), ICM, 2, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 22, Iin, Jin ,Kin, Itimestep)
+ 				ENDIF
+ 				IF(ISYM2(3) == 1) THEN
+ 				  CALL JERDFUN_KS(R2D(:,3), R2ND(:,3), B21_MY(:,3), &
+ 								  FI2(:,3), PSI2(:,3), fl1, D2N, &
+ 								  ISYM2(3), ICM, 3, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 23, Iin, Jin ,Kin, Itimestep)
+
+ 				! IN CASE : ISYM2.NE.0
+ 				ENDIF
+ 			ENDIF
+
+ 			IF(ISYM3 == 1) THEN
+ 				IDROP = 0
+ 				FL3 = 0.0
+ 				CALL JERDFUN_KS(R3D, R3ND, B31_MY, &
+ 								FI3, PSI3, fl3, D2N, &
+ 								ISYM3, 1, 3, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 3, Iin, Jin ,Kin, Itimestep)
+ 			ENDIF
+
+
+ 			IF(ISYM4 == 1) THEN
+ 			 	IDROP = 0
+ 			 	FL4 = 0.0
+ 			 	CALL JERDFUN_KS(R4D, R4ND, B41_MY, &
+ 								FI4, PSI4, fl4, D2N, &
+ 								ISYM4, 1, 4, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 4, Iin, Jin ,Kin, Itimestep)
+ 				! IN CASE : ISYM4.NE.0
+ 			ENDIF
+
+ 			IF(ISYM5 == 1) THEN
+ 			 IDROP = 0
+ 			 FL5 = 0.0
+ 			 CALL JERDFUN_KS(R5D, R5ND, B51_MY, &
+ 							FI5, PSI5, fl5, D2N, &
+ 							ISYM5, 1, 5, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 5, Iin, Jin ,Kin, Itimestep)
+ 			! IN CASE : ISYM5.NE.0
+ 			ENDIF
+
+ 			IF((DEL2.GT.0.AND.DEL2N.LT.0) &
+          		.AND.ABS(DEL2N).GT.EPSDEL) THEN
+                 call wrf_error_fatal("fatal error in module_mp_fast_sbm (DEL2.GT.0.AND.DEL2N.LT.0), model stop")
+ 			ENDIF
+
+ 	  ELSE
+ 	  ! ... IN CASE KCOND.NE.21
+ 			! ONLY ICE: EVAPORATION
+        DTNEWL = DT
+        DTNEWL = AMIN1(DTNEWL,TIMEREV)
+        TIMENEW = TIMENEW + DTNEWL
+        DTT = DTNEWL
+
+ 			  IF (DTT < 0.0) call wrf_error_fatal("fatal error in ONECOND2-DEL2N<0:(DTT<0), model stop")
+
+   			DEL1_d = DEL1
+   			DEL2_d = DEL2
+   			RW_d = RW
+   			PW_d = PW
+   			RI_d = RI
+   			PI_d = PI
+   			CALL JERSUPSAT_KS(DEL1_d,DEL2_d,DEL1N,DEL2N, &
+   												RW_d,PW_d,RI_d,PI_d, &
+   					  						DTT,D1N_d,D2N_d,0.0,0.0, &
+   						  					ISYM1,ISYM2,ISYM3,ISYM4,ISYM5)
+   		 	DEL1 = DEL1_d
+   			DEL2 = DEL2_d
+   			RW = RW_d
+   			PW = PW_d
+   			RI = RI_d
+   			PI = PI_d
+   			D1N = D1N_d
+   			D2N = D2N_d
+
+ 			IF(sum(ISYM2) > 0) THEN
+ 			  IDROP = 0
+ 			  FL1 = 0.0
+ 			  IF(ISYM2(1)==1)THEN
+ 			  	CALL JERDFUN_KS(R2D(:,1), R2ND(:,1), B21_MY(:,1), &
+ 							    FI2(:,1), PSI2(:,1), fl1, D2N, &
+ 							    ISYM2(1), ICM, 1, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 21, Iin, Jin ,Kin, Itimestep)
+ 		  	  ENDIF
+ 			  IF(ISYM2(2)==1)THEN
+ 		      	CALL JERDFUN_KS(R2D(:,2), R2ND(:,2), B21_MY(:,2), &
+ 							    FI2(:,2), PSI2(:,2), fl1, D2N, &
+ 								ISYM2(2), ICM, 2, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 22, Iin, Jin ,Kin, Itimestep)
+ 		      ENDIF
+ 			  IF(ISYM2(3)==1)THEN
+ 		      	CALL JERDFUN_KS(R2D(:,3), R2ND(:,3), B21_MY(:,3), &
+ 								FI2(:,3), PSI2(:,3), fl1, D2N, &
+ 							    ISYM2(3), ICM, 3, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 23, Iin, Jin ,Kin, Itimestep)
+ 			 ENDIF
+ 			ENDIF
+
+       IF(ISYM3 == 1) THEN
+ 			! ... SNOW
+ 				IDROP = 0
+ 				FL3 = 0.0
+ 				CALL JERDFUN_KS(R3D, R3ND, B31_MY, &
+ 								FI3, PSI3, fl3, D2N, &
+ 								ISYM3, 1, 3, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 3, Iin, Jin ,Kin, Itimestep)
+ 			! IN CASE : ISYM3.NE.0
+       ENDIF
 
-! CALL JERDFUN - SNOW - 2 (ONLY_ICE: EVAPORATION)
+     IF(ISYM4 == 1) THEN
+     ! ... GRAUPELS (ONLY_ICE: EVAPORATION)
+         ! ... New JERDFUN
+         IDROP = 0
+         FL4 = 0.0
+         CALL JERDFUN_KS(R4D, R4ND, B41_MY, &
+                         FI4, PSI4, fl4, D2N, &
+                         ISYM4, 1, 4, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 4, Iin, Jin ,Kin, Itimestep)
+     ! IN CASE : ISYM4.NE.0
+     ENDIF
+
+       IF(ISYM5 == 1) THEN
+         ! ... HAIL (ONLY_ICE: EVAPORATION)
+           ! ... New JERDFUN
+           IDROP = 0
+           FL5 = 0.0
+           CALL JERDFUN_KS(R5D, R5ND, B51_MY, &
+                           FI5, PSI5, fl5, D2N, &
+                           ISYM5, 1, 5, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 5, Iin, Jin ,Kin, Itimestep)
+             ! IN CASE : ISYM5.NE.0
+       ENDIF
 
-	          CALL JERDFUN(R3,B31_MY,B32_MY &
-     &                        ,FI3,PSI3,D2N &
-     &                        ,1,3,COL,NKR,TPN)
+       IF((DEL2.LT.0.AND.DEL2N.GT.0) &
+            .AND.ABS(DEL2N).GT.EPSDEL) THEN
+             call wrf_error_fatal("fatal error in module_mp_fast_sbm (DEL2.LT.0.AND.DEL2N.GT.0), model stop")
+       ENDIF
 
+ 		 ! IN CASE : KCOND.NE.21
+     ENDIF
+
+ ! MASSES
+ 	  RMASSIBB=0.0
+ 	  RMASSIAA=0.0
+
+ 	  DO K=1,NKR
+ 		 DO ICE = 1,ICEMAX
+ 			FI2_K = FI2(K,ICE)
+ 			R2_K = R2(K,ICE)
+ 			FI2R2 = FI2_K*R2_K*R2_K
+ 			RMASSIBB = RMASSIBB + FI2R2
+ 	 	 ENDDO
+ 		 FI3_K=FI3(K)
+ 		 FI4_K=FI4(K)
+ 		 FI5_K=FI5(K)
+ 		 R3_K=R3(K)
+ 		 R4_K=R4(K)
+ 		 R5_K=R5(K)
+ 		 FI3R3=FI3_K*R3_K*R3_K
+ 		 FI4R4=FI4_K*R4_K*R4_K
+ 		 FI5R5=FI5_K*R5_K*R5_K
+ 		 RMASSIBB=RMASSIBB+FI3R3
+ 		 RMASSIBB=RMASSIBB+FI4R4
+ 		 RMASSIBB=RMASSIBB+FI5R5
+ 	  ENDDO
+ 	  RMASSIBB=RMASSIBB*COL3*RORI
+ 	  IF(RMASSIBB.LT.0.0) RMASSIBB=0.0
+
+ 	  DO K=1,NKR
+ 		 DO ICE =1,ICEMAX
+ 			FI2_K=PSI2(K,ICE)
+ 			R2_K=R2(K,ICE)
+ 			FI2R2=FI2_K*R2_K*R2_K
+ 			RMASSIAA=RMASSIAA+FI2R2
+ 		 ENDDO
+ 		 FI3_K = PSI3(K)
+ 		 FI4_K = PSI4(K)
+ 		 FI5_K = PSI5(K)
+ 		 R3_K=R3(K)
+ 		 R4_K=R4(K)
+ 		 R5_K=R5(K)
+ 		 FI3R3=FI3_K*R3_K*R3_K
+ 		 FI4R4=FI4_K*R4_K*R4_K
+ 		 FI5R5=FI5_K*R5_K*R5_K
+ 		 RMASSIAA=RMASSIAA+FI3R3
+ 		 RMASSIAA=RMASSIAA+FI4R4
+ 		 RMASSIAA=RMASSIAA+FI5R5
+ 	  ENDDO
+ 		RMASSIAA = RMASSIAA*COL3*RORI
+
+ 		IF(RMASSIAA.LT.0.0) RMASSIAA=0.0
+
+ 		DELMASSI1 = RMASSIAA-RMASSIBB
+ 		QPN = QPS-DELMASSI1
+ 		DAL2 = AL2
+ 		TPN = TPS+DAL2*DELMASSI1
+
+ 	  IF(ABS(DAL2*DELMASSI1) > 5.0 )THEN
+      print*,"ONECOND2-out (start)"
+      print*,"I=",Iin,"J=",Jin,"Kin",Kin,"W",w_in,"DX",dx_in
+      print*,"DEL1N,DEL2N,D1N,D2N,RW,PW,RI,PI,DT"
+      print*,DEL1N,DEL2N,D1N,D2N,RW,PW,RI,PI,DTT
+      print*,"TPS=",TPS,"QPS=",QPS,"delmassi1",delmassi1
+      print*,"DAL1=",DAL2
+      print*,RMASSIBB,RMASSIAA
+      print*,"FI2_1",FI2(:,1)
+      print*,"FI2_2",FI2(:,2)
+      print*,"FI2_3",FI2(:,3)
+      print*,"FI3",FI3
+      print*,"FI4",FI4
+      print*,"FI5",FI5
+      print*,"PSI2_1",PSI2(:,1)
+      print*,"PSI2_2",PSI2(:,2)
+      print*,"PSI2_3",PSI2(:,3)
+      print*,"PSI3",PSI3
+      print*,"PSI4",PSI4
+      print*,"PSI5",PSI5
+      print*,"ONECOND2-out (end)"
+      IF(ABS(DAL2*DELMASSI1) > 5.0 )THEN
+      call wrf_error_fatal("fatal error in ONECOND2-out (ABS(DAL2*DELMASSI1) > 5.0), model stop")
+ 		ENDIF
+ 	  ENDIF
+
+ ! ... SUPERSATURATION
+ 	  ARGEXP=-BB1_MY/TPN
+ 	  ES1N=AA1_MY*DEXP(ARGEXP)
+ 	  ARGEXP=-BB2_MY/TPN
+ 	  ES2N=AA2_MY*DEXP(ARGEXP)
+ 	  EW1N=OPER3(QPN,PP)
+ 	  IF(ES1N == 0.0)THEN
+ 	   DEL1N=0.5
+ 	   DIV1=1.5
+ 	   call wrf_error_fatal("fatal error in ONECOND2 (ES1N.EQ.0), model stop")
+ 	  ELSE
+ 	   DIV1=EW1N/ES1N
+ 	   DEL1N=EW1N/ES1N-1.
+ 	  END IF
+ 	  IF(ES2N == 0.0)THEN
+ 	   DEL2N=0.5
+ 	   DIV2=1.5
+ 	   call wrf_error_fatal("fatal error in ONECOND2 (ES2N.EQ.0), model stop")
+ 	  ELSE
+ 	   DEL2N=EW1N/ES2N-1.
+ 	   DIV2=EW1N/ES2N
+ 	  END IF
+
+ !  END OF TIME SPLITTING
+ ! (ONLY ICE: CONDENSATION OR EVAPORATION)
+  	IF(TIMENEW.LT.DT) GOTO 46
+
+ 		TT=TPN
+ 		QQ=QPN
+ 		DO KR=1,NKR
+ 			DO ICE=1,ICEMAX
+ 				FF2(KR,ICE)=PSI2(KR,ICE)
+ 			ENDDO
+ 			FF3(KR)=PSI3(KR)
+ 			FF4(KR)=PSI4(KR)
+ 			FF5(KR)=PSI5(KR)
+ 		ENDDO
+
+   RETURN
+   END SUBROUTINE ONECOND2
+ ! +----------------------------------------------------------------------------+
+         SUBROUTINE ONECOND3 &
+ 						 & (TT,QQ,PP,ROR &
+ 						 & ,VR1,VR2,VR3,VR4,VR5,PSINGLE &
+ 						 & ,DEL1N,DEL2N,DIV1,DIV2 &
+ 						 & ,FF1,PSI1,R1,RLEC,RO1BL &
+ 						 & ,FF2,PSI2,R2,RIEC,RO2BL &
+ 						 & ,FF3,PSI3,R3,RSEC,RO3BL &
+ 						 & ,FF4,PSI4,R4,RGEC,RO4BL &
+ 						 & ,FF5,PSI5,R5,RHEC,RO5BL &
+ 						 & ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+ 						 & ,C1_MEY,C2_MEY &
+ 						 & ,COL,DTCOND,ICEMAX,NKR &
+ 						 & ,ISYM1,ISYM2,ISYM3,ISYM4,ISYM5, &
+ 						 	Iin,Jin,Kin,W_in,DX_in, Itimestep)
 
+        IMPLICIT NONE
+        INTEGER ICEMAX,NKR,KR,ITIME,ICE,KCOND,K &
+      &           ,ISYM1,ISYM2(ICEMAX),ISYM3,ISYM4,ISYM5, Kin, Iin, Jin, Itimestep
+        INTEGER KLIMITL,KLIMITG,KLIMITH,KLIMITI_1, &
+      &  KLIMITI_2,KLIMITI_3
+        INTEGER I_MIXCOND,I_MIXEVAP,I_ABERGERON,I_BERGERON
+        REAL ROR,VR1(NKR),VR2(NKR,ICEMAX),VR3(NKR),VR4(NKR) &
+      &           ,VR5(NKR),PSINGLE &
+      &           ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
+      &           ,C1_MEY,C2_MEY &
+      &           ,COL,DTCOND,W_in,DX_in
+
+ ! DROPLETS
+
+         REAL R1(NKR)&
+      &           ,RLEC(NKR),RO1BL(NKR) &
+      &           ,FI1(NKR),FF1(NKR),PSI1(NKR) &
+      &           ,B11_MY(NKR),B12_MY(NKR)
+
+ ! CRYSTALS
+
+ 	REAL R2(NKR,ICEMAX) &
+      &           ,RIEC(NKR,ICEMAX) &
+      &           ,RO2BL(NKR,ICEMAX) &
+      &           ,FI2(NKR,ICEMAX),PSI2(NKR,ICEMAX) &
+      &           ,FF2(NKR,ICEMAX) &
+      &           ,B21_MY(NKR,ICEMAX),B22_MY(NKR,ICEMAX) &
+      &           ,RATE2(NKR,ICEMAX),DEL_R2M(NKR,ICEMAX)
+
+ ! SNOW
+         REAL R3(NKR) &
+      &           ,RSEC(NKR),RO3BL(NKR) &
+      &           ,FI3(NKR),FF3(NKR),PSI3(NKR) &
+      &           ,B31_MY(NKR),B32_MY(NKR) &
+      &           ,DEL_R3M(NKR)
+
+ ! GRAUPELS
+
+         REAL R4(NKR) &
+      &           ,RGEC(NKR),RO4BL(NKR) &
+      &           ,FI4(NKR),FF4(NKR),PSI4(NKR) &
+      &           ,B41_MY(NKR),B42_MY(NKR) &
+      &           ,DEL_R4M(NKR)
+
+ ! HAIL
+         REAL R5(NKR) &
+      &           ,RHEC(NKR),RO5BL(NKR) &
+      &           ,FI5(NKR),FF5(NKR),PSI5(NKR) &
+      &           ,B51_MY(NKR),B52_MY(NKR) &
+      &           ,DEL_R5M(NKR)
+
+       DOUBLE PRECISION DD1N,DB11_MY,DAL1,DAL2
+       DOUBLE PRECISION COL3,RORI,TPN,TPS,QPN,QPS,TOLD,QOLD &
+      &                  ,FI1_K,FI2_K,FI3_K,FI4_K,FI5_K &
+      &                  ,R1_K,R2_K,R3_K,R4_K,R5_K &
+      &                  ,FI1R1,FI2R2,FI3R3,FI4R4,FI5R5 &
+      &                  ,RMASSLAA,RMASSLBB,RMASSIAA,RMASSIBB &
+      &                  ,ES1N,ES2N,EW1N,ARGEXP &
+      &                  ,TT,QQ,PP,DEL1N0,DEL2N0 &
+      &                  ,DEL1N,DEL2N,DIV1,DIV2 &
+      &                  ,OPER2,OPER3,AR1,AR2
+
+        DOUBLE PRECISION DELTAQ1,DELMASSI1,DELMASSL1
+
+        REAL A1_MYN, BB1_MYN, A2_MYN, BB2_MYN
+         DATA A1_MYN, BB1_MYN, A2_MYN, BB2_MYN &
+      &      /2.53,5.42,3.41E1,6.13/
+        REAL B8L,B8I,SFN11,SFN12,SFNL,SFNI
+        REAL B5L,B5I,B7L,B7I,B6,DOPL,DEL1S,DEL2S,DOPI,RW,QW,PW, &
+      &  RI,PI,QI,SFNI1(ICEMAX),SFNI2(ICEMAX),AL1,AL2
+        REAL D1N,D2N,DT0L, DT0I,D1N0,D2N0
+        REAL SFN21,SFN22,SFNII1,SFNII2,SFN31,SFN32,SFN41,SFN42,SFN51, &
+      &  SFN52
+        REAL DEL1,DEL2
+        REAL  TIMEREV,DT,DTT,TIMENEW
+        REAL DTIMEG(NKR),DTIMEH(NKR),totccn_before,totccn_after
+
+        REAL DEL2D(ICEMAX),DTIMEO(NKR),DTIMEL(NKR) &
+      &           ,DTIMEI_1(NKR),DTIMEI_2(NKR),DTIMEI_3(NKR)
+        REAL DT_WATER_COND,DT_WATER_EVAP,DT_ICE_COND,DT_ICE_EVAP, &
+      &  DT_MIX_COND,DT_MIX_EVAP,DT_MIX_BERGERON,DT_MIX_ANTIBERGERON
+        REAL DTNEWL0,DTNEWL1,DTNEWI1,DTNEWI2_1,DTNEWI2_2,DTNEWI2_3, &
+      & DTNEWI2,DTNEWI_1,DTNEWI_2,DTNEWI3,DTNEWI4,DTNEWI5, &
+      & DTNEWL,DTNEWL2,DTNEWG1,DTNEWH1
+        REAL TIMESTEPD(NKR)
+
+        DATA AL1 /2500./, AL2 /2834./
+        REAL EPSDEL,EPSDEL2
+        DATA EPSDEL, EPSDEL2 /0.1E-03,0.1E-03/
+
+ 	   REAL :: FL1(NKR), FL2(NKR,ICEMAX), FL3(NKR), FL4(NKR), FL5(NKR), SFNDUMMY(3), &
+ 	   		   R1N(NKR), R2N(NKR,ICEMAX), R3N(NKR), R4N(NKR), R5N(NKR)
+ 	   INTEGER :: IDROP, ICM, ISYMICE
+ 	   DOUBLE PRECISION :: R1D(NKR),R2D(NKR,ICEMAX),R3D(NKR), R4D(NKR), R5D(NKR), &
+ 			       R1ND(NKR),R2ND(NKR,ICEMAX),R3ND(NKR), R4ND(NKR), R5ND(NKR)
+
+
+ 	   DATA DT0L, DT0I /1.E20,1.E20/
+
+ 	   DOUBLE PRECISION :: DEL1_d, DEL2_d , RW_d, PW_d , RI_d , PI_d , D1N_d, D2N_d, &
+ 				VR1_d(NKR), VR2_d(NKR,ICEMAX), VR3_d(NKR), VR4_d(NKR), VR5_d(NKR), &
+ 				TTinput,QQinput,DEL1Ninput,DEL2Ninput
+
+        OPER2(AR1)=0.622/(0.622+0.378*AR1)/AR1
+        OPER3(AR1,AR2)=AR1*AR2/(0.622+0.378*AR1)
+
+
+
+ TTinput = TT
+ QQinput = QQ
+ DEL1Ninput = DEL1N
+ DEL2Ninput = DEL2N
+
+ B12_MY = 0.0
+ B22_MY = 0.0
+ B32_MY = 0.0
+ B42_MY = 0.0
+ B52_MY = 0.0
+
+ B21_MY = 0.0
+ B31_MY = 0.0
+ B41_MY = 0.0
+ B51_MY = 0.0
+
+ ICM = ICEMAX
+ R1D = R1
+ R2D = R2
+ R3D = R3
+ R4D = R4
+ R5D = R5
+ R1ND = R1D
+ R2ND = R2D
+ R3ND = R3D
+ R4ND = R4D
+ R5ND = R5D
+
+ VR1_d = VR1
+ VR2_d = VR2
+ VR3_d = VR3
+ VR4_d = VR4
+ VR5_d = VR5
+
+ SFN11 = 0.0
+ SFNI1 = 0.0
+ SFN31 = 0.0
+ SFN41 = 0.0
+ SFN51 = 0.0
+
+ DT_WATER_COND=0.4
+ DT_WATER_EVAP=0.4
+ DT_ICE_COND=0.4
+ DT_ICE_EVAP=0.4
+ DT_MIX_COND=0.4
+ DT_MIX_EVAP=0.4
+ DT_MIX_BERGERON=0.4
+ DT_MIX_ANTIBERGERON=0.4
+
+ I_MIXCOND=0
+ I_MIXEVAP=0
+ I_ABERGERON=0
+ I_BERGERON=0
+
+ ITIME = 0
+ TIMENEW = 0.0
+ DT = DTCOND
+ DTT = DTCOND
+
+ B6=0.
+ B8L=1./ROR
+ B8I=1./ROR
+
+ RORI=1.D0/ROR
+  COL3=3.D0*COL
+ TPN=TT
+ QPN=QQ
+
+ 16  ITIME = ITIME + 1
+ IF((TPN-273.15).GE.-0.187) GO TO 17
+ TIMEREV = DT - TIMENEW
+ DEL1 = DEL1N
+ DEL2 = DEL2N
+ DEL1S = DEL1N
+ DEL2S = DEL2N
+
+ DEL2D(1) = DEL2N
+ DEL2D(2) = DEL2N
+ DEL2D(3) = DEL2N
+ TPS = TPN
+ QPS = QPN
+ DO KR = 1,NKR
+ 	FI1(KR) = PSI1(KR)
+ 	FI3(KR) = PSI3(KR)
+ 	FI4(KR) = PSI4(KR)
+ 	FI5(KR) = PSI5(KR)
+ 	DO ICE = 1,ICEMAX
+ 		FI2(KR,ICE) = PSI2(KR,ICE)
+ 	ENDDO
+ ENDDO
+
+ IF(ISYM1 == 1)THEN
+  FL1 = 0.0
+ 	CALL JERRATE_KS &
+      	 	(R1D,TPS,PP,VR1_d,RLEC,RO1BL,B11_MY,1,1,fl1,NKR,ICEMAX)
+
+ 	sfndummy(1) = SFN11
+ 	CALL JERTIMESC_KS(FI1,R1D,SFNDUMMY,B11_MY,B8L,1,NKR,ICEMAX,COL)
+ 	SFN11 = sfndummy(1)
+ ENDIF
+
+ IF(sum(ISYM2) > 0) THEN
+ 		FL1 = 0.0
+ 		! ... ice crystals
+   	CALL JERRATE_KS (R2D,TPS,PP,VR2_d,RIEC,RO2BL,B21_MY,3,2,fl1,NKR,ICEMAX)
+   	CALL JERTIMESC_KS (FI2,R2D,SFNI1,B21_MY,B8I,ICM,NKR,ICEMAX,COL)
+ ENDIF
+ IF(ISYM3 == 1) THEN
+ 		FL3 = 0.0
+ 		! ... snow
+ 		CALL JERRATE_KS (R3D,TPS,PP,VR3_d,RSEC,RO3BL,B31_MY,1,3,fl3,NKR,ICEMAX)
+ 		sfndummy(1) = SFN31
+ 		CALL JERTIMESC_KS(FI3,R3D,SFNDUMMY,B31_MY,B8I,1,NKR,ICEMAX,COL)
+   	SFN31 = sfndummy(1)
+ ENDIF
+ IF(ISYM4 == 1) THEN
+ 		FL4 = 0.0
+ 		! ... graupel
+ 		CALL JERRATE_KS(R4D,TPS,PP,VR4_d,RGEC,RO4BL,B41_MY,1,2,fl4,NKR,ICEMAX)
+ 		sfndummy(1) = SFN41
+ 		CALL JERTIMESC_KS(FI4,R4D,SFNDUMMY,B41_MY,B8I,1,NKR,ICEMAX,COL)
+ 		SFN41 = sfndummy(1)
+ ENDIF
+ IF(ISYM5 == 1) THEN
+ 		FL5 = 0.0
+ 		! ... hail
+ 		CALL JERRATE_KS(R5D,TPS,PP,VR5_d,RHEC,RO5BL,B51_MY,1,2,fl5,NKR,ICEMAX)
+ 		sfndummy(1) = SFN51
+ 		CALL JERTIMESC_KS(FI5,R5D,SFNDUMMY,B51_MY,B8I,1,NKR,ICEMAX,COL)
+ 		SFN51 = sfndummy(1)
+ ENDIF
+
+ 	SFNII1 = SFNI1(1) + SFNI1(2) + SFNI1(3)
+ 	SFN21 = SFNII1 + SFN31 + SFN41 + SFN51
+ 	SFN12 = 0.0
+ 	SFNL = SFN11 + SFN12
+ 	SFN22 = 0.0
+ 	SFNI = SFN21 + SFN22
+
+ 	B5L=BB1_MY/TPS/TPS
+ 	B5I=BB2_MY/TPS/TPS
+ 	B7L=B5L*B6
+ 	B7I=B5I*B6
+ 	DOPL=1.+DEL1S
+ 	DOPI=1.+DEL2S
+ 	RW=(OPER2(QPS)+B5L*AL1)*DOPL*SFNL
+ 	QW=B7L*DOPL
+ 	PW=(OPER2(QPS)+B5I*AL1)*DOPI*SFNL
+ 	RI=(OPER2(QPS)+B5L*AL2)*DOPL*SFNI
+ 	PI=(OPER2(QPS)+B5I*AL2)*DOPI*SFNI
+ 	QI=B7I*DOPI
+
+ 	IF(RW.NE.RW .or. PW.NE.PW)THEN
+ 	  print*, 'NaN In ONECOND3'
+ 	  call wrf_error_fatal("fatal error in ONECOND3 (RW or PW are NaN), model stop")
+ 	ENDIF
+
+ 	! DEL1 > 0, DEL2 < 0    (ANTIBERGERON MIXED PHASE - KCOND=50)
+ 	! DEL1 < 0 AND DEL2 < 0 (EVAPORATION MIXED_PHASE - KCOND=30)
+ 	! DEL1 > 0 AND DEL2 > 0 (CONDENSATION MIXED PHASE - KCOND=31)
+ 	! DEL1 < 0, DEL2 > 0    (BERGERON MIXED PHASE - KCOND=32)
+
+  KCOND=50
+ 	IF(DEL1N .LT. 0.0 .AND. DEL2N .LT. 0.0) KCOND=30
+ 	IF(DEL1N .GT. 0.0 .AND. DEL2N .GT. 0.0) KCOND=31
+ 	IF(DEL1N .LT. 0.0 .AND. DEL2N .GT. 0.0) KCOND=32
+
+ 	IF(KCOND == 50) THEN
+ 		DTNEWL = DT
+    DTNEWL = AMIN1(DTNEWL,TIMEREV)
+    TIMENEW = TIMENEW + DTNEWL
+    DTT = DTNEWL
+
+ 		! ... Incase the Anti-Bregeron regime we do not call diffusional-growth
+ 		PRINT*, "Anti-Bregeron Regime, No DIFFU"
+ 		PRINT*,  DEL1, DEL2, TT, QQ, Kin
+ 		GO TO 17
+ 	  ! IN CASE : KCOND = 50
+  ENDIF
+  IF(KCOND == 31) THEN
+		! ... DEL1 > 0 AND DEL2 > 0 (CONDENSATION MIXED PHASE - KCOND=31)
+		! ... CONDENSATION MIXED PHASE (BEGIN)
+	  DTNEWL = DT
+    DTNEWL = AMIN1(DTNEWL,TIMEREV)
+    TIMENEW = TIMENEW + DTNEWL
+    DTT = DTNEWL
+		! CONDENSATION MIXED PHASE (END)
+	! IN CASE : KCOND = 31
+  ENDIF
+   IF(KCOND == 30) THEN
+ 		! ... DEL1 < 0 AND DEL2 < 0 (EVAPORATION MIXED_PHASE - KCOND=30)
+ 		! ... EVAPORATION MIXED PHASE (BEGIN)
+ 		DTNEWL = DT
+    DTNEWL = AMIN1(DTNEWL,TIMEREV)
+    TIMENEW = TIMENEW + DTNEWL
+    DTT = DTNEWL
+ 	! EVAPORATION MIXED PHASE (END)
+ 	! IN CASE : KCOND = 30
+ 	ENDIF
+ 	IF(KCOND == 32) THEN
+ 		! ... IF(DEL1N < 0.0 .AND. DEL2N > 0.0) KCOND=32
+ 		! ... BERGERON MIXED PHASE (BEGIN)
+ 		DTNEWL = DT
+    DTNEWL = AMIN1(DTNEWL,TIMEREV)
+    TIMENEW = TIMENEW + DTNEWL
+    DTT = DTNEWL
+ 	! BERGERON MIXED PHASE (END)
+ 	! IN CASE : KCOND = 32
+ 	ENDIF
+
+   IF (DTT < 0.0) call wrf_error_fatal("fatal error in ONECOND3:(DTT<0), model stop")
+
+ 	DEL1_d = DEL1
+ 	DEL2_d = DEL2
+ 	RW_d = RW
+ 	PW_d = PW
+ 	RI_d = RI
+ 	PI_d = PI
+ 	CALL JERSUPSAT_KS(DEL1_d,DEL2_d,DEL1N,DEL2N, &
+ 						RW_d,PW_d,RI_d,PI_d, &
+ 						DTT,D1N_d,D2N_d,0.0,0.0, &
+ 						ISYM1,ISYM2,ISYM3,ISYM4,ISYM5)
+ 	DEL1 = DEL1_d
+ 	DEL2 = DEL2_d
+ 	RW = RW_d
+ 	PW = PW_d
+ 	RI = RI_d
+ 	PI = PI_d
+ 	D1N = D1N_d
+ 	D2N = D2N_d
+
+ 	IF(ISYM1 == 1) THEN
+ 		! DROPLETS
+ 		! DROPLET DISTRIBUTION FUNCTION
+ 		IDROP = ISYM1
+ 		FL1 = 0.0
+ 		CALL JERDFUN_KS(R1D, R1ND, B11_MY, &
+ 						FI1, PSI1, fl1, D1N, &
+ 						ISYM1, 1, 1, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 1, Iin, Jin ,Kin, Itimestep)
+ 		! IN CASE ISYM1.NE.0
+ 	ENDIF
+ 	IF(sum(ISYM2) > 0) THEN
+ 		! CRYSTALS
+ 		IDROP = 0
+ 		FL1 = 0.0
+ 		IF(ISYM2(1)==1)THEN
+ 			CALL JERDFUN_KS(R2D(:,1), R2ND(:,1), B21_MY(:,1), &
+ 						    FI2(:,1), PSI2(:,1), fl1, D2N, &
+ 							ISYM2(1), ICM, 1, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 21, Iin, Jin ,Kin, Itimestep)
+ 		ENDIF
+ 		IF(ISYM2(2)==1)THEN
+ 	  		CALL JERDFUN_KS(R2D(:,2), R2ND(:,2), B21_MY(:,2), &
+ 						    FI2(:,2), PSI2(:,2), fl1, D2N, &
+ 							ISYM2(2), ICM, 2, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 22, Iin, Jin ,Kin, Itimestep)
+ 		ENDIF
+ 		IF(ISYM2(3)==1)THEN
+ 	  		CALL JERDFUN_KS(R2D(:,3), R2ND(:,3), B21_MY(:,3), &
+ 						    FI2(:,3), PSI2(:,3), fl1, D2N, &
+ 							ISYM2(3), ICM, 3, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 23, Iin, Jin ,Kin, Itimestep)
+ 		ENDIF
+ 	ENDIF
+
+ 	IF(ISYM3 == 1) THEN
+ 		! SNOW
+ 		IDROP = 0
+ 		FL3 = 0.0
+ 		CALL JERDFUN_KS(R3D, R3ND, B31_MY, &
+ 						FI3, PSI3, fl3, D2N, &
+ 						ISYM3, 1, 3, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 3, Iin, Jin ,Kin, Itimestep)
+ 	! IN CASE ISYM3.NE.0
+ 	ENDIF
+
+ 	IF(ISYM4 == 1) THEN
+ 	! GRAUPELS
+ 		IDROP = 0
+ 		FL4 = 0.0
+ 		CALL JERDFUN_KS(R4D, R4ND, B41_MY, &
+ 						FI4, PSI4, fl4, D2N, &
+ 						ISYM4, 1, 4, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 4, Iin, Jin ,Kin, Itimestep)
+
+ 	! IN CASE ISYM4.NE.0
+ 	ENDIF
+
+    IF(ISYM5 == 1) THEN
+     ! HAIL
+ 	  IDROP = 0
+ 	  FL5 = 0.0
+ 	  CALL JERDFUN_KS(R5D, R5ND, B51_MY, &
+ 					FI5, PSI5, fl5, D2N, &
+ 					ISYM5, 1, 5, TPN, IDROP, FR_LIM, FRH_LIM, ICEMAX, NKR, COL, 5, Iin, Jin ,Kin, Itimestep)
+  ! IN CASE ISYM5.NE.0
+  ENDIF
+
+ RMASSLBB=0.D0
+ RMASSIBB=0.D0
+ RMASSLAA=0.D0
+ RMASSIAA=0.D0
+
+ DO K=1,NKR
+  FI1_K=FI1(K)
+  R1_K=R1(K)
+  FI1R1=FI1_K*R1_K*R1_K
+  RMASSLBB=RMASSLBB+FI1R1
+  DO ICE =1,ICEMAX
+ 	FI2_K=FI2(K,ICE)
+ 	R2_K=R2(K,ICE)
+ 	FI2R2=FI2_K*R2_K*R2_K
+ 	RMASSIBB=RMASSIBB+FI2R2
+  ENDDO
+ 	 FI3_K=FI3(K)
+ 	 FI4_K=FI4(K)
+ 	 FI5_K=FI5(K)
+ 	 R3_K=R3(K)
+ 	 R4_K=R4(K)
+ 	 R5_K=R5(K)
+ 	 FI3R3=FI3_K*R3_K*R3_K
+ 	 FI4R4=FI4_K*R4_K*R4_K
+ 	 FI5R5=FI5_K*R5_K*R5_K
+ 	 RMASSIBB=RMASSIBB+FI3R3
+ 	 RMASSIBB=RMASSIBB+FI4R4
+ 	 RMASSIBB=RMASSIBB+FI5R5
+   ENDDO
+   RMASSIBB=RMASSIBB*COL3*RORI
+   IF(RMASSIBB.LT.0.0) RMASSIBB=0.0
+   RMASSLBB=RMASSLBB*COL3*RORI
+   IF(RMASSLBB.LT.0.0) RMASSLBB=0.0
+   DO K=1,NKR
+ 	 FI1_K=PSI1(K)
+ 	 R1_K=R1(K)
+ 	 FI1R1=FI1_K*R1_K*R1_K
+ 	 RMASSLAA=RMASSLAA+FI1R1
+ 	 DO ICE =1,ICEMAX
+ 		FI2(K,ICE)=PSI2(K,ICE)
+ 		FI2_K=FI2(K,ICE)
+ 		R2_K=R2(K,ICE)
+ 		FI2R2=FI2_K*R2_K*R2_K
+ 		RMASSIAA=RMASSIAA+FI2R2
+ 	 ENDDO
+ 	 FI3_K=PSI3(K)
+ 	 FI4_K=PSI4(K)
+ 	 FI5_K=PSI5(K)
+ 	 R3_K=R3(K)
+ 	 R4_K=R4(K)
+ 	 R5_K=R5(K)
+ 	 FI3R3=FI3_K*R3_K*R3_K
+ 	 FI4R4=FI4_K*R4_K*R4_K
+ 	 FI5R5=FI5_K*R5_K*R5_K
+ 	 RMASSIAA=RMASSIAA+FI3R3
+ 	 RMASSIAA=RMASSIAA+FI4R4
+ 	 RMASSIAA=RMASSIAA+FI5R5
+   ENDDO
+ 	RMASSIAA=RMASSIAA*COL3*RORI
+ 	IF(RMASSIAA.LE.0.0) RMASSIAA=0.0
+ 	RMASSLAA=RMASSLAA*COL3*RORI
+ 	IF(RMASSLAA.LT.0.0) RMASSLAA=0.0
+
+ 	DELMASSL1=RMASSLAA-RMASSLBB
+ 	DELMASSI1=RMASSIAA-RMASSIBB
+ 	DELTAQ1=DELMASSL1+DELMASSI1
+ 	QPN=QPS-DELTAQ1
+ 	DAL1=AL1
+ 	DAL2=AL2
+ 	TPN = TPS + DAL1*DELMASSL1+DAL2*DELMASSI1
+
+ 	IF(ABS(DAL1*DELMASSL1+DAL2*DELMASSI1) > 5.0 )THEN
+ 		print*,"ONECOND3-input-start"
+ 		print*,"TTinput",TTinput,"QQinput",QQinput,"PP",PP
+ 		print*,'DEL1Ninput',DEL1Ninput,'DEL2Ninput',DEL2Ninput
+ 		print*,"ROR",ROR,'VR1',VR1,'PSINGLE',PSINGLE
+ 		print*,'DIV1',DIV1,'DIV2',DIV2
+ 		print*,'R1',R1,'RLEC',RLEC,'RO1BL',RO1BL
+ 		print*,'const',AA1_MY,BB1_MY,AA2_MY,BB2_MY
+ 		print*,'const',C1_MEY,C2_MEY,COL
+ 		print*,'DTCOND',DTCOND,'ICEMAX',ICEMAX,'NKR',NKR
+ 		print*,'ISYM1',ISYM1,'ISYM2',ISYM2,'ISYM3',ISYM3,'ISYM4',ISYM4,'ISYM5',ISYM5
+ 		print*,Iin,Jin,Kin,W_in,DX_in
+ 		print*,"ONECOND3-input-end"
+
+ 		print*,"ONECOND3-out (start)"
+ 		print*,"I=",Iin,"J=",Jin,"Kin",Kin,"W",w_in,"DX",dx_in
+ 		print*,"DEL1N,DEL2N,D1N,D2N,RW,PW,RI,PI,DT"
+ 		print*,DEL1N,DEL2N,D1N,D2N,RW,PW,RI,PI,DTT
+ 		print*,"TPS=",TPS,"TPN=",TPN,"QPS=",QPS,"delmassl1",delmassl1,"delmassi1",delmassi1
+ 		print*,"DAL2=",DAL2,"DAL1=",DAL1
+ 		print*,RMASSLAA,RMASSLBB
+ 		print*,RMASSIAA,RMASSIBB
+ 		print*,"FI1",FI1
+ 		print*,"FI3",FI3
+ 		print*,"FI4",FI4
+ 		print*,"FI5",FI5
+ 		print*,"PSI1",PSI1
+ 		print*,"R1D",R1D,"R1ND",R1ND
+ 		print*,"PSI3",PSI3
+ 		print*,"R3D",R3D,"R3ND",R3ND
+ 		print*,"PSI4",PSI4
+ 		print*,"R4D",R4D,"R4ND",R4ND
+ 		print*,"PSI5",PSI5
+ 		print*,"R5D",R5D,"R5ND",R5ND
+ 		print*,"ONECOND3-out (end)"
+ 		IF(ABS(DAL1*DELMASSL1+DAL2*DELMASSI1) > 5.0 )THEN
+ 			call wrf_error_fatal("fatal error in ONECOND3-out (ABS(DAL1*DELMASSL1+DAL2*DELMASSI1) > 5.0), model stop")
+ 		ENDIF
+ 	ENDIF
+
+ ! SUPERSATURATION
+ 	ARGEXP=-BB1_MY/TPN
+ 	ES1N=AA1_MY*DEXP(ARGEXP)
+ 	ARGEXP=-BB2_MY/TPN
+ 	ES2N=AA2_MY*DEXP(ARGEXP)
+ 	EW1N=OPER3(QPN,PP)
+ 	IF(ES1N == 0.0)THEN
+ 	 DEL1N=0.5
+ 	 DIV1=1.5
+ 	 print*,'es1n onecond3 = 0'
+ 	 call wrf_error_fatal("fatal error in ONECOND3 (ES1N.EQ.0), model stop")
+ 	ELSE
+ 	 DIV1=EW1N/ES1N
+ 	 DEL1N=EW1N/ES1N-1.
+ 	END IF
+ 	IF(ES2N == 0.0)THEN
+ 	 DEL2N=0.5
+ 	 DIV2=1.5
+ 	 print*,'es2n onecond3 = 0'
+ 	 call wrf_error_fatal("fatal error in ONECOND3 (ES2N.EQ.0), model stop")
+ 	ELSE
+ 	 DEL2N=EW1N/ES2N-1.
+ 	 DIV2=EW1N/ES2N
+ 	END IF
+ 	! END OF TIME SPLITTING
+
+ 	IF(TIMENEW < DT) GOTO 16
+ 	17 CONTINUE
+
+ 	TT=TPN
+ 	QQ=QPN
+ 	DO KR=1,NKR
+ 	   FF1(KR)=PSI1(KR)
+ 	   DO ICE=1,ICEMAX
+ 	      FF2(KR,ICE)=PSI2(KR,ICE)
+ 	   ENDDO
+ 	   FF3(KR)=PSI3(KR)
+ 	   FF4(KR)=PSI4(KR)
+ 	   FF5(KR)=PSI5(KR)
+ 	ENDDO
+
+   RETURN
+   END SUBROUTINE ONECOND3
+ ! +---------------------------------------------------------+
+ 	SUBROUTINE COAL_BOTT_NEW(FF1R,FF2R,FF3R,                      &
+ 							      FF4R,FF5R,TT,QQ,PP,RHO,dt_coll,TCRIT,TTCOAL,&
+			              FLIQFR_S,FLIQFR_G,FLIQFR_H,FRIMFR_S,        &
+				            DEL1in, DEL2in,                             &
+  		              Iin,Jin,Kin,CollEff)
+
+    use module_mp_SBM_Collision,only:coll_xyy_lwf,coll_xyx_lwf,coll_xxx_lwf,    &
+ 								                     coll_xyz_lwf, modkrn_KS, coll_breakup_KS, 	&
+				                             coll_xxy_lwf
+
+     implicit none
+
+     integer,intent(in) :: Iin,Jin,Kin
+     real(kind=r4size),intent(in) :: tcrit,ttcoal,dt_coll
+     real(kind=r4size),intent(inout) :: ff1r(:),ff2r(:,:),ff3r(:),ff4r(:),  &
+                                        ff5r(:),colleff
+     real(kind=r8size),intent(inout) :: fliqfr_s(:),fliqfr_g(:),fliqfr_h(:), &
+                                       frimfr_s(:),del1in,del2in,tt,qq
+     real(kind=r8size),intent(in) :: pp
+
+ 	   integer :: KR,ICE,icol_drop,icol_snow,icol_graupel,icol_hail, &
+      		      icol_column,icol_plate,icol_dendrite,icol_drop_brk
+     real(kind=r8size) :: g1(nkr),g2(nkr,icemax),g3(nkr),g4(nkr),g5(nkr), &
+                          gdumb(JMAX),gdumb_bf_breakup(JMAX),xl_dumb(JMAX), &
+                          g_orig(nkr),g2_1(nkr),g2_2(nkr),g2_3(nkr)
+     real(kind=r4size) :: cont_fin_drop,dconc,conc_icempl,deldrop,t_new, &
+      	                 delt_new,cont_fin_ice,conc_old,conc_new,cont_init_ice, &
+  		                   cont_init_drop,ALWC,T_new_real,PP_r,rho,ES1N,ES2N,EW1N
+     real(kind=r4size),parameter :: tt_no_coll=273.16
+
+     integer :: I,J,IT,NDIV
+     real(kind=r8size) :: break_drop_bef,break_drop_aft,dtbreakup,break_drop_per, &
+                          prdkrn,fl1(nkr),rf1(nkr),rf3(nkr),fl3(nkr), &
+                          fl4(nkr),fl5(nkr),fl2_1(nkr),fl2_2(nkr),fl2_3(nkr), &
+                          rf2(nkr),rf4(nkr),rf5(nkr),conc_drop_old, conc_drop_new, &
+                          dconc_drop, dm_rime(nkr), conc_plate_icempl, &
+                          col3, cont_coll_drop
+     real(kind=r8size),parameter :: prdkrn1 = 1.0d0
+     real(kind=r4size),parameter :: prdkrn1_r = 1.0
+ 	   integer,parameter :: icempl = 1
+ 	   real(kind=r8size),parameter :: t_ice_mpl = 270.15D0 ! for ice multiplication in temp > 268.15
+ 	   real(kind=r8size),PARAMETER :: g_lim = 1.0D-19*1.0D3,AA1_MY = 2.53E12,  &
+                                    BB1_MY = 5.42E3, AA2_MY = 3.41E13 ,BB2_MY = 6.13E3
+
+    icol_drop_brk=0
+    icol_drop=0
+    icol_snow=0
+    icol_graupel=0
+    icol_hail=0
+    icol_column=0
+    icol_plate=0
+    icol_dendrite=0
+    t_new = tt
+
+    PP_r = PP
+    call Kernals_KS(dt_coll,nkr,PP_r)
+    CALL MODKRN_KS(TT,QQ,PP,RHO,PRDKRN,TTCOAL,1,1,Iin,Jin,Kin)
+
+ 	  CollEff = PRDKRN
+
+    DO KR=1,NKR
+      G1(KR)=FF1R(KR)*3.*XL(KR)*XL(KR)*1.E3
+      G2(KR,1)=FF2R(KR,1)*3*xi(KR,1)*XI(KR,1)*1.e3
+      G2(KR,2)=FF2R(KR,2)*3.*xi(KR,2)*XI(KR,2)*1.e3
+      G2(KR,3)=FF2R(KR,3)*3.*xi(KR,3)*XI(KR,3)*1.e3
+      G3(KR)=FF3R(KR)*3.*xs(kr)*xs(kr)*1.e3
+      G4(KR)=FF4R(KR)*3.*xg(kr)*xg(kr)*1.e3
+      G5(KR)=FF5R(KR)*3.*xh(kr)*xh(kr)*1.e3
+      g2_1(kr)=g2(KR,1)
+      g2_2(KR)=g2(KR,2)
+      g2_3(KR)=g2(KR,3)
+      if(kr .gt. KRMIN_BREAKUP .and. g1(kr) > g_lim) icol_drop_brk = 1
+      IF (IBREAKUP.NE.1) icol_drop_brk = 0
+      if(g1(kr).gt.g_lim) icol_drop=1
+      if(g2_1(kr).gt.g_lim) icol_column = 1
+      if(g2_2(kr).gt.g_lim) icol_plate = 1
+      if(g2_3(kr).gt.g_lim) icol_dendrite = 1
+      if(g3(kr).gt.g_lim) icol_snow = 1
+      if(g4(kr).gt.g_lim) icol_graupel = 1
+      if(g5(kr).gt.g_lim) icol_hail = 1
+    END DO
+
+ 	  fl1 = 1.0
+ 	  fl3(:) = FLIQFR_S(:)
+ 	  fl4(:) = FLIQFR_G(:)
+ 	  fl5(:) = FLIQFR_H(:)
+ 	  rf1 = 1.0
+ 	  rf3(:) = FRIMFR_S(:)
+ 	  rf4(:) = 0.0
+ 	  rf5(:) = 0.0
+
+
+ ! calculation of initial hydromteors content in g/cm**3 :
+  cont_init_drop=0.
+  cont_init_ice=0.
+  do kr=1,nkr
+    cont_init_drop=cont_init_drop+g1(kr)
+    cont_init_ice=cont_init_ice+g3(kr)+g4(kr)+g5(kr)
+    do ice=1,icemax
+      cont_init_ice=cont_init_ice+g2(kr,ice)
+    enddo
+  enddo
+  cont_init_drop=col*cont_init_drop*1.e-3
+  cont_init_ice=col*cont_init_ice*1.e-3
+! calculation of alwc in g/m**3
+  alwc=cont_init_drop*1.e6
+! calculation interactions :
+! droplets - droplets and droplets - ice :
+! water-water = water
 
+  if (icol_drop.eq.1)then
+! ... Drop-Drop collisions
+  fl1 = 1.0
+  call coll_xxx_lwf (G1,fl1,CWLL,XL_MG,CHUCM,IMA,1.d0,NKR)
+! ... Breakup
+  if(icol_drop_brk == 1)then
+    ndiv = 1
+    10     	continue
+    do it = 1,ndiv
+      if (ndiv > 1024)print*,'ndiv in coal_bott_new = ',ndiv
+      if (ndiv > 1024) go to 11
+      dtbreakup = dt_coll/ndiv
+      if (it == 1)then
+        do kr=1,JMAX
+          gdumb(kr)= g1(kr)*1.D-3
+          gdumb_bf_breakup(kr) =  g1(kr)*1.D-3
+          xl_dumb(kr)=xl_mg(KR)*1.D-3
+        end do
+        break_drop_bef=0.d0
+        do kr=1,JMAX
+          break_drop_bef = break_drop_bef+g1(kr)*1.D-3
+        end do
+      end if
 
+      call coll_breakup_KS(gdumb, xl_dumb, JMAX, dtbreakup, JBREAK, PKIJ, QKJ, NKR, NKR)
 
-! IN CASE : ISYM3.NE.0
+      do KR=1,NKR
+        FF1R(KR) = (1.0d3*GDUMB(KR))/(3.*XL(KR)*XL(KR)*1.E3)
+        if(GDUMB(KR) < 0.0)then
+          go to 11
+          !call wrf_error_fatal("in coal_bott af-coll_breakup - FF1R/GDUMB < 0.0")
+        endif
+        if(GDUMB(kr) .ne. GDUMB(kr)) then
+          print*,kr,GDUMB(kr),GDUMB_BF_BREAKUP(kr),XL(kr)
+          print*,IT,NDIV, DTBREAKUP
+          print*,GDUMB
+          print*,GDUMB_BF_BREAKUP
+          call wrf_error_fatal("in coal_bott af-coll_breakup - FF1R NaN, model stop")
+        endif
+      enddo
+    end do
+
+    break_drop_aft=0.0d0
+    do kr=1,JMAX
+      break_drop_aft=break_drop_aft+gdumb(kr)
+    end do
+    break_drop_per=break_drop_aft/break_drop_bef
+    if (break_drop_per > 1.001)then
+      ndiv=ndiv*2
+      GO TO 10
+    else
+      do kr=1,JMAX
+        g1(kr) = gdumb(kr)*1.D3
+      end do
+    end if
+  ! if icol_drop_brk.eq.1
+  end if
+! if icol_drop.eq.1
+end if
+
+11   continue
+ ! +--------------------------------------------------------+
+ ! Negative temperature collisions block (start)
+ ! +---------------------------------------------------------+
+ 	if(tt <= 273.15)then
+ 		if(icol_drop == 1)then
+ 			! ... interactions between drops and snow
+ 			!	    drop - snow = graupel/hail
+ 			!	    snow - drop = snow
+      !          or
+ 			!     snow - drop = graupel/hail
+  		if (icol_snow == 1)then
+ 				rf1 = 1.0
+ 				rf5 = 0.0
+ 				rf4 = 0.0
+ 				if(hail_opt == 1)then
+ 					call coll_xyz_lwf(g1,g3,g5,rf1,rf3,rf5,cwls,xl_mg,xs_mg, &
+             	         	   	      	 chucm,ima,prdkrn1,nkr,0)
+ 				else
+ 					call coll_xyz_lwf(g1,g3,g4,rf1,rf3,rf4,cwls,xl_mg,xs_mg, &
+             	         	   		  	  chucm,ima,prdkrn1,nkr,0)
+ 				endif
+		    rf1 = 1.0
+        rf5 = 0.0
+        rf4 = 0.0
+		    if(alwc < alcr) then
+    			call coll_xyx_lwf(g3,g1,rf3,rf1,cwsl,xs_mg,xl_mg, &
+         	         		      chucm,ima,prdkrn1,nkr,1,dm_rime)
+		    else
+ 					if(hail_opt == 1)then
+ 						call coll_xyz_lwf(g3,g1,g5,rf3,rf1,rf5,cwsl,xs_mg,xl_mg, &
+									           chucm,ima,prdkrn1,nkr,1)
+ 					else
+ 						call coll_xyz_lwf(g3,g1,g4,rf3,rf1,rf4,cwsl,xs_mg,xl_mg, &
+ 										         chucm,ima,prdkrn1,nkr,1)
+ 					endif
+ 				endif
+ 			! in case : icolxz_snow.ne.0
+ 			end if
+
+  		if (icol_graupel == 1) then
+ 			! ... interactions between drops and graupel
+ 			!     drops - graupel = graupel
+ 			!     graupel - drops = graupel
+ 			!     drops - graupel = hail (no transition in FSBM)
+ 			!     graupel - drop = hail (no transition in FSBM)
+    		if(alwc < alcr_g) then
+  		    rf1 = 1.0
+  		    rf4 = 0.0
+  				call coll_xyy_lwf(g1,g4,rf1,rf4,cwlg,xl_mg,xg_mg, &
+    		 	     	         	  chucm,ima,prdkrn1,nkr,0)
+   					! ... for ice multiplication
+   					conc_old = 0.0
+       			conc_new = 0.0
+   					do kr = kr_icempl,nkr
+   						conc_old = conc_old+col*g1(kr)/xl_mg(kr)
+       			end do
+       			rf1 = 1.0
+       			rf4 = 0.0
+   					call coll_xyx_lwf(g4,g1,rf4,rf1,cwgl,xg_mg,xl_mg, &
+   		 							           chucm,ima,prdkrn1,nkr,1,dm_rime)
+  			else
+          rf1 = 1.0
+          rf5 = 0.0
+          rf4 = 0.0
+ 					call coll_xyz_lwf(g1,g4,g5,rf1,rf4,rf5,cwlg,xl_mg,xg_mg, &
+           			      			  chucm,ima,prdkrn1,nkr,1)
+ 					! ... for ice multiplication
+ 					conc_old = 0.0
+   			  conc_new = 0.0
+ 					do kr = kr_icempl,nkr
+				    conc_old = conc_old+col*g1(kr)/xl_mg(kr)
+   				enddo
+          rf1 = 1.0
+          rf5 = 0.0
+          rf4 = 0.0
+ 					call coll_xyz_lwf(g4,g1,g5,rf4,rf1,rf5,cwgl,xg_mg,xl_mg, &
+           			            chucm,ima,prdkrn1,nkr,1)
+    		end if
+ 			! in case icol_graup == 1
+  		endif
+
+  		if(icol_hail == 1) then
+   			! interactions between drops and hail
+   			! drops - hail = hail
+   			! hail - water = hail
+         rf1 = 1.0
+         rf5 = 0.0
+  	     call coll_xyy_lwf(g1,g5,rf1,rf5,cwlh,xl_mg,xh_mg, &
+             		          chucm,ima,prdkrn1,nkr,0)
+  			 ! ... for ice multiplication
+  			 conc_old = 0.0
+       	 conc_new = 0.0
+  			 do kr = kr_icempl,nkr
+  			  conc_old = conc_old+col*g1(kr)/xl_mg(kr)
+  	     enddo
+   			rf1 = 1.0
+   			rf5 = 0.0
+  			call coll_xyx_lwf(g5,g1,rf5,rf1,cwhl,xh_mg,xl_mg, &
+                 			   chucm,ima,prdkrn1,nkr,1,dm_rime)
+   		! in case icol_hail == 1
+  		endif
+
+ 			if((icol_graupel == 1 .or. icol_hail == 1) .and. icempl == 1) then
+ 				if(tt .ge. 265.15 .and. tt .le. tcrit) then
+ 				! ... ice-multiplication (H-M) :
+ 					do kr = kr_icempl,nkr
+ 					   conc_new=conc_new+col*g1(kr)/xl_mg(kr)
+ 					enddo
+ 					dconc = conc_old-conc_new
+ 					if(tt .le. 268.15) then
+ 						conc_icempl=dconc*4.e-3*(265.15-tt)/(265.15-268.15)
+ 					endif
+ 					if(tt .gt. 268.15) then
+ 						conc_icempl=dconc*4.e-3*(tcrit-tt)/(tcrit-268.15)
+ 					endif
+ 					!g2_2(1)=g2_2(1)+conc_icempl*xi2_mg(1)/col
+ 					 g3(1)=g3(1)+conc_icempl*xs_mg(1)/col ! [KSS] >> FAST-sbm has small snow as IC
+ 				! in case t.ge.265.15 :
+ 				endif
+ 			! in case icempl=1
+ 			endif
+ 		! if icol_drop.eq.1
+ 		endif
+
+ 		if(icol_snow == 1) then
+ 		! ... interactions between snowflakes
+			call coll_xxx_lwf(g3,rf3,cwss,xs_mg,chucm,ima,prdkrn,nkr)
+ 		! in case icolxz_snow.ne.0
+ 		endif
+
+ 	  ! in case : t > TTCOAL
+  	endif ! if tt <= 273.15
+ ! Negative temp. collision block (end)
+ ! +-----------------------------------------------+
+
+    cont_fin_drop=0.
+    cont_fin_ice=0.
+    do kr=1,nkr
+      g2(kr,1)=g2_1(kr)
+      g2(kr,2)=g2_2(kr)
+      g2(kr,3)=g2_3(kr)
+      cont_fin_drop=cont_fin_drop+g1(kr)
+      cont_fin_ice=cont_fin_ice+g3(kr)+g4(kr)+g5(kr)
+      do ice=1,icemax
+         cont_fin_ice=cont_fin_ice+g2(kr,ice)
+      enddo
+    enddo
+    cont_fin_drop=col*cont_fin_drop*1.e-3
+    cont_fin_ice=col*cont_fin_ice*1.e-3
+    deldrop=cont_init_drop-cont_fin_drop ! [g/cm**3]
+ ! riming temperature correction (rho in g/cm**3) :
+     if(t_new <= 273.15) then
+       if(deldrop >= 0.0) then
+          t_new = t_new + 320.*deldrop/rho
+  	        ES1N = AA1_MY*DEXP(-BB1_MY/t_new)
+            ES2N = AA2_MY*DEXP(-BB2_MY/t_new)
+          EW1N = QQ*PP/(0.622+0.378*QQ)
+            DEL1in = EW1N/ES1N - 1.0
+            DEL2in = EW1N/ES2N - 1.0
+       else
+  	     ! if deldrop < 0
+         if(abs(deldrop).gt.cont_init_drop*0.05) then
+           call wrf_error_fatal("fatal error in module_mp_fast_sbm (abs(deldrop).gt.cont_init_drop), model stop")
+         endif
+       endif
+      endif
 
-	        ENDIF
+ 61   continue
+ ! recalculation of density function f1,f3,f4,f5 in  units [1/(g*cm**3)] :
+     DO KR=1,NKR
+        FF1R(KR)=G1(KR)/(3.*XL(KR)*XL(KR)*1.E3)
+        if((FF1R(kr) .ne. FF1R(kr)) .or. FF1R(kr) < 0.0)then
+	 	       print*,"G1",G1
+ 		 	     call wrf_error_fatal("stop at end coal_bott - FF1R NaN or FF1R < 0.0, model stop")
+	      endif
+        FF3R(KR)=G3(KR)/(3.*xs(kr)*xs(kr)*1.e3)
+          if((FF3R(kr) .ne. FF3R(kr)) .or. FF3R(kr) < 0.0)then
+           call wrf_error_fatal("stop at end coal_bott - FF3R NaN or FF3R < 0.0, model stop")
+          endif
+ 		   if(hail_opt == 0)then
+ 		 	   FF4R(KR)=G4(KR)/(3.*xg(kr)*xg(kr)*1.e3)
+      	 if((FF4R(kr) .ne. FF4R(kr)) .or. FF4R(kr) < 0.0) then
+          call wrf_error_fatal("stop at end coal_bott - FF4R NaN or FF4R < 0.0, model stop")
+         end if
+      else
+ 		 	   FF5R(KR)=G5(KR)/(3.*xh(kr)*xh(kr)*1.e3)
+		     if((FF5R(kr) .ne. FF5R(kr)) .or. FF5R(kr) < 0.0) then
+           call wrf_error_fatal("stop at end coal_bott - FF5R NaN or FF5R < 0.0, model stop")
+         endif
+ 		 endif
+ 		END DO
+ 15   CONTINUE
+
+ 	FLIQFR_S(:) = fl3(:)
+ 	FLIQFR_G(:) = fl4(:)
+ 	FLIQFR_H(:) = fl5(:)
+ 	FRIMFR_S(:) = rf3(:)
+
+ 	if (abs(tt-t_new).gt.5.0) then
+ 		call wrf_error_fatal("fatal error in module_mp_FAST_sbm Del_T 5 K, model stop")
+ 	endif
+
+  tt = t_new
+
+ 	RETURN
+ 	END SUBROUTINE COAL_BOTT_NEW
+ ! ..................................................................................................
+     SUBROUTINE BREAKINIT_KS(PKIJ,QKJ,ECOALMASSM,BRKWEIGHT,XL_r,DROPRADII,BR_MAX,JBREAK,JMAX,NKR,VR1)
+
+     USE module_domain
+     USE module_dm
+
+     IMPLICIT NONE
+
+ ! ... Interface
+     integer,intent(in) :: br_max, JBREAK, NKR, JMAX
+     real(kind=r8size),intent(inout) :: ECOALMASSM(:,:),BRKWEIGHT(:)
+     real,intent(in) :: XL_r(:), DROPRADII(:), VR1(:)
+     real(kind=r4size),intent(inout) :: PKIJ(:,:,:),QKJ(:,:)
+ ! ... Interface
+
+     !REAL :: XL_r(size(NKR))
+     INTEGER :: hujisbm_unit1
+     LOGICAL, PARAMETER :: PRINT_diag=.FALSE.
+     LOGICAL :: opened
+     LOGICAL , EXTERNAL :: wrf_dm_on_monitor
+     CHARACTER*80 errmess
+
+ !.....INPUT VARIABLES
+ !
+ !     GT    : MASS DISTRIBUTION FUNCTION
+ !     XT_MG : MASS OF BIN IN MG
+ !     JMAX  : NUMBER OF BINS
+
+ !.....LOCAL VARIABLES
+
+     DOUBLE PRECISION :: XL_d(NKR), DROPRADII_d(NKR), VR1_d(NKR)
+     INTEGER :: IE,JE,KE
+     INTEGER,PARAMETER :: AP = 1
+     INTEGER :: I,J,K,JDIFF
+     REAL :: RPKIJ(JBREAK,JBREAK,JBREAK),RQKJ(JBREAK,JBREAK)
+     REAL :: PI,D0,HLP
+     DOUBLE PRECISION :: M(0:JBREAK),ALM
+     REAL :: DBREAK(JBREAK),GAIN,LOSS
+
+ !.....DECLARATIONS FOR INIT
+     INTEGER :: IP,KP,JP,KQ,JQ
+     REAL :: XTJ
+
+     CHARACTER*256 FILENAME_P,FILENAME_Q, file_p, file_q
+
+     xl_d = xl_r
+
+     IE = JBREAK
+     JE = JBREAK
+     KE = JBREAK
+
+     if(nkr == 43) file_p = 'SBM_input_43/'//'coeff_p43.dat'
+     if(nkr == 43) file_q = 'SBM_input_43/'//'coeff_q43.dat'
+     if(nkr == 33) file_p = 'SBM_input_33/'//'coeff_p_new_33.dat' ! new Version 33 (taken from 43bins)
+     if(nkr == 33) file_q = 'SBM_input_33/'//'coeff_q_new_33.dat' ! new Version 33   (taken from 43 bins)
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+         DO i = 20,99
+             INQUIRE ( i , OPENED = opened )
+             IF ( .NOT. opened ) THEN
+                 hujisbm_unit1 = i
+                 GOTO 2061
+             ENDIF
+         ENDDO
+         2061     CONTINUE
+     ENDIF
 
-! GRAUPELS (ONLY_ICE: EVAPORATION) 
+     CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
 
-	        IF(ISYM4.NE.0) THEN
+     IF ( hujisbm_unit1 < 0 ) THEN
+       CALL wrf_error_fatal ( 'Can not find unused fortran unit to read in BREAKINIT_KS lookup table, model stop' )
+     ENDIF
 
-! GRAUPEL DISTRIBUTION FUNCTION (ONLY_ICE: EVAPORATION) 
-                                                         
-	          CALL JERDFUN(R4,B41_MY,B42_MY &
-     &                        ,FI4,PSI4,D2N &
-     &                        ,1,4,COL,NKR,TPN)
-! IN CASE : ISYM4.NE.0
+     IF ( wrf_dm_on_monitor() ) THEN
+       OPEN(UNIT=hujisbm_unit1,FILE=trim(file_p),         &
+       !OPEN(UNIT=hujisbm_unit1,FILE="coeff_p.asc",       &
+            FORM="FORMATTED",STATUS="OLD",ERR=2070)
 
-	        ENDIF
+         DO K=1,KE
+             DO I=1,IE
+                 DO J=1,I
+                 READ(hujisbm_unit1,'(3I6,1E16.8)') KP,IP,JP,PKIJ(KP,IP,JP) ! PKIJ=[g^3*cm^3/s]
+                 ENDDO
+             ENDDO
+         ENDDO
+         CLOSE(hujisbm_unit1)
+     END IF
+
+     hujisbm_unit1 = -1
+     IF ( wrf_dm_on_monitor() ) THEN
+       DO i = 20,99
+         INQUIRE ( i , OPENED = opened )
+         IF ( .NOT. opened ) THEN
+           hujisbm_unit1 = i
+           GOTO 2062
+         ENDIF
+       ENDDO
+       2062     CONTINUE
+     ENDIF
 
-! HAIL (ONLY_ICE: EVAPORATION) 
+     CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
 
-	        IF(ISYM5.NE.0) THEN
+     IF ( hujisbm_unit1 < 0 ) THEN
+       CALL wrf_error_fatal ( 'Can not find unused fortran unit to read in BREAKINIT_KS lookup table, model stop' )
+     ENDIF
 
-! HAIL DISTRIBUTION FUNCTION (ONLY_ICE: EVAPORATION) 
-                                                         
-	          CALL JERDFUN(R5,B51_MY,B52_MY &
-     &                        ,FI5,PSI5,D2N &
-     &                        ,1,5,COL,NKR,TPN)
-! IN CASE : ISYM5.NE.0
+     IF ( wrf_dm_on_monitor() ) THEN
+      OPEN(UNIT=hujisbm_unit1,FILE=trim(file_q),    &
+           FORM="FORMATTED",STATUS="OLD",ERR=2070)
+          DO K=1,KE
+             DO J=1,JE
+                READ(hujisbm_unit1,'(2I6,1E16.8)') KQ,JQ,QKJ(KQ,JQ)
+             ENDDO
+          ENDDO
+      CLOSE(hujisbm_unit1)
+     END IF
 
-	        ENDIF
+     DROPRADII_d = DROPRADII
+     vr1_d = vr1
+     DO J=1,NKR
+         DO I=1,NKR
+             ECOALMASSM(I,J)=ECOALMASS(xl_d(I), xl_d(J), DROPRADII_d, vr1_d, NKR)
+          ENDDO
+     ENDDO
+ ! Correction of coalescence efficiencies for drop collision kernels
 
-	        IF((DEL2.LT.0.AND.DEL2N.GT.0) &
-     &         .AND.ABS(DEL2N).GT.EPSDEL) THEN
-                call wrf_error_fatal("fatal error in module_mp_fast_sbm (ABS(DEL2N).GT.EPSDEL), model stop")
-	        ENDIF
+     DO J=25,31
+         ECOALMASSM(NKR,J)=0.1D-29
+     ENDDO
 
-! IN CASE : KCOND.NE.21
- 
-	      ENDIF
+       RETURN
+ 2070  continue
+       WRITE( errmess , '(A,I4)' )                                          &
+        'module_FAST_SBM: error opening hujisbm_DATA on unit, model stop'  &
+        , hujisbm_unit1
+       CALL wrf_error_fatal(errmess)
+       END SUBROUTINE BREAKINIT_KS
 
-! IN CASES : KCOND = 21 OR KCOND.NE.21
+ !coalescence efficiency as function of masses
+ !----------------------------------------------------------------------------+
+     double precision FUNCTION ecoalmass(x1, x2, DROPRADII, VR1_BREAKUP, NKR)
 
-! END OF "PROCESS'S TYPE" 
-!
-! MASSES
-              RMASSIBB=0.0
-              RMASSIAA=0.0
-! BEFORE JERNEWF
-              DO K=1,NKR
-                 DO ICE =1,ICEMAX
-                    FI2_K=FI2(K,ICE)
-                    R2_K=R2(K,ICE)
-                    FI2R2=FI2_K*R2_K*R2_K
-                    RMASSIBB=RMASSIBB+FI2R2
-                 ENDDO
-                 FI3_K=FI3(K)
-                 FI4_K=FI4(K)
-                 FI5_K=FI5(K)
-                 R3_K=R3(K)
-                 R4_K=R4(K)
-                 R5_K=R5(K)
-                 FI3R3=FI3_K*R3_K*R3_K
-                 FI4R4=FI4_K*R4_K*R4_K
-                 FI5R5=FI5_K*R5_K*R5_K
-                 RMASSIBB=RMASSIBB+FI3R3
-                 RMASSIBB=RMASSIBB+FI4R4
-                 RMASSIBB=RMASSIBB+FI5R5
-              ENDDO
-              RMASSIBB=RMASSIBB*COL3*RORI
-! NEW CHANGE RMASSIBB
-              IF(RMASSIBB.LT.0.0) RMASSIBB=0.0
-! AFTER JERNEWF
-              DO K=1,NKR
-                 DO ICE =1,ICEMAX
-                    FI2_K=PSI2(K,ICE)
-                    R2_K=R2(K,ICE)
-                    FI2R2=FI2_K*R2_K*R2_K
-                    RMASSIAA=RMASSIAA+FI2R2
-                 ENDDO
-                 FI3_K=PSI3(K)
-                 FI4_K=PSI4(K)
-                 FI5_K=PSI5(K)
-                 R3_K=R3(K)
-                 R4_K=R4(K)
-                 R5_K=R5(K)
-                 FI3R3=FI3_K*R3_K*R3_K
-                 FI4R4=FI4_K*R4_K*R4_K
-                 FI5R5=FI5_K*R5_K*R5_K
-                 RMASSIAA=RMASSIAA+FI3R3
-                 RMASSIAA=RMASSIAA+FI4R4
-                 RMASSIAA=RMASSIAA+FI5R5
-              ENDDO
-              RMASSIAA=RMASSIAA*COL3*RORI
-! NEW CHANGE RMASSIAA
-              IF(RMASSIAA.LT.0.0) RMASSIAA=0.0
-! NEW TREATMENT OF "T" & "Q"
-              DELMASSI1=RMASSIAA-RMASSIBB
-              QPN=QPS-DELMASSI1
-              DAL2=AL2
-              TPN=TPS+DAL2*DELMASSI1
-! SUPERSATURATION
-              ARGEXP=-BB1_MY/TPN
-              ES1N=AA1_MY*DEXP(ARGEXP)
-              ARGEXP=-BB2_MY/TPN
-              ES2N=AA2_MY*DEXP(ARGEXP)
-              EW1N=OPER3(QPN,PP)
-              IF(ES1N.EQ.0)THEN
-               DEL1N=0.5
-               DIV1=1.5
-              call wrf_error_fatal("fatal error in module_mp_fast_sbm (ES1N.EQ.0), model stop")
-              ELSE
-               DIV1=EW1N/ES1N
-               DEL1N=EW1N/ES1N-1.
-              END IF
-              IF(ES2N.EQ.0)THEN
-               DEL2N=0.5
-               DIV2=1.5
-              call wrf_error_fatal("fatal error in module_mp_fast_sbm (ES2N.EQ.0), model stop")
-              ELSE
-               DEL2N=EW1N/ES2N-1.
-               DIV2=EW1N/ES2N
-              END IF
+     implicit none
+     integer,intent(in) :: NKR
+     real(kind=r8size),intent(in) :: DROPRADII(NKR), VR1_BREAKUP(NKR), x1, x2
 
-!  END OF TIME SPLITTING 
-! (ONLY ICE: CONDENSATION OR EVAPORATION) 
-	      IF(TIMENEW.LT.DT) GOTO 46
-        TT=TPN
-        QQ=QPN
-	DO KR=1,NKR
-	   DO ICE=1,ICEMAX
-	      FF2(KR,ICE)=PSI2(KR,ICE)
-	   ENDDO
-	   FF3(KR)=PSI3(KR)
-	   FF4(KR)=PSI4(KR)
-	   FF5(KR)=PSI5(KR)
-	ENDDO
+     real(kind=r8size),PARAMETER :: zero=0.0d0,one=1.0d0,eps=1.0d-10
+     real(kind=r8size) :: rho, PI, akPI, Deta, Dksi
 
+     rho=1.0d0             ! [rho]=g/cm^3
 
-! GO TO "CONDENSATION AND VAPORATION"
+     PI=3.1415927d0
+     akPI=6.0d0/PI
 
+     Deta = (akPI*x1/rho)**(1.0d0/3.0d0)
+     Dksi = (akPI*x2/rho)**(1.0d0/3.0d0)
 
-        RETURN                                          
-        END SUBROUTINE ONECOND2
-!==================================================================
+     ecoalmass = ecoaldiam(Deta, Dksi, DROPRADII, VR1_BREAKUP, NKR)
 
-        SUBROUTINE ONECOND3 &
-     & (TT,QQ,PP,ROR &
-     & ,VR1,VR2,VR3,VR4,VR5,PSINGLE &
-     & ,DEL1N,DEL2N,DIV1,DIV2 &
-     & ,FF1,PSI1,R1,RLEC,RO1BL &
-     & ,FF2,PSI2,R2,RIEC,RO2BL &
-     & ,FF3,PSI3,R3,RSEC,RO3BL &
-     & ,FF4,PSI4,R4,RGEC,RO4BL &
-     & ,FF5,PSI5,R5,RHEC,RO5BL &
-     & ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
-     & ,C1_MEY,C2_MEY &
-     & ,COL,DTCOND,ICEMAX,NKR &
-     & ,ISYM1,ISYM2,ISYM3,ISYM4,ISYM5)
-       IMPLICIT NONE
-       INTEGER ICEMAX,NKR,KR,ITIME,ICE,KCOND,K &
-     &           ,ISYM1,ISYM2,ISYM3,ISYM4,ISYM5
-       INTEGER KLIMITL,KLIMITG,KLIMITH,KLIMITI_1, &
-     &  KLIMITI_2,KLIMITI_3
-       INTEGER I_MIXCOND,I_MIXEVAP,I_ABERGERON,I_BERGERON  
-       REAL ROR,VR1(NKR),VR2(NKR,ICEMAX),VR3(NKR),VR4(NKR) &
-     &           ,VR5(NKR),PSINGLE &
-     &           ,AA1_MY,BB1_MY,AA2_MY,BB2_MY &
-     &           ,C1_MEY,C2_MEY &
-     &           ,COL,DTCOND
-
-! DROPLETS 
-                                                                       
-        REAL R1(NKR)&
-     &           ,RLEC(NKR),RO1BL(NKR) &
-     &           ,FI1(NKR),FF1(NKR),PSI1(NKR) &
-     &           ,B11_MY(NKR),B12_MY(NKR)
-
-! CRYSTALS
-                                                                       
-	REAL R2(NKR,ICEMAX) &
-     &           ,RIEC(NKR,ICEMAX) &
-     &           ,RO2BL(NKR,ICEMAX) &
-     &           ,FI2(NKR,ICEMAX),PSI2(NKR,ICEMAX) &
-     &           ,FF2(NKR,ICEMAX) &
-     &           ,B21_MY(NKR,ICEMAX),B22_MY(NKR,ICEMAX) &
-     &           ,RATE2(NKR,ICEMAX),DEL_R2M(NKR,ICEMAX)
-
-! SNOW                                                                          
-        REAL R3(NKR) &
-     &           ,RSEC(NKR),RO3BL(NKR) &
-     &           ,FI3(NKR),FF3(NKR),PSI3(NKR) &
-     &           ,B31_MY(NKR),B32_MY(NKR) &
-     &           ,DEL_R3M(NKR)  
-
-! GRAUPELS 
-                                                                       
-        REAL R4(NKR),R4N(NKR) &
-     &           ,RGEC(NKR),RO4BL(NKR) &
-     &           ,FI4(NKR),FF4(NKR),PSI4(NKR) &
-     &           ,B41_MY(NKR),B42_MY(NKR) &
-     &           ,DEL_R4M(NKR)
-
-! HAIL                                                                          
-        REAL R5(NKR),R5N(NKR) &
-     &           ,RHEC(NKR),RO5BL(NKR) &
-     &           ,FI5(NKR),FF5(NKR),PSI5(NKR) &
-     &           ,B51_MY(NKR),B52_MY(NKR) &
-     &           ,DEL_R5M(NKR)
-
-      DOUBLE PRECISION DD1N,DB11_MY,DAL1,DAL2
-      DOUBLE PRECISION COL3,RORI,TPN,TPS,QPN,QPS,TOLD,QOLD &
-     &                  ,FI1_K,FI2_K,FI3_K,FI4_K,FI5_K &
-     &                  ,R1_K,R2_K,R3_K,R4_K,R5_K &
-     &                  ,FI1R1,FI2R2,FI3R3,FI4R4,FI5R5 &
-     &                  ,RMASSLAA,RMASSLBB,RMASSIAA,RMASSIBB &
-     &                  ,ES1N,ES2N,EW1N,ARGEXP &
-     &                  ,TT,QQ,PP,DEL1N0,DEL2N0 &
-     &                  ,DEL1N,DEL2N,DIV1,DIV2 &
-     &                  ,OPER2,OPER3,AR1,AR2
-
-       DOUBLE PRECISION DELTAQ1,DELMASSI1,DELMASSL1
-
-       REAL A1_MYN, BB1_MYN, A2_MYN, BB2_MYN
-        DATA A1_MYN, BB1_MYN, A2_MYN, BB2_MYN &
-     &      /2.53,5.42,3.41E1,6.13/
-       REAL B8L,B8I,SFN11,SFN12,SFNL,SFNI
-       REAL B5L,B5I,B7L,B7I,B6,DOPL,DEL1S,DEL2S,DOPI,RW,QW,PW, &
-     &  RI,PI,QI,SFNI1(ICEMAX),SFNI2(ICEMAX),AL1,AL2
-       REAL D1N,D2N,DT0L, DT0I,D1N0,D2N0
-       REAL SFN21,SFN22,SFNII1,SFNII2,SFN31,SFN32,SFN41,SFN42,SFN51, &
-     &  SFN52
-       REAL DEL1,DEL2
-       REAL  TIMEREV,DT,DTT,TIMENEW
-       REAL DTIMEG(NKR),DTIMEH(NKR)
-
-       REAL DEL2D(ICEMAX),DTIMEO(NKR),DTIMEL(NKR) &
-     &           ,DTIMEI_1(NKR),DTIMEI_2(NKR),DTIMEI_3(NKR)
-       REAL DT_WATER_COND,DT_WATER_EVAP,DT_ICE_COND,DT_ICE_EVAP, &
-     &  DT_MIX_COND,DT_MIX_EVAP,DT_MIX_BERGERON,DT_MIX_ANTIBERGERON
-       REAL DTNEWL0,DTNEWL1,DTNEWI1,DTNEWI2_1,DTNEWI2_2,DTNEWI2_3, &
-     & DTNEWI2,DTNEWI_1,DTNEWI_2,DTNEWI3,DTNEWI4,DTNEWI5, &
-     & DTNEWL,DTNEWL2,DTNEWG1,DTNEWH1
-       REAL TIMESTEPD(NKR)
-
-       DATA AL1 /2500./, AL2 /2834./
-       REAL EPSDEL,EPSDEL2
-       DATA EPSDEL, EPSDEL2 /0.1E-03,0.1E-03/
-       OPER2(AR1)=0.622/(0.622+0.378*AR1)/AR1
-       OPER3(AR1,AR2)=AR1*AR2/(0.622+0.378*AR1)
-      
-! BELOW
-!
-        DT_WATER_COND=0.4
-        DT_WATER_EVAP=0.4
-        DT_ICE_COND=0.4
-        DT_ICE_EVAP=0.4
-        DT_MIX_COND=0.4
-        DT_MIX_EVAP=0.4
-        DT_MIX_BERGERON=0.4
-        DT_MIX_ANTIBERGERON=0.4
-
-        I_MIXCOND=0
-        I_MIXEVAP=0
-        I_ABERGERON=0
-        I_BERGERON=0
-
-       ITIME = 0
-       TIMENEW=0.
-       DT=DTCOND
-       DTT=DTCOND
-
-       B6=0.
-       B8L=1./ROR
-       B8I=1./ROR
-! NEW CHANGES 19.04.01 (BEGIN)
-        RORI=1.D0/ROR
-! NEW CHANGES 19.04.01 (END)
-! NEW CHANGES 19.04.01 (BEGIN)
-        COL3=3.D0*COL
-! NEW CHANGES 19.04.01 (END)
-
-
-
-! BARRY:DIV
-        TPN=TT
-        QPN=QQ
-! HERE
-   16         ITIME=ITIME+1
-! BARRY
-!             TPC_NEW=TPN-273.15
-              IF((TPN-273.15).GE.-0.187) GO TO 17
-              TIMEREV=DT-TIMENEW
-              DEL1=DEL1N
-              DEL2=DEL2N
-              DEL1S=DEL1N
-              DEL2S=DEL2N
-! NEW ALGORITHM (NO TYPE ICE)
-              DEL2D(1)=DEL2N
-              DEL2D(2)=DEL2N
-              DEL2D(3)=DEL2N
-              TPS=TPN
-              QPS=QPN
-              DO KR=1,NKR
-                 FI1(KR)=PSI1(KR)
-                 FI3(KR)=PSI3(KR)
-                 FI4(KR)=PSI4(KR)
-                 FI5(KR)=PSI5(KR)
-                 DO ICE=1,ICEMAX
-                    FI2(KR,ICE)=PSI2(KR,ICE)
-                 ENDDO
-              ENDDO
-! TIME-STEP GROWTH RATE
-! HERE
-              CALL JERRATE(R1,TPS,PP,ROR,VR1,PSINGLE &
-     &                    ,RLEC,RO1BL,B11_MY,B12_MY,1,1,ICEMAX,NKR)
-              CALL JERRATE(R2,TPS,PP,ROR,VR2,PSINGLE &
-     &                    ,RIEC,RO2BL,B21_MY,B22_MY,3,2,ICEMAX,NKR)
-              CALL JERRATE(R3,TPS,PP,ROR,VR3,PSINGLE &
-     &                    ,RSEC,RO3BL,B31_MY,B32_MY,1,2,ICEMAX,NKR)
-              CALL JERRATE(R4,TPS,PP,ROR,VR4,PSINGLE &
-     &                    ,RGEC,RO4BL,B41_MY,B42_MY,1,2,ICEMAX,NKR)
-              CALL JERRATE(R5,TPS,PP,ROR,VR5,PSINGLE &
-     &                    ,RHEC,RO5BL,B51_MY,B52_MY,1,2,ICEMAX,NKR)
-              CALL JERTIMESC(FI1,R1,SFN11,SFN12 &
-     &                      ,B11_MY,B12_MY,RLEC,B8L,1,COL,NKR)
-              CALL JERTIMESC_ICE(FI2,R2,SFNI1,SFNI2 &
-     &                      ,B21_MY,B22_MY,RIEC,B8I,ICEMAX,COL,NKR)
-              CALL JERTIMESC(FI3,R3,SFN31,SFN32 &
-     &                      ,B31_MY,B32_MY,RSEC,B8I,1,COL,NKR)
-              CALL JERTIMESC(FI4,R4,SFN41,SFN42 &
-     &                      ,B41_MY,B42_MY,RGEC,B8I,1,COL,NKR)
-              CALL JERTIMESC(FI5,R5,SFN51,SFN52 &
-     &                      ,B51_MY,B52_MY,RHEC,B8I,1,COL,NKR)
-! NEW ALGORITHM (NO TYPE ICE)
-              SFNII1=SFNI1(1)+SFNI1(2)+SFNI1(3)
-              SFNII2=SFNI2(1)+SFNI2(2)+SFNI2(3)
-              SFN21=SFNII1+SFN31+SFN41+SFN51
-              SFN22=SFNII2+SFN32+SFN42+SFN52
-              SFNL=SFN11+SFN12
-              SFNI=SFN21+SFN22
-! SOME CONSTANTS (QW,QI=0,since B6=0.)
-              B5L=BB1_MY/TPS/TPS
-              B5I=BB2_MY/TPS/TPS
-              B7L=B5L*B6
-              B7I=B5I*B6
-              DOPL=1.+DEL1S
-              DOPI=1.+DEL2S
-              RW=(OPER2(QPS)+B5L*AL1)*DOPL*SFNL
-              QW=B7L*DOPL
-              PW=(OPER2(QPS)+B5I*AL1)*DOPI*SFNL
-              RI=(OPER2(QPS)+B5L*AL2)*DOPL*SFNI
-              PI=(OPER2(QPS)+B5I*AL2)*DOPI*SFNI
-              QI=B7I*DOPI
-! SOLVING FOR TIMEZERO
-              CALL JERSUPSAT(DEL1,DEL2,DEL1N0,DEL2N0 &
-     &                      ,RW,PW,RI,PI,QW,QI &
-     &                      ,DTT,D1N0,D2N0,DT0L,DT0I)
-! DEL1 > 0, DEL2 < 0    (ANTIBERGERON MIXED PHASE - KCOND=50)
-! DEL1 < 0 AND DEL2 < 0 (EVAPORATION MIXED_PHASE - KCOND=30)
-! DEL1 > 0 AND DEL2 > 0 (CONDENSATION MIXED PHASE - KCOND=31)
-! DEL1 < 0, DEL2 > 0    (BERGERON MIXED PHASE - KCOND=32)
-              KCOND=50
-
-              IF(DEL1.LT.0.AND.DEL2.LT.0) KCOND=30
-              IF(DEL1.GT.0.AND.DEL2.GT.0) KCOND=31
-              IF(DEL1.LT.0.AND.DEL2.GT.0) KCOND=32
-              IF(KCOND.EQ.50) THEN 
-                I_ABERGERON=I_ABERGERON+1
-                IF(DT0L.EQ.0) THEN
-                  DTNEWL=DT
-                ELSE
-                  DTNEWL=AMIN1(DT,DT0L)
-                ENDIF
-! NEW TIME STEP (ANTIBERGERON MIXED PHASE)
-                IF(DTNEWL.GT.DT) DTNEWL=DT
-                IF((TIMENEW+DTNEWL).GT.DT.AND.ITIME.LT.(NKR-1)) &
-     &          DTNEWL=DT-TIMENEW
-                IF(ITIME.EQ.(NKR-1)) DTNEWL=DT-TIMENEW
-                TIMENEW=TIMENEW+DTNEWL
-                DTT=DTNEWL
-                IF(ITIME.GE.NKR) THEN
-                call wrf_error_fatal("fatal error in module_mp_fast_sbm (ITIME.GE.NKR), model stop")
-                ENDIF
-                TIMESTEPD(ITIME)=DTNEWL
-! ANTIBERGERON MIXED PHASE (BEGIN)
-! IN CASE : KCOND = 50
-              ENDIF
-              IF(KCOND.EQ.31) THEN
-! CONDENSATION MIXED PHASE (BEGIN)
-! CONTROL OF TIMESTEP ITERATIONS
-                I_MIXCOND=I_MIXCOND+1
-               IF (DEL1N.EQ.0)THEN
-                DTNEWL0=DT
-               ELSE
-                DTNEWL0=ABS(R1(ITIME)/(B11_MY(ITIME)*DEL1N- &
-     &                                 B12_MY(ITIME)))
-               END IF
-! NEW ALGORITHM (NO TYPE OF ICE)
-
-               IF (DEL2N.EQ.0)THEN
-                DTNEWI2_1=DT
-                DTNEWI2_2=DT
-                DTNEWI2_3=DT
-                DTNEWI3=DT
-                DTNEWI4=DT
-                DTNEWI5=DT
-               ELSE
-                DTNEWI2_1=ABS(R2(ITIME,1)/ &
-     &         (B21_MY(ITIME,1)*DEL2N-B22_MY(ITIME,1)))
-                DTNEWI2_2=ABS(R2(ITIME,2)/ &
-     &         (B21_MY(ITIME,2)*DEL2N-B22_MY(ITIME,2))) 
-                DTNEWI2_3=ABS(R2(ITIME,3)/ &
-     &         (B21_MY(ITIME,3)*DEL2N-B22_MY(ITIME,3)))  
-                DTNEWI2=AMIN1(DTNEWI2_1,DTNEWI2_2,DTNEWI2_3)
-
-                DTNEWI3=ABS(R3(ITIME)/(B31_MY(ITIME)*DEL2N- &
-     &                                 B32_MY(ITIME)))
-                DTNEWI4=ABS(R4(ITIME)/(B41_MY(ITIME)*DEL2N- &
-     &                                 B42_MY(ITIME)))
-                DTNEWI5=ABS(R5(ITIME)/(B51_MY(ITIME)*DEL2N- &
-     &                                 B52_MY(ITIME)))
-               END IF
-                DTNEWI1=AMIN1(DTNEWI2,DTNEWI4,DTNEWI5,DT0I)
-                IF(DT0L.NE.0) THEN
-                  IF(ABS(DT0L).LT.DT_MIX_COND) THEN
-                    DTNEWL1=AMIN1(DT_MIX_COND,DTNEWL0)
-                  ELSE
-                    DTNEWL1=AMIN1(DT0L,DTNEWL0)
-                  ENDIF
-                ELSE
-                  DTNEWL1=DTNEWL0
-                ENDIF
-                DTNEWL=AMIN1(DTNEWL1,DTNEWI1)
-                IF(ITIME.GE.NKR) THEN
-                call wrf_error_fatal("fatal error in module_mp_fast_sbm (ITIME.GE.NKR), model stop")
-                ENDIF
-                TIMESTEPD(ITIME)=DTNEWL
-! NEW TIME STEP (CONDENSATION MIXED PHASE)
-                IF(DTNEWL.GT.DT) DTNEWL=DT
-                IF((TIMENEW+DTNEWL).GT.DT.AND.ITIME.LT.(NKR-1)) &
-     &          DTNEWL=DT-TIMENEW
-                IF(ITIME.EQ.(NKR-1)) DTNEWL=DT-TIMENEW
-                TIMENEW=TIMENEW+DTNEWL
-                TIMESTEPD(ITIME)=DTNEWL
-                DTT=DTNEWL
-! CONDENSATION MIXED PHASE (END)
-! IN CASE : KCOND = 31
-              ENDIF
-              IF(KCOND.EQ.30) THEN
-! EVAPORATION MIXED PHASE (BEGIN)
-! CONTROL OF TIMESTEP ITERATIONS
-                I_MIXEVAP=I_MIXEVAP+1
-                DO KR=1,NKR
-                   DTIMEL(KR)=0.
-                   DTIMEG(KR)=0.
-                   DTIMEH(KR)=0.
-! NEW ALGORITHM (NO TYPE ICE)
-                   DTIMEI_1(KR)=0.
-                   DTIMEI_2(KR)=0.
-                   DTIMEI_3(KR)=0.
-                ENDDO
-                DO KR=1,NKR
-                 IF (DEL1N.EQ.0) THEN
-                   DTIMEL(KR)=DT
-                   DTIMEG(KR)=DT
-                   DTIMEH(KR)=DT
-                 ELSE
-                   DTIMEL(KR)=-R1(KR)/(B11_MY(KR)*DEL1N- &
-     &                                 B12_MY(KR))
-                   DTIMEG(KR)=-R4(KR)/(B41_MY(KR)*DEL1N- &
-     &                                 B42_MY(KR))
-                   DTIMEH(KR)=-R5(KR)/(B51_MY(KR)*DEL1N- &
-     &                             B52_MY(KR))
-! NEW ALGORITHM (NO TYPE OF ICE)
-                 END IF
-                 IF (DEL2N.EQ.0) THEN
-                   DTIMEI_1(KR)=DT
-                   DTIMEI_2(KR)=DT
-                   DTIMEI_3(KR)=DT
-                 ELSE
-                   DTIMEI_1(KR)=-R2(KR,1)/ &
-     &               (B21_MY(KR,1)*DEL2N-B22_MY(KR,1))
-                   DTIMEI_2(KR)=-R2(KR,2)/ &
-     &               (B21_MY(KR,2)*DEL2N-B22_MY(KR,2))
-                   DTIMEI_3(KR)=-R2(KR,3)/ &
-     &               (B21_MY(KR,3)*DEL2N-B22_MY(KR,3))
-                 END IF
-                ENDDO
-! WATER
-                KLIMITL=1
-                DO KR=1,NKR
-                   IF(DTIMEL(KR).GT.TIMEREV) GOTO 355
-                   KLIMITL=KR
-                ENDDO
-  355           KLIMITL=KLIMITL-1
-                IF(KLIMITL.LT.1) KLIMITL=1
-                DTNEWL1=AMIN1(DTIMEL(KLIMITL),DT0L,TIMEREV)
-! GRAUPELS
-                KLIMITG=1
-                DO KR=1,NKR
-                   IF(DTIMEG(KR).GT.TIMEREV) GOTO 455
-                   KLIMITG=KR
-                ENDDO
-  455           KLIMITG=KLIMITG-1
-                IF(KLIMITG.LT.1) KLIMITG=1
-                DTNEWG1=AMIN1(DTIMEG(KLIMITG),TIMEREV)
-! HAIL
-                KLIMITH=1
-                DO KR=1,NKR
-                   IF(DTIMEH(KR).GT.TIMEREV) GOTO 555
-                   KLIMITH=KR
-                ENDDO
-  555           KLIMITH=KLIMITH-1
-                IF(KLIMITH.LT.1) KLIMITH=1
-                DTNEWH1=AMIN1(DTIMEH(KLIMITH),TIMEREV)
-! ICE CRYSTALS
-! NEW ALGORITHM (NO TYPE OF ICE) (BEGIN)
-                KLIMITI_1=1
-                KLIMITI_2=1
-                KLIMITI_3=1
-                DO KR=1,NKR
-                   IF(DTIMEI_1(KR).GT.TIMEREV) GOTO 655
-                   KLIMITI_1=KR
-                ENDDO
-  655           CONTINUE
-                DO KR=1,NKR
-                   IF(DTIMEI_2(KR).GT.TIMEREV) GOTO 656
-                   KLIMITI_2=KR
-                ENDDO
-  656           CONTINUE
-                DO KR=1,NKR
-                   IF(DTIMEI_3(KR).GT.TIMEREV) GOTO 657
-                   KLIMITI_3=KR
-                ENDDO
-  657           CONTINUE
-                KLIMITI_1=KLIMITI_1-1
-                IF(KLIMITI_1.LT.1) KLIMITI_1=1
-                DTNEWI2_1=AMIN1(DTIMEI_1(KLIMITI_1),TIMEREV)
-                KLIMITI_2=KLIMITI_2-1
-                IF(KLIMITI_2.LT.1) KLIMITI_2=1
-                DTNEWI2_2=AMIN1(DTIMEI_2(KLIMITI_2),TIMEREV)
-                KLIMITI_3=KLIMITI_3-1
-                IF(KLIMITI_3.LT.1) KLIMITI_3=1
-                DTNEWI2_3=AMIN1(DTIMEI_3(KLIMITI_3),TIMEREV)
-                DTNEWI2=AMIN1(DTNEWI2_1,DTNEWI2_2,DTNEWI2_3)
-! NEW ALGORITHM (NO TYPE OF ICE) (END)
-                DTNEWI1=AMIN1(DTNEWI2,DTNEWG1,DTNEWH1,DT0I)
-                IF(ABS(DEL2N).LT.EPSDEL2) &
-     &          DTNEWI1=AMIN1(DTNEWI2,DTNEWG1,DTNEWH1)
-                DTNEWL2=AMIN1(DTNEWL1,DTNEWI1)
-                DTNEWL=DTNEWL2
-                IF(DTNEWL.LT.DT_MIX_EVAP) &
-     &          DTNEWL=AMIN1(DT_MIX_EVAP,TIMEREV)  
-                IF(ITIME.GE.NKR) THEN
-                call wrf_error_fatal("fatal error in module_mp_fast_sbm (ITIME.GE.NKR), model stop")
-                ENDIF
-                TIMESTEPD(ITIME)=DTNEWL
-! NEW TIME STEP (EVAPORATION MIXED PHASE)
-                IF(DTNEWL.GT.DT) DTNEWL=DT
-                IF((TIMENEW+DTNEWL).GT.DT &
-     &         .AND.ITIME.LT.(NKR-1)) &
-     &          DTNEWL=DT-TIMENEW
-                IF(ITIME.EQ.(NKR-1)) DTNEWL=DT-TIMENEW
-                TIMESTEPD(ITIME)=DTNEWL
-                TIMENEW=TIMENEW+DTNEWL
-                DTT=DTNEWL
-! EVAPORATION MIXED PHASE (END)
-! IN CASE : KCOND = 30
-              ENDIF
-              IF(KCOND.EQ.32) THEN
-! BERGERON MIXED PHASE (BEGIN)
-! CONTROL OF TIMESTEP ITERATIONS
-                I_BERGERON=I_BERGERON+1
-! NEW TREATMENT OF TIME STEP (BERGERON MIXED PHASE)
-               IF (DEL1N.EQ.0)THEN
-                DTNEWL0=DT
-               ELSE
-                DTNEWL0=-R1(1)/(B11_MY(1)*DEL1N-B12_MY(1))
-               END IF
-! NEW ALGORITHM (NO TYPE ICE)
-               IF (DEL2N.EQ.0)THEN
-                DTNEWI2_1=DT
-                DTNEWI2_2=DT
-                DTNEWI2_3=DT
-               ELSE
-                DTNEWI2_1=R2(1,1)/(B21_MY(1,1)*DEL2N-B22_MY(1,1))
-                DTNEWI2_2=R2(1,2)/(B21_MY(1,2)*DEL2N-B22_MY(1,2))
-                DTNEWI2_3=R2(1,3)/(B21_MY(1,3)*DEL2N-B22_MY(1,3))
-               END IF
-               DTNEWI2=AMIN1(DTNEWI2_1,DTNEWI2_2,DTNEWI2_3)
-               IF (DEL2N.EQ.0)THEN
-                DTNEWI3=DT
-                DTNEWI4=DT
-                DTNEWI5=DT
-               ELSE
-                DTNEWI3=R3(1)/(B31_MY(1)*DEL2N-B32_MY(1))
-                DTNEWI4=R4(1)/(B41_MY(1)*DEL2N-B42_MY(1))
-                DTNEWI5=R5(1)/(B51_MY(1)*DEL2N-B52_MY(1))
-               END IF
-                DTNEWL1=AMIN1(DTNEWL0,DT0L,TIMEREV)
-                DTNEWI1=AMIN1(DTNEWI2,DTNEWI3,DTNEWI4 &
-     &                       ,DTNEWI5,DT0I,TIMEREV)
-                DTNEWI1=AMIN1(DTNEWI2,DTNEWI4,DTNEWI5,DT0I,TIMEREV)
-                DTNEWL=AMIN1(DTNEWL1,DTNEWI1)
-! NEW CHANGES 23.04.01 (BEGIN)
-                IF(DTNEWL.LT.DT_MIX_BERGERON) &
-     &          DTNEWL=AMIN1(DT_MIX_BERGERON,TIMEREV)
-                TIMESTEPD(ITIME)=DTNEWL
-! NEW TIME STEP (BERGERON MIXED PHASE)
-                IF(DTNEWL.GT.DT) DTNEWL=DT
-                IF((TIMENEW+DTNEWL).GT.DT.AND.ITIME.LT.(NKR-1)) &
-     &          DTNEWL=DT-TIMENEW
-                IF(ITIME.EQ.(NKR-1)) DTNEWL=DT-TIMENEW
-                TIMESTEPD(ITIME)=DTNEWL
-                TIMENEW=TIMENEW+DTNEWL
-                DTT=DTNEWL
-! BERGERON MIXED PHASE (END)
-! IN CASE : KCOND = 32
-              ENDIF
-! SOLVING FOR SUPERSATURATION 
-! CALL JERSUPSAT - 7 (MIXED_PHASE)
-         
-	      CALL JERSUPSAT(DEL1,DEL2,DEL1N,DEL2N &
-     &                      ,RW,PW,RI,PI,QW,QI &
-     &                      ,DTT,D1N,D2N,DT0L,DT0I)
-! END OF "NEW SUPERSATURATION" 
-
-! DROPLETS 
-	      IF(ISYM1.NE.0) THEN
-
-! DROPLET DISTRIBUTION FUNCTION 
-
-                                                         
-! CALL JERDFUN - 3
-	        CALL JERDFUN(R1,B11_MY,B12_MY &
-     &                      ,FI1,PSI1,D1N &
-     &                      ,1,1,COL,NKR,TPN)
-! END OF "DROPLET DISTRIBUTION FUNCTION" 
- 
-! IN CASE ISYM1.NE.0
-
- 	      ENDIF                     
-! CRYSTALS 
-	      IF(ISYM2.NE.0) THEN
-
-! CRYSTAL DISTRIBUTION FUNCTION 
- 
-	        CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                      ,FI2,PSI2,D2N &
-     &                      ,ICEMAX,1,COL,NKR,TPN)
-
-	        CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                      ,FI2,PSI2,D2N &
-     &                      ,ICEMAX,2,COL,NKR,TPN)
-
-	        CALL JERDFUN(R2,B21_MY,B22_MY &
-     &                      ,FI2,PSI2,D2N &
-     &                      ,ICEMAX,3,COL,NKR,TPN)
-! IN CASE ISYM2.NE.0
-
-	      ENDIF
-! SNOW 
-	      IF(ISYM3.NE.0) THEN
-
-! SNOW DISTRIBUTION FUNCTION 
-                                                         
-
-! CALL JERDFUN - SNOW - 3
-
- 	        CALL JERDFUN(R3,B31_MY,B32_MY &
-     &                      ,FI3,PSI3,D2N &
-     &                      ,1,3,COL,NKR,TPN)
-
-
-! IN CASE ISYM3.NE.0
-
-  	      ENDIF
-
-! GRAUPELS 
-
-	      IF(ISYM4.NE.0) THEN
-
-! GRAUPEL DISTRIBUTION FUNCTION
-                                                         
-	        CALL JERDFUN(R4,B41_MY,B42_MY &
-     &                      ,FI4,PSI4,D2N &
-     &                      ,1,4,COL,NKR,TPN)
-! IN CASE ISYM4.NE.0
-
-	      ENDIF
-! HAIL 
-	      IF(ISYM5.NE.0) THEN
-
-! HAIL DISTRIBUTION FUNCTION 
-                                                         
-	        CALL JERDFUN(R5,B51_MY,B52_MY &
-     &                      ,FI5,PSI5,D2N &
-     &                      ,1,5,COL,NKR,TPN)
-! IN CASE ISYM5.NE.0
-
-	      ENDIF
-! MASSES
-              RMASSLBB=0.D0
-              RMASSIBB=0.D0
-              RMASSLAA=0.D0
-              RMASSIAA=0.D0
-! BEFORE JERNEWF
-              DO K=1,NKR
-                 FI1_K=FI1(K)
-                 R1_K=R1(K)
-                 FI1R1=FI1_K*R1_K*R1_K
-                 RMASSLBB=RMASSLBB+FI1R1
-                 DO ICE =1,ICEMAX
-                    FI2_K=FI2(K,ICE)
-                    R2_K=R2(K,ICE)
-                    FI2R2=FI2_K*R2_K*R2_K
-                    RMASSIBB=RMASSIBB+FI2R2
-                 ENDDO
-                 FI3_K=FI3(K)
-                 FI4_K=FI4(K)
-                 FI5_K=FI5(K)
-                 R3_K=R3(K)
-                 R4_K=R4(K)
-                 R5_K=R5(K)
-                 FI3R3=FI3_K*R3_K*R3_K
-                 FI4R4=FI4_K*R4_K*R4_K
-                 FI5R5=FI5_K*R5_K*R5_K
-                 RMASSIBB=RMASSIBB+FI3R3
-                 RMASSIBB=RMASSIBB+FI4R4
-                 RMASSIBB=RMASSIBB+FI5R5
-              ENDDO
-              RMASSIBB=RMASSIBB*COL3*RORI
-! NEW CHANGE RMASSIBB
-              IF(RMASSIBB.LT.0.0) RMASSIBB=0.0
-              RMASSLBB=RMASSLBB*COL3*RORI
-! NEW CHANGE RMASSLBB
-              IF(RMASSLBB.LT.0.0) RMASSLBB=0.0
-! AFTER  JERNEWF
-              DO K=1,NKR
-                 FI1_K=PSI1(K)
-                 R1_K=R1(K)
-                 FI1R1=FI1_K*R1_K*R1_K
-                 RMASSLAA=RMASSLAA+FI1R1
-                 DO ICE =1,ICEMAX
-                    FI2(K,ICE)=PSI2(K,ICE)
-                    FI2_K=FI2(K,ICE)
-                    R2_K=R2(K,ICE)
-                    FI2R2=FI2_K*R2_K*R2_K
-                    RMASSIAA=RMASSIAA+FI2R2
-                 ENDDO
-                 FI3_K=PSI3(K)
-                 FI4_K=PSI4(K)
-                 FI5_K=PSI5(K)
-                 R3_K=R3(K)
-                 R4_K=R4(K)
-                 R5_K=R5(K)
-                 FI3R3=FI3_K*R3_K*R3_K
-                 FI4R4=FI4_K*R4_K*R4_K
-                 FI5R5=FI5_K*R5_K*R5_K
-                 RMASSIAA=RMASSIAA+FI3R3
-                 RMASSIAA=RMASSIAA+FI4R4
-                 RMASSIAA=RMASSIAA+FI5R5
-              ENDDO
-              RMASSIAA=RMASSIAA*COL3*RORI
-! NEW CHANGE RMASSIAA
-              IF(RMASSIAA.LE.0.0) RMASSIAA=0.0
-              RMASSLAA=RMASSLAA*COL3*RORI
-! NEW CHANGE RMASSLAA
-              IF(RMASSLAA.LT.0.0) RMASSLAA=0.0
-! NEW TREATMENT OF "T" & "Q"
-              DELMASSL1=RMASSLAA-RMASSLBB
-              DELMASSI1=RMASSIAA-RMASSIBB
-              DELTAQ1=DELMASSL1+DELMASSI1
-!             QPN=QPS-DELTAQ1-CWQ*DTT
-              QPN=QPS-DELTAQ1
-              DAL1=AL1
-              DAL2=AL2
-!             TPN=TPS+DAL1*DELMASSL1+AL2*DELMASSI1-CWQ*DTT
-              TPN=TPS+DAL1*DELMASSL1+DAL2*DELMASSI1
-! SUPERSATURATION
-              ARGEXP=-BB1_MY/TPN
-              ES1N=AA1_MY*DEXP(ARGEXP)
-              ARGEXP=-BB2_MY/TPN
-              ES2N=AA2_MY*DEXP(ARGEXP)
-              EW1N=OPER3(QPN,PP)
-              IF(ES1N.EQ.0)THEN
-               DEL1N=0.5
-               DIV1=1.5
-!              print*,'es1n onecond3 = 0'
-!              stop
-              ELSE
-               DIV1=EW1N/ES1N
-               DEL1N=EW1N/ES1N-1.
-              END IF
-              IF(ES2N.EQ.0)THEN
-               DEL2N=0.5
-               DIV2=1.5
-!              print*,'es2n onecond3 = 0'
-!              stop
-              ELSE
-               DEL2N=EW1N/ES2N-1.
-               DIV2=EW1N/ES2N
-              END IF
-! END OF TIME SPLITTING
+     RETURN
+     END FUNCTION ecoalmass
+ !coalescence efficiency as function of diameters
+ !---------------------------------------------------------------------------+
+     double precision FUNCTION ecoaldiam(Deta,Dksi,DROPRADII,VR1_BREAKUP,NKR)
 
-! HERE
+     implicit none
+     integer,intent(in) :: NKR
+     real(kind=r8size),intent(in) :: DROPRADII(nkr), VR1_BREAKUP(nkr),Deta,Dksi
 
-        IF(TIMENEW.LT.DT) GOTO 16
-17      CONTINUE
+     real(kind=r8size) :: Dgr, Dkl, Rgr, RKl, q, qmin, qmax, e, x, e1, e2, sin1, cos1
+     real(kind=r8size),PARAMETER :: zero=0.0d0,one=1.0d0,eps=1.0d-30,PI=3.1415927d0
 
-        TT=TPN
-        QQ=QPN
-        DO KR=1,NKR
-           FF1(KR)=PSI1(KR)
-           DO ICE=1,ICEMAX
-              FF2(KR,ICE)=PSI2(KR,ICE)
-           ENDDO
-           FF3(KR)=PSI3(KR)
-           FF4(KR)=PSI4(KR)
-           FF5(KR)=PSI5(KR)
-        ENDDO
+     Dgr=dmax1(Deta,Dksi)
+     Dkl=dmin1(Deta,Dksi)
 
+     Rgr=0.5d0*Dgr
+     Rkl=0.5d0*Dkl
 
-        RETURN                                          
-        END SUBROUTINE ONECOND3
-        SUBROUTINE COAL_BOTT_NEW(FF1R,FF2R,FF3R, &
-     &   FF4R,FF5R,TT,QQ,PP,RHO,dt_coll,TCRIT,TTCOAL)
-       implicit none
-       INTEGER KR,ICE
-       INTEGER icol_drop,icol_snow,icol_graupel,icol_hail, &
-     & icol_column,icol_plate,icol_dendrite,icol_drop_brk
-       double precision  g1(nkr),g2(nkr,icemax),g3(nkr),g4(nkr),g5(nkr)
-       double precision gdumb(JMAX),xl_dumb(0:nkr),g_orig(nkr)
-       double precision g2_1(nkr),g2_2(nkr),g2_3(nkr)
-       real cont_fin_drop,dconc,conc_icempl,deldrop,t_new, &
-     & delt_new,cont_fin_ice,conc_old,conc_new,cont_init_ice, &
-     & cont_init_drop,ALWC
-       REAL    FF1R(NKR),FF2R(NKR,ICEMAX),FF3R(NKR),FF4R(NKR),FF5R(NKR)
-       REAL dt_coll
-       REAL TCRIT,TTCOAL
-       real tt_no_coll
-       parameter (tt_no_coll=273.16)
-
-
-       
-   
-! SHARED
-       INTEGER I,J,IT,NDIV
-       REAL RHO
-       DOUBLE PRECISION break_drop_bef,break_drop_aft,dtbreakup
-       DOUBLE PRECISION break_drop_per
-       DOUBLE PRECISION TT,QQ,PP,prdkrn,prdkrn1
-       parameter (prdkrn1=1.d0)
-!     print*,'tcrit = ',tcrit
-!     print*,'ttcoal = ',ttcoal
-!     print*,'col = ',col
-!     print*,'p1,p2,p3 = ',p1,p2,p3
-!     print*,'icempl,kr_icempl  = ',icempl,kr_icempl
-!     print*,'dt_coll = ',dt_coll
-      icol_drop_brk=0
-      icol_drop=0
-      icol_snow=0
-      icol_graupel=0
-      icol_hail=0
-      icol_column=0
-      icol_plate=0
-      icol_dendrite=0
-
-
-       t_new=tt
-         CALL MISC1(PP,cwll_1000mb,cwll_750mb,cwll_500mb, &
-     &    cwll,nkr)
-! THIS IS FOR BREAKUP
-         DO I=1,NKR
-            DO J=1,NKR
-               CWLL(I,J)=ECOALMASSM(I,J)*CWLL(I,J)
-            ENDDO
-         ENDDO
-!
-! THIS IS FOR TURBULENCE
-        IF (LIQTURB.EQ.1)THEN
-         DO I=1,KRMAX_LL
-           DO J=1,KRMAX_LL
-               CWLL(I,J)=CTURBLL(I,J)*CWLL(I,J)
-           END DO
-         END DO
-        END IF
-         CALL MODKRN(TT,QQ,PP,PRDKRN,TTCOAL)
-        DO 13 KR=1,NKR
-         G1(KR)=FF1R(KR)*3.*XL(KR)*XL(KR)*1.E3
-         G2(KR,1)=FF2R(KR,1)*3*xi(KR,1)*XI(KR,1)*1.e3
-         G2(KR,2)=FF2R(KR,2)*3.*xi(KR,2)*XI(KR,2)*1.e3
-         G2(KR,3)=FF2R(KR,3)*3.*xi(KR,3)*XI(KR,3)*1.e3
-         G3(KR)=FF3R(KR)*3.*xs(kr)*xs(kr)*1.e3
-         G4(KR)=FF4R(KR)*3.*xg(kr)*xg(kr)*1.e3
-         G5(KR)=FF5R(KR)*3.*xh(kr)*xh(kr)*1.e3
-         g2_1(kr)=g2(KR,1)
-         g2_2(KR)=g2(KR,2)
-         g2_3(KR)=g2(KR,3)
-         if(kr.gt.(nkr-jbreak).and.g1(kr).gt.1.e-17)icol_drop_brk=1
-!        icol_drop_brk=0
-         IF (IBREAKUP.NE.1)icol_drop_brk=0 
-         if(g1(kr).gt.1.e-10)icol_drop=1
-         if (tt.le.tt_no_coll)then
-         if(g2_1(kr).gt.1.e-10)icol_column=1
-         if(g2_2(kr).gt.1.e-10)icol_plate=1
-         if(g2_3(kr).gt.1.e-10)icol_dendrite=1
-         if(g3(kr).gt.1.e-10)icol_snow=1
-         if(g4(kr).gt.1.e-10)icol_graupel=1
-         if(g5(kr).gt.1.e-10)icol_hail=1
-         end if
-13     CONTINUE 
-! calculation of initial hydromteors content in g/cm**3 :
-      cont_init_drop=0.
-      cont_init_ice=0.
-      do kr=1,nkr
-         cont_init_drop=cont_init_drop+g1(kr)
-         cont_init_ice=cont_init_ice+g3(kr)+g4(kr)+g5(kr)
-         do ice=1,icemax
-            cont_init_ice=cont_init_ice+g2(kr,ice)
-         enddo
-      enddo
-      cont_init_drop=col*cont_init_drop*1.e-3
-      cont_init_ice=col*cont_init_ice*1.e-3
-! calculation of alwc in g/m**3
-      alwc=cont_init_drop*1.e6
-! calculation interactions :
-! droplets - droplets and droplets - ice :
-! water-water = water
+     q=0.5d0*(Rkl+Rgr)
 
-      if (icol_drop.eq.1)then 
-! break-up
-
-       call coll_xxx (G1,CWLL,XL_MG,CHUCM,IMA,NKR)
-! breakup!
-       if(icol_drop_brk.eq.1)then
-       ndiv=1
-10     continue
-       do it = 1,ndiv
-         if (ndiv.gt.10000) call wrf_error_fatal("fatal error in module_mp_fast_sbm (ndiv.gt.10000), model stop")
-         dtbreakup = dt_coll/ndiv
-         if (it.eq.1)then
-!         do kr=1,nkr
-          do kr=1,JMAX
-           gdumb(kr)= g1(kr)*1.D-3
-           xl_dumb(kr)=xl_mg(KR)*1.D-3
-          end do
-          break_drop_bef=0.d0
-!         do kr=1,nkr
-          do kr=1,JMAX
-            break_drop_bef=break_drop_bef+g1(kr)*1.D-3
-          enddo
-         end if
-         call breakup(gdumb,xl_dumb,dtbreakup,brkweight, &
-     &        pkij,qkj,JMAX,jbreak)
-       end do
-       break_drop_aft=0.0d0
-       do kr=1,JMAX
-           break_drop_aft=break_drop_aft+gdumb(kr)
-       enddo
-       break_drop_per=break_drop_aft/break_drop_bef
-       if (break_drop_per.gt.1.001)then
-           ndiv=ndiv*2
-           GO TO 10
-       else
-           do kr=1,JMAX
-            g1(kr)=gdumb(kr)*1.D3
-           end do
-       end if
-       end if
-      end if
-       if (icol_snow.eq.1)then 
-         call coll_xyz (g1,g3,g4,cwls,xl_mg,xs_mg, &
-     &                chucm,ima,prdkrn1,nkr,0)
-         if(alwc.lt.alcr) then
-         call coll_xyx (g3,g1,cwsl,xs_mg,xl_mg, &
-     &                chucm,ima,prdkrn1,nkr,1)
-         endif
-         if(alwc.ge.alcr) then
-!        call coll_xyz (g3,g1,g4,cwsl,xs_mg,xl_mg, &
-!    &                chucm,ima,prdkrn1,nkr,1)
-            call coll_xyxz_h (g3,g1,g4,cwsl,xs_mg,xl_mg, &
-     &                chucm,ima,prdkrn1,nkr,1)
-         endif
-! in case : icolxz_snow.ne.0
-       end if
-! interactions between water and  graupel (begin)
-! water - graupel = graupel (t < tcrit ; xl_mg ge xg_mg)
-! graupel - water = graupel (t < tcrit ; xg_mg > xl_mg)
-! water - graupel = hail (t ge tcrit ; xl_mg ge xg_mg)
-! graupel - water = hail (t ge tcrit ; xg_mg > xl_mg)
-       if (icol_graupel.eq.1)then 
-! water-graupel
-! included kp_bound = 25
-!!         call coll_xyyz_h (g1,g4,g5,cwlg,xl_mg,xg_mg, &
-!!     &                chucm,ima,prdkrn1,nkr,1)
-! for ice multiplication
-          conc_old=0.
-          conc_new=0.
-          do kr=kr_icempl,nkr
-               conc_old=conc_old+col*g1(kr)/xl_mg(kr)
-          enddo
-! graupel-water
-!          if(alwc.lt.alcr_g) then
-! water-graupel
-! TEST
-            call coll_xyy (g1,g4,cwlh,xl_mg,xg_mg, &
-     &               chucm,ima,prdkrn1,nkr,0)
-            call coll_xyx (g4,g1,cwhl,xg_mg,xl_mg, &
-     &          chucm,ima,prdkrn1,nkr,1)
-! TEST
-!          else
-!!          call coll_xyxz_h (g4,g1,g5,cwgl,xg_mg,xl_mg, &
-!!   &                chucm,ima,prdkrn1,nkr,1)
-!          end if
-! interactions between water and  graupels (end)
-
-         if(icempl.eq.1) then
-          if(tt.ge.265.15.and.tt.le.tcrit) then
-! ice-multiplication :
-            do kr=kr_icempl,nkr
-               conc_new=conc_new+col*g1(kr)/xl_mg(kr)
-            enddo
-            dconc=conc_old-conc_new
-            if(tt.le.268.15) then
-              conc_icempl=dconc*4.e-3*(265.15-tt)/(265.15-268.15)
-            endif
-            if(tt.gt.268.15) then
-             conc_icempl=dconc*4.e-3*(tcrit-tt)/(tcrit-268.15)
-            endif
-!CHANGE FOR FOUR BIN SCHEME           g2_2(1)=g2_2(1)+conc_icempl*xi2_mg(1)/col
-            g3(1)=g3(1)+conc_icempl*xs_mg(1)/col
-! in case t.ge.265.15 :
-          endif
-! in case icempl=1
-         endif
-! interactions between water and  graupels (end)
-! in case icolxz_graup.ne.0
-       endif
-! water - hail = hail (xl_mg ge xh_mg)                      (kxyy=2)
-! hail - water = hail (xh_mg > xl_mg)                       (kxyx=3)
-!      if(icol_hail.eq.1) then
-!       call coll_xyy (g1,g5,cwlh,xl_mg,xh_mg, &
-!    &               chucm,ima,prdkrn1,nkr,0)
-!       call coll_xyx (g5,g1,cwhl,xh_mg,xl_mg, &
-!    &               chucm,ima,prdkrn1,nkr,1)
-! in case icolxz_hail.ne.0
-!      endif
-! interactions between water and hail (end)
-! interactions between water and crystals :
-! interactions between water and columns :
-! water - columns = graupel (t < tcrit ; xl_mg ge xi_mg)    (kxyz=6)
-! water - columns = hail (t ge tcrit ; xl_mg ge xi_mg)      (kxyz=7)
-! columns - water = columns/graupel (xi_mg > xl_mg)             (kxyx=4); kxyxz=2)
-! now: columns - water = columns (xi_mg > xl_mg)             (kxyx=4); kxyxz=2)
-!      if(icol_column.eq.1) then
-!       if(tt.lt.tcrit) then
-!        call coll_xyz (g1,g2_1,g4,cwli_1,xl_mg,xi1_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!       endif
-!       if(tt.ge.tcrit) then
-!        call coll_xyz (g1,g2_1,g5,cwli_1,xl_mg,xi1_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!       endif
-!       call coll_xyxz (g2_1,g1,g4,cwil_1,xi1_mg,xl_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-!       call coll_xyx (g2_1,g1,cwil_1,xi1_mg,xl_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-! in case icolxz_column.ne.0
-!      endif
-
-!     if(icolxz_plate.ne.0) then
-! interactions between water and plates :
-! water - plates = graupel (t < tcrit ; xl_mg ge xi2_mg)    (kxyz=8)
-! water - plates = hail (t ge tcrit ; xl_mg ge xi2_mg)      (kxyz=9)
-! plates - water = plates/graupel (xi2_mg > xl_mg)              (kxyx=5; kxyxz=3)
-!now: plates - water = plates (xi2_mg > xl_mg)              (kxyx=5; kxyxz=3)
-!      if(icol_plate.eq.1) then
-!       if(tt.lt.tcrit) then
-!        call coll_xyz (g1,g2_2,g4,cwli_2,xl_mg,xi2_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!       endif
-!       if(tt.ge.tcrit) then
-!        call coll_xyz (g1,g2_2,g5,cwli_2,xl_mg,xi2_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!       endif
-!       call coll_xyxz (g2_2,g1,g4,cwil_2,xi2_mg,xl_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-!       call coll_xyx (g2_2,g1,cwil_2,xi2_mg,xl_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-! in case icolxz_plate.ne.0
-!      endif
-
-! interactions between water and dendrites :
-! water - dendrites = graupel (t < tcrit ; xl_mg ge xi3_mg) (kxyz=10)
-! water - dendrites = hail (t ge tcrit ; xl_mg ge xi3_mg)   (kxyz=11)
-! dendrites - water = dendrites/graupel (xi3_mg > xl_mg)         (kxyx=6; kxyxz=4)
-!now dendrites - water = dendrites (xi3_mg > xl_mg)         (kxyx=6; kxyxz=4)
-!      if(icol_dendrite.eq.1) then
-!       if(tt.lt.tcrit) then
-!        call coll_xyz (g1,g2_3,g4,cwli_3,xl_mg,xi3_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!       endif
-!       if(tt.ge.tcrit) then
-!        call coll_xyz (g1,g2_3,g5,cwli_3,xl_mg,xi3_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!       endif
-!       call coll_xyxz (g2_3,g1,g4,cwil_3,xi3_mg,xl_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-!       call coll_xyx (g2_3,g1,cwil_3,xi3_mg,xl_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-! in case icolxz_dendr.ne.0
-!      endif
-! interactions between water and dendrites (end)
-! in case icolxz_drop.ne.0
-!     endif
-! interactions between water and crystals (end)
-
-! interactions between crystals :
-! if(t.le.TTCOAL) - no interactions between crystals
-!     if(tt.gt.TTCOAL) then
-! interactions between columns and other particles (begin)
-!      if(icol_column.eq.1) then
-! columns - columns = snow
-!       call coll_xxy (g2_1,g3,cwii_1_1,xi1_mg, &
-!    &                 chucm,ima,prdkrn,nkr)
-! interactions between columns and plates :
-! columns - plates = snow (xi1_mg ge xi2_mg)                (kxyz=12)
-! plates - columns = snow (xi2_mg > xi1_mg)                 (kxyz=13)
-!       if(icol_plate.eq.1) then     
-!        call coll_xyz (g2_1,g2_2,g3,cwii_1_2,xi1_mg,xi2_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!        call coll_xyz (g2_2,g2_1,g3,cwii_2_1,xi2_mg,xi1_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-!       end if
-! interactions between columns and dendrites :
-! columns - dendrites = snow (xi1_mg ge xi3_mg)             (kxyz=14)
-! dendrites - columns = snow (xi3_mg > xi1_mg)              (kxyz=15)
-!       if(icol_dendrite.eq.1) then
-!          call coll_xyz (g2_1,g2_3,g3,cwii_1_3,xi1_mg,xi3_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!          call coll_xyz (g2_3,g2_1,g3,cwii_3_1,xi3_mg,xi1_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-!       end if
-! interactions between columns and snow :
-! columns - snow = snow (xi1_mg ge xs_mg)                   (kxyy=3)
-! snow - columns = snow (xs_mg > xi1_mg)                    (kxyx=7)
-! ALEX?
-!       if(icol_snow.eq.1) then
-!B       call coll_xyy (g2_1,g3,cwis_1,xi1_mg,xs_mg,
-!B   1                 chucm,ima,prdkrn,nkr,0)
-!!        call coll_xyx (g3,g2_1,cwsi_1,xs_mg,xi1_mg, &
-!!    &                 chucm,ima,prdkrn,nkr,1)
-!       endif          
-! in case icolxz_column.ne.0
-!      endif
-! interactions between columns and other particles (end)
-! interactions between plates and other particles (begin)
-! plates - plates = snow
-!      if(icol_plate.eq.1) then
-!       call coll_xxy (g2_2,g3,cwii_2_2,xi2_mg, &
-!    &                 chucm,ima,prdkrn,nkr)
-! interactions between plates and dendrites :
-! plates - dendrites = snow (xi2_mg ge xi3_mg)              (kxyz=17)
-! dendrites - plates = snow (xi3_mg > xi2_mg)               (kxyz=18)
-!       if(icol_dendrite.eq.1) then
-!        call coll_xyz (g2_2,g2_3,g3,cwii_2_3,xi2_mg,xi3_mg, &
-!    &                 chucm,ima,prdkrn,nkr,0)
-!        call coll_xyz (g2_3,g2_2,g3,cwii_3_2,xi3_mg,xi2_mg, &
-!    &                 chucm,ima,prdkrn,nkr,1)
-!       end if
-! interactions between plates and snow :
-! plates - snow = snow (xi2_mg ge xs_mg)                    (kxyy=4)
-! snow - plates = snow (xs_mg > xi2_mg)                     (kxyx=12)
-!       if(icol_snow.eq.1) then
-! ALEX
-!B       call coll_xyy (g2_2,g3,cwis_2,xi2_mg,xs_mg,
-!B   1                 chucm,ima,prdkrn,nkr,0)
-!!        call coll_xyx (g3,g2_2,cwsi_2,xs_mg,xi2_mg, &
-!!     &                 chucm,ima,prdkrn,nkr,1)
-!        end if
-! in case icolxz_plate.ne.0
-!      endif
-! interactions between plates and others particles (end)
-! interactions between dendrites and other hydrometeors (begin)
-! dendrites - dendrites = snow
-!      if(icol_dendrite.eq.1) then
-!!       call coll_xxy (g2_3,g3,cwii_3_3,xi3_mg, &
-!!    &                  chucm,ima,prdkrn,nkr)
-! interactions between dendrites and snow :
-! dendrites - snow = snow (xi3_mg ge xs_mg)                 (kxyy=5)
-! snow - dendrites = snow (xs_mg > xi3_mg)                  (kxyx=17)
-!       if(icol_snow.eq.1) then
-! ALEX
-!B       call coll_xyy (g2_3,g3,cwis_3,xi3_mg,xs_mg,
-!B   1                 chucm,ima,prdkrn,nkr,0)
-!!        call coll_xyx (g3,g2_3,cwsi_3,xs_mg,xi3_mg, &
-!!   &                 chucm,ima,prdkrn,nkr,1)
-!       end if
-! in case icolxz_dendr.ne.0
-!      endif
-! interactions between dendrites and other hydrometeors (end)
-! interactions between snowflakes and other hydromteors (begin)
-!       if(icol_snow.ne.0) then
-! interactions between snowflakes
-! snow - snow = snow
-         call coll_xxx_prd (g3,cwss,xs_mg,chucm,ima,prdkrn,nkr)
-! interactions between snowflakes and graupels :
-! snow - graupel = snow (xs_mg > xg_mg)                     (kxyx=22)
-! graupel - snow = graupel (xg_mg ge xs_mg)                 (kxyx=23)
-!        if(icol_graupel.eq.1) then
-!!         call coll_xyx (g3,g4,cwsg,xs_mg,xg_mg, &
-!!   &                chucm,ima,prdkrn,nkr,1)
-! in case icolxz_graup.ne.0
-!        endif
-! in case icolxz_snow.ne.0
-!       endif
-! interactions between snowflakes and other hydromteors (end)
-! in case : t > TTCOAL
-!     endif
-! in case : t > TTCOAL or t.le.TTCOAL
-! calculation of finish hydrometeors contents in g/cm**3 :
-      cont_fin_drop=0.
-      cont_fin_ice=0.
-      do kr=1,nkr
-!        g2(kr,1)=g2_1(kr)
-!        g2(kr,2)=g2_2(kr)
-!        g2(kr,3)=g2_3(kr)
-         cont_fin_drop=cont_fin_drop+g1(kr)
-!        cont_fin_ice=cont_fin_ice+g3(kr)+g4(kr)+g5(kr)
-         cont_fin_ice=cont_fin_ice+g3(kr)+g4(kr)
-!        do ice=1,icemax
-!           cont_fin_ice=cont_fin_ice+g2(kr,ice)
-!        enddo
-      enddo
-      cont_fin_drop=col*cont_fin_drop*1.e-3
-      cont_fin_ice=col*cont_fin_ice*1.e-3
-      deldrop=cont_init_drop-cont_fin_drop
-! deldrop in g/cm**3
-! resulted value of temperature (rob in g/cm**3) :
-      if(t_new.le.273.15) then
-        if(deldrop.ge.0.) then
-          t_new=t_new+320.*deldrop/rho
-        else
-! if deldrop < 0
-          if(abs(deldrop).gt.cont_init_drop*0.05) then
-            call wrf_error_fatal("fatal error in module_mp_fast_sbm, abs(deldrop).gt.cont_init_drop, model stop")
-          endif
-        endif
-       endif
+     qmin=250.0d-4
+     qmax=500.0d-4
+
+     if(Dkl<100.0d-4) then
+
+         e=1.0d0
 
-61    continue
-! recalculation of density function f1,f2,f3,f4,f5 in 1/(g*cm**3) :  
-        DO 15 KR=1,NKR
-         FF1R(KR)=G1(KR)/(3.*XL(KR)*XL(KR)*1.E3)
-!        FF2R(KR,1)=G2(KR,1)/(3*xi(KR,1)*XI(KR,1)*1.e3)
-!        FF2R(KR,2)=G2(KR,2)/(3.*xi(KR,2)*XI(KR,2)*1.e3)
-!        FF2R(KR,3)=G2(KR,3)/(3.*xi(KR,3)*XI(KR,3)*1.e3)
-         FF3R(KR)=G3(KR)/(3.*xs(kr)*xs(kr)*1.e3)
-         FF4R(KR)=G4(KR)/(3.*xg(kr)*xg(kr)*1.e3)
-!        FF5R(KR)=G5(KR)/(3.*xh(kr)*xh(kr)*1.e3)
-15     CONTINUE 
-      tt=t_new
-      RETURN
-      END SUBROUTINE COAL_BOTT_NEW
+          elseif (q gmin :
-              endif
-            end do
-        end do
- 2020   continue
-        return
-        end subroutine coll_xxx
-        subroutine coll_xxx_prd (g,ckxx,x,chucm,ima,prdkrn,nkr)
-        implicit double precision (a-h,o-z)
-        dimension g(nkr),ckxx(nkr,nkr),x(0:nkr)
-        dimension chucm(nkr,nkr)
-        double precision ima(nkr,nkr)
-! this is character values containes adresses of temporary files      
-        gmin=1.d-60
-!       gmin=1.d-15
-! lower and upper integration limit ix0,ix1
-        do i=1,nkr-1
-           ix0=i
-           if(g(i).gt.gmin) goto 2000
-        enddo
- 2000   continue
-        if(ix0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           ix1=i
-           if(g(i).gt.gmin) goto 2010
-        enddo
- 2010   continue
-! J. Dudhia gave reasons why this can't be looped with a
-! multiprocessor.
-! BARRY
-!       do i=ix0,ix1
-!          do j=i,ix1
-        do i=ix0,ix1-1
-           do j=i+1,ix1
+     elseif(q>=qmin.and.q gmin :
-              endif
-            end do
-        end do
- 2020   continue
-        return
-        end subroutine coll_xxx_prd 
-      subroutine modkrn(TT,QQ,PP,PRDKRN,TTCOAL)
-      implicit none
-      real epsf,tc,ttt1,ttt,factor,qs2,qq1,dele,f,factor_t
-      double precision TT,QQ,PP,satq2,t,p
-      double precision prdkrn
-      REAL at,bt,ct,dt,temp,a,b,c,d,tc_min,tc_max
-       real factor_max,factor_min
-      REAL TTCOAL
-	data at,bt,ct,dt/0.88333,0.0931878,0.0034793,4.5185186e-05/
-        satq2(t,p)=3.80e3*(10**(9.76421-2667.1/t))/p
-        temp(a,b,c,d,tc)=d*tc*tc*tc+c*tc*tc+b*tc+a
-        IF (QQ.LE.0)QQ=1.E-12
-        epsf    =.5
-        tc      =tt-273.15
-        factor=0 ! mchen add temporarily
-        if(tc.le.0) then
-! in case tc.le.0
-          ttt1  =temp(at,bt,ct,dt,tc)
-          ttt   =ttt1
-          qs2   =satq2(tt,pp)
-          qq1   =qq*(0.622+0.378*qs2)/(0.622+0.378*qq)/qs2
-          dele  =ttt*qq1
-! new change 27.06.00
-          if(tc.ge.-6.) then
-            factor = dele
-            if(factor.lt.epsf) factor=epsf
-            if(factor.gt.1.) factor=1.
-! in case : tc.ge.-6.
-          endif                        
-          factor_t=factor
-          if(tc.ge.-12.5.and.tc.lt.-6.) factor_t=0.5
-          if(tc.ge.-17.0.and.tc.lt.-12.5) factor_t=1.
-          if(tc.ge.-20.0.and.tc.lt.-17.) factor_t=0.4
-          if(tc.lt.-20.) then
-            tc_min=ttcoal-273.15
-            tc_max=-20.
-            factor_max=0.25
-            factor_min=0.
-            f=factor_min+(tc-tc_min)*(factor_max-factor_min)/  &
-     &                               (tc_max-tc_min)
-            factor_t=f
-          endif
-! BARRY
-          if (factor_t.lt.0)factor_t=0.01
-          prdkrn=factor_t
-      else
-          prdkrn=1.d0
-      end if
-      RETURN
-      END SUBROUTINE modkrn 
-           
-
-
-        subroutine coll_xxy(gx,gy,ckxx,x,chucm,ima,prdkrn,nkr)
-        implicit double precision (a-h,o-z)
-        dimension chucm(nkr,nkr)
-        double precision ima(nkr,nkr)
-        dimension  &
-     &  gx(nkr),gy(nkr),ckxx(nkr,nkr),x(0:nkr)
-        gmin=1.d-60
-! lower and upper integration limit ix0,ix1
-        do i=1,nkr-1
-           ix0=i
-           if(gx(i).gt.gmin) goto 2000
-        enddo
-        if(ix0.eq.nkr-1) goto 2020
- 2000   continue
-        do i=nkr-1,1,-1
-           ix1=i
-           if(gx(i).gt.gmin) goto 2010
-        enddo
- 2010   continue
-! collisions
-        do i=ix0,ix1
-           do j=i,ix1
-              k=ima(i,j)
-              kp=k+1
-              x0=ckxx(i,j)*gx(i)*gx(j)*prdkrn
-              x0=min(x0,gx(i)*x(j))
-              x0=min(x0,gx(j)*x(i))
-              gsi=x0/x(j)
-              gsj=x0/x(i)
-              gsk=gsi+gsj
-              gx(i)=gx(i)-gsi
-              if(gx(i).lt.0.d0) gx(i)=0.d0
-              gx(j)=gx(j)-gsj
-              if(gx(j).lt.0.d0) gx(j)=0.d0
-              gk=gy(k)+gsk
-              flux=0.d0
-! BARRY
-              if(gk.gt.gmin) then
-! new changes 13.01.01 (begin)
-                x1=dlog(gy(kp)/gk+1.d-15)
-! BARRY
-!               flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-! new changes 23.01.01 (begin)
-!               flux=min(flux,gk)
-!               flux=min(flux,gsk)
-! new changes 23.01.01 (end)
-! new changes 13.01.01 (end)
-! BARRY
-               if (x1.eq.0)then
-                flux=0  
-               else
-                flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-                flux=min(flux,gsk)
-               end if
-                gy(k)=gk-flux
-                if(gy(k).lt.0.d0) gy(k)=0.d0
-                gy(kp)=gy(kp)+flux
-! in case gk > gmin :
-              endif
-           enddo
-        enddo
- 2020   continue
-        return
-        end subroutine coll_xxy
-!====================================================================
-        subroutine coll_xyy(gx,gy,ckxy,x,y,chucm,ima, &
-     &     prdkrn,nkr,indc)
-        implicit double precision (a-h,o-z)
-        dimension  &
-     &  gy(nkr),gx(nkr),ckxy(nkr,nkr),x(0:nkr),y(0:nkr)
-        dimension chucm(nkr,nkr)
-        double precision ima(nkr,nkr)
-        gmin=1.d-60
-! lower and upper integration limit ix0,ix1
-        do i=1,nkr-1
-           ix0=i
-           if(gx(i).gt.gmin) go to 2000
-        enddo
- 2000   continue
-        if(ix0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           ix1=i
-           if(gx(i).gt.gmin) go to 2010
-        enddo
- 2010   continue
-! lower and upper integration limit iy0,iy1
-        do i=1,nkr-1
-           iy0=i
-           if(gy(i).gt.gmin) go to 2001
-        enddo
- 2001   continue
-        if(iy0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           iy1=i
-           if(gy(i).gt.gmin) go to 2011
-        enddo
- 2011   continue
-! collisions :
-        do i=iy0,iy1
-           jmin=i
-           if(jmin.eq.(nkr-1)) goto 2020
-           if(i.lt.ix0) jmin=ix0-indc
-	   do j=jmin+indc,ix1         
-              k=ima(i,j)
-              kp=k+1
-              x0=ckxy(j,i)*gy(i)*gx(j)*prdkrn
-              x0=min(x0,gy(i)*x(j))
-              x0=min(x0,gx(j)*y(i))
-              gsi=x0/x(j)
-              gsj=x0/y(i)
-              gsk=gsi+gsj
-              gy(i)=gy(i)-gsi
-              if(gy(i).lt.0.d0) gy(i)=0.d0
-              gx(j)=gx(j)-gsj
-              if(gx(j).lt.0.d0) gx(j)=0.d0
-              gk=gy(k)+gsk
-              flux=0.d0
-! BARRY
-              if(gk.gt.gmin) then
-                x1=dlog(gy(kp)/gk+1.d-15)
-! BARRY
-!               flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-! new changes 23.01.01 (begin)
-!               flux=min(flux,gk)
-!               flux=min(flux,gsk)
-! BARRY
-               if (x1.eq.0)then
-                flux=0  
-               else
-                flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-                flux=min(flux,gsk)
-               end if
-! new changes 23.01.01 (end)
-                gy(k)=gk-flux
-                if(gy(k).lt.0.d0) gy(k)=0.d0
-                gy(kp)=gy(kp)+flux
-! in case gk > gmin :
-              endif
-! in case gk > gmin or gk.le.gmin
-           enddo
-        enddo
- 2020   continue
-        return
-        end subroutine coll_xyy
-!=================================================================
-        subroutine coll_xyx(gx,gy,ckxy,x,y,chucm,ima, &
-     &    prdkrn,nkr,indc)
-        implicit double precision (a-h,o-z)
-        dimension gy(nkr),gx(nkr),ckxy(nkr,nkr),x(0:nkr),y(0:nkr)
-        dimension chucm(nkr,nkr)
-        double precision ima(nkr,nkr)
-        gmin=1.d-60
-! lower and upper integration limit ix0,ix1
-        do i=1,nkr-1
-           ix0=i
-           if(gx(i).gt.gmin) go to 2000
-        enddo
- 2000   continue
-        if(ix0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           ix1=i
-           if(gx(i).gt.gmin) go to 2010
-        enddo
- 2010   continue
-! lower and upper integration limit iy0,iy1
-        do i=1,nkr-1
-           iy0=i
-           if(gy(i).gt.gmin) go to 2001
-        enddo
- 2001   continue
-        if(iy0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           iy1=i
-           if(gy(i).gt.gmin) go to 2011
-        enddo
- 2011   continue
-! collisions :
-        do i=iy0,iy1
-           jmin=i
-           if(jmin.eq.(nkr-1)) goto 2020
-           if(i.lt.ix0) jmin=ix0-indc
-	   do j=jmin+indc,ix1
-              k=ima(i,j)
-              kp=k+1
-              x0=ckxy(j,i)*gy(i)*gx(j)*prdkrn
-              x0=min(x0,gy(i)*x(j))
-              if(j.ne.k) then
-                x0=min(x0,gx(j)*y(i))
-              endif
-              gsi=x0/x(j)
-              gsj=x0/y(i)
-              gsk=gsi+gsj
-              gy(i)=gy(i)-gsi
-              if(gy(i).lt.0.d0) gy(i)=0.d0
-              gx(j)=gx(j)-gsj
-              gk=gx(k)+gsk
-! BARRY
-!             if(gx(j).lt.0.d0)then
-!                gy(i)=gy(i)+gsi
-!                gx(j)=gx(j)+gsj
-!                go to 10
-!             end if
-              if(gx(j).lt.0.d0.and.gk.lt.gmin) then
-                gx(j)=0.d0
-                gx(k)=gx(k)+gsi
-              endif
-              flux=0.d0            
-! BARRY
-              if(gk.gt.gmin) then
-                x1=dlog(gx(kp)/gk+1.d-15)
-! BARRY
-!               flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-! new changes 23.01.01 (begin)
-!               flux=min(flux,gk)
-!               flux=min(flux,gsk)
-! BARRY
-               if (x1.eq.0)then
-                flux=0  
-               else
-                flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-                flux=min(flux,gsk)
-               end if
-! new changes 23.01.01 (end)
-                gx(k)=gk-flux
-                if(gx(k).lt.0.d0) gx(k)=0.d0
-                gx(kp)=gx(kp)+flux
-! in case gk > gmin :
-              endif
-! in case gk > gmin or gk.le.gmin
-! BARRY
-10         continue
-           enddo
-        enddo
- 2020   continue
-        return
-        end subroutine coll_xyx
-!=====================================================================
-        subroutine coll_xyxz(gx,gy,gz,ckxy,x,y,chucm,ima, &
-     &    prdkrn,nkr,indc)
-        implicit double precision (a-h,o-z)
-      dimension gy(nkr),gx(nkr),gz(nkr),ckxy(nkr,nkr),x(0:nkr),y(0:nkr)
-        dimension chucm(nkr,nkr)
-        double precision ima(nkr,nkr)
-        gmin=1.d-60
-! lower and upper integration limit ix0,ix1
-        do i=1,nkr-1
-           ix0=i
-           if(gx(i).gt.gmin) go to 2000
-        enddo
- 2000   continue
-        if(ix0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           ix1=i
-           if(gx(i).gt.gmin) go to 2010
-        enddo
- 2010   continue
-! lower and upper integration limit iy0,iy1
-        do i=1,nkr-1
-           iy0=i
-           if(gy(i).gt.gmin) go to 2001
-        enddo
- 2001   continue
-        if(iy0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           iy1=i
-           if(gy(i).gt.gmin) go to 2011
-        enddo
- 2011   continue
-! collisions :
-        do i=iy0,iy1
-           jmin=i
-           if(jmin.eq.(nkr-1)) goto 2020
-           if(i.lt.ix0) jmin=ix0-indc
-	   do j=jmin+indc,ix1
-              k=ima(i,j)
-              kp=k+1
-              x0=ckxy(j,i)*gy(i)*gx(j)*prdkrn
-              x0=min(x0,gy(i)*x(j))
-              if(j.ne.k) then
-                x0=min(x0,gx(j)*y(i))
-              endif
-              gsi=x0/x(j)
-              gsj=x0/y(i)
-              gsk=gsi+gsj
-              gy(i)=gy(i)-gsi
-              if(gy(i).lt.0.d0) gy(i)=0.d0
-              gx(j)=gx(j)-gsj
-              gk=gx(k)+gsk
-              if(gx(j).lt.0.d0.and.gk.lt.gmin) then
-                gx(j)=0.d0
-                gx(k)=gx(k)+gsi
-              endif
-              flux=0.d0
-! BARRY
-              if(kp.lt.17) gkp=gx(kp)
-              if(kp.ge.17) gkp=gz(kp)
-              if(gk.gt.gmin) then
-                x1=dlog(gkp/gk+1.d-15)
-! BARRY
-!               flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-! new changes 23.01.01 (begin)
-!               flux=min(flux,gk)
-!               flux=min(flux,gsk)
-! BARRY
-               if (x1.eq.0)then
-                flux=0  
-               else
-                flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-                flux=min(flux,gsk)
-               end if
-! new changes 23.01.01 (end)
-                gx(k)=gk-flux
-                if(gx(k).lt.0.d0) gx(k)=0.d0
-                if(kp.lt.17) gx(kp)=gkp+flux
-                if(kp.ge.17) gz(kp)=gkp+flux
-! ALEX 15 11 2005
-!               if(kp.ge.17) gx(kp)=gkp+flux
-! in case gk > gmin :
-              endif
-! in case gk > gmin or gk.le.gmin
-           enddo
-        enddo
- 2020   continue
-        return
-        end subroutine coll_xyxz
-!=====================================================================
-        subroutine coll_xyxz_h(gx,gy,gz,ckxy,x,y,chucm,ima, &
-     &    prdkrn,nkr,indc)
-        implicit double precision (a-h,o-z)
-      dimension gy(nkr),gx(nkr),gz(nkr),ckxy(nkr,nkr),x(0:nkr),y(0:nkr)
-        dimension chucm(nkr,nkr)
-        double precision ima(nkr,nkr)
-        gmin=1.d-60
-! lower and upper integration limit ix0,ix1
-        do i=1,nkr-1
-           ix0=i
-           if(gx(i).gt.gmin) go to 2000
-        enddo
- 2000   continue
-        if(ix0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           ix1=i
-           if(gx(i).gt.gmin) go to 2010
-        enddo
- 2010   continue
-! lower and upper integration limit iy0,iy1
-        do i=1,nkr-1
-           iy0=i
-           if(gy(i).gt.gmin) go to 2001
-        enddo
- 2001   continue
-        if(iy0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           iy1=i
-           if(gy(i).gt.gmin) go to 2011
-        enddo
- 2011   continue
-! collisions :
-        do i=iy0,iy1
-           jmin=i
-           if(jmin.eq.(nkr-1)) goto 2020
-           if(i.lt.ix0) jmin=ix0-indc
-	   do j=jmin+indc,ix1
-              k=ima(i,j)
-              kp=k+1
-              x0=ckxy(j,i)*gy(i)*gx(j)*prdkrn
-              x0=min(x0,gy(i)*x(j))
-              if(j.ne.k) then
-                x0=min(x0,gx(j)*y(i))
-              endif
-              gsi=x0/x(j)
-              gsj=x0/y(i)
-              gsk=gsi+gsj
-              gy(i)=gy(i)-gsi
-              if(gy(i).lt.0.d0) gy(i)=0.d0
-              gx(j)=gx(j)-gsj
-              gk=gx(k)+gsk
-              if(gx(j).lt.0.d0.and.gk.lt.gmin) then
-                gx(j)=0.d0
-                gx(k)=gx(k)+gsi
-              endif
-              flux=0.d0
-! BARRY
-              if(kp.lt.22) gkp=gx(kp)
-              if(kp.ge.22) gkp=gz(kp)
-              if(gk.gt.gmin) then
-                x1=dlog(gkp/gk+1.d-15)
-! BARRY
-!               flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-! new changes 23.01.01 (begin)
-!               flux=min(flux,gk)
-!               flux=min(flux,gsk)
-! BARRY
-               if (x1.eq.0)then
-                flux=0  
-               else
-                flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-                flux=min(flux,gsk)
-               end if
-! new changes 23.01.01 (end)
-                gx(k)=gk-flux
-                if(gx(k).lt.0.d0) gx(k)=0.d0
-                if(kp.lt.22) gx(kp)=gkp+flux
-                if(kp.ge.22) gz(kp)=gkp+flux
-! ALEX 15 11 2005
-!               if(kp.ge.25) gx(kp)=gkp+flux
-! in case gk > gmin :
-              endif
-! in case gk > gmin or gk.le.gmin
-           enddo
-        enddo
- 2020   continue
-        return
-        end subroutine coll_xyxz_h
-!=====================================================================
-        subroutine coll_xyz(gx,gy,gz,ckxy,x,y,chucm,ima, &
-     &                      prdkrn,nkr,indc)
-        implicit double precision (a-h,o-z)
-      dimension gx(nkr),gy(nkr),gz(nkr),ckxy(nkr,nkr),x(0:nkr),y(0:nkr)
-        dimension chucm(nkr,nkr)
-        double precision ima(nkr,nkr)
-        gmin=1.d-60
-! lower and upper integration limit ix0,ix1
-        do i=1,nkr-1
-           ix0=i
-           if(gx(i).gt.gmin) go to 2000
-        enddo
- 2000   continue
-        if(ix0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           ix1=i
-           if(gx(i).gt.gmin) go to 2010
-        enddo
- 2010   continue
-! lower and upper integration limit iy0,iy1
-        do i=1,nkr-1
-           iy0=i
-           if(gy(i).gt.gmin) go to 2001
-        enddo
- 2001   continue
-        if(iy0.eq.nkr-1) goto 2020
-        do i=nkr-1,1,-1
-           iy1=i
-           if(gy(i).gt.gmin) go to 2011
-        enddo
- 2011   continue
-! collisions :
-        do i=iy0,iy1
-           jmin=i
-           if(jmin.eq.(nkr-1)) goto 2020
-           if(i.lt.ix0) jmin=ix0-indc
-	   do j=jmin+indc,ix1         
-              k=ima(i,j)
-              kp=k+1
-              x0=ckxy(j,i)*gy(i)*gx(j)*prdkrn
-              x0=min(x0,gy(i)*x(j))
-              x0=min(x0,gx(j)*y(i))
-              gsi=x0/x(j)
-              gsj=x0/y(i)
-              gsk=gsi+gsj
-              gy(i)=gy(i)-gsi
-              if(gy(i).lt.0.d0) gy(i)=0.d0
-              gx(j)=gx(j)-gsj
-              if(gx(j).lt.0.d0) gx(j)=0.d0
-              gk=gz(k)+gsk
-              flux=0.d0
-! BARRY
-              if(gk.gt.gmin) then
-                x1=dlog(gz(kp)/gk+1.d-15)
-! BARRY
-               if (x1.eq.0)then
-                flux=0  
-               else
-                flux=gsk/x1*(dexp(0.5*x1)-dexp(x1*(0.5-chucm(i,j))))
-                flux=min(flux,gsk)
-               end if
-! new changes 23.01.01 (end)
-                gz(k)=gk-flux
-                if(gz(k).lt.0.d0) gz(k)=0.d0
-                gz(kp)=gz(kp)+flux
-! in case gk > gmin :
-              endif
-           enddo
-        enddo
- 2020   continue
-        return
-        end subroutine coll_xyz
-!===============================================================
-!****************************************************************
-! SEE /include/microhucm.incl for setting of krdrop and krbreak
-!****************************************************************
-      SUBROUTINE BREAKUP(GT_MG,XT_MG,DT,BRKWEIGHT, &
-     &           PKIJ,QKJ,JMAX,JBREAK)
-!     SUBROUTINE BREAKUP(GT_MG,DT,JMAX,JBREAK)
-!     implicit double precision (a-h,o-z)
-
-!.....INPUT VARIABLES
-!
-!     GT    : MASS DISTRIBUTION FUNCTION
-!     XT_MG : MASS OF BIN IN MG
-!     JMAX  : NUMBER OF BINS
-!     DT    : TIMESTEP IN S
+         x=(q-qmin)/(qmax-qmin)
 
-      INTEGER JMAX
+         sin1=dsin(PI/2.0d0*x)
+         cos1=dcos(PI/2.0d0*x)
 
-!.....LOCAL VARIABLES
+         e1=ecoalOchs(Dgr, Dkl, DROPRADII, VR1_BREAKUP, NKR)
+         e2=ecoalLowList(Dgr, Dkl, DROPRADII, VR1_BREAKUP, NKR)
 
-      LOGICAL LTHAN
-      INTEGER JBREAK,AP,IA,JA,KA,IE,JE,KE
-      DOUBLE PRECISION EPS,NEGSUM
+         e=cos1**2*e1+sin1**2*e2
 
-      PARAMETER (AP = 1)
-      PARAMETER (IA = 1)
-      PARAMETER (JA = 1)
-      PARAMETER (KA = 1)
-      PARAMETER (EPS = 1.D-20)
+     elseif(q>=qmax) then
 
-      INTEGER I,J,K,JJ,JDIFF
-      DOUBLE PRECISION GT_MG(JMAX),XT_MG(0:JMAX),DT
-!     xl_mg(0:nkr)
-      DOUBLE PRECISION BRKWEIGHT(JBREAK),PKIJ(JBREAK,JBREAK,JBREAK), &
-     &    QKJ(JBREAK,JBREAK)
-      DOUBLE PRECISION D0,ALM,HLP(JMAX)
-      DOUBLE PRECISION FT(JMAX),FA(JMAX)
-      DOUBLE PRECISION DG(JMAX),DF(JMAX),DBREAK(JBREAK),GAIN,LOSS
-      REAL PI
-      PARAMETER (PI = 3.1415927)
-      INTEGER IP,KP,JP,KQ,JQ
-      IE = JBREAK
-      JE = JBREAK
-      KE = JBREAK
+         e=ecoalLowList(Dgr, Dkl, DROPRADII, VR1_BREAKUP, NKR)
 
+     else
 
+         e=0.999d0
 
+     endif
 
+     ecoaldiam=dmax1(dmin1(one,e),eps)
 
+ RETURN
+ END FUNCTION ecoaldiam
+ !coalescence efficiency (Low & List)
+ !----------------------------------------------------------------------------+
+     double precision FUNCTION ecoalLowList(Dgr,Dkl,DROPRADII,VR1_BREAKUP,NKR)
 
+     implicit none
 
-!.....IN CGS
+     integer,intent(in) :: NKR
+     real(kind=r8size),intent(in) :: DROPRADII(NKR), VR1_BREAKUP(NKR)
+     real(kind=r8size),intent(inout) :: Dgr, Dkl
 
-!     DO J=1,JMAX
-!        XT(J) = XT_MG(J) * 1E-3
-!        GT_MG(J) = GT_MG(J)* 1E-3
-!     ENDDO
+     real(kind=r8size) :: sigma, aka, akb, dSTSc, ST, Sc, ET, CKE, qq0, qq1, qq2, Ecl, W1, W2, DC
+     real(kind=r8size),PARAMETER :: epsi=1.d-20
 
-!.....SHIFT BETWEEN COAGULATION AND BREAKUP GRID
+ ! 1 J = 10^7 g cm^2/s^2
 
-      JDIFF = JMAX - JBREAK
-!       14  =  33  - 19
+     sigma=72.8d0    ! Surface Tension,[sigma]=g/s^2 (7.28E-2 N/m)
+     aka=0.778d0      ! Empirical Constant
+     akb=2.61d-4      ! Empirical Constant,[b]=2.61E6 m^2/J^2
 
-!.....INITIALIZATION
+     CALL collenergy(Dgr,Dkl,CKE,ST,Sc,W1,W2,Dc,DROPRADII,VR1_BREAKUP,NKR)
 
-!.....TRANSFORMATION FROM G(LN X) = X**2 F(X) TO F(X)
-      DO J=1,JMAX
-         FT(J) = GT_MG(J) / XT_MG(J)**2
-      ENDDO
+     dSTSc=ST-Sc         ! Diff. of Surf. Energies   [dSTSc] = g*cm^2/s^2
+     ET=CKE+dSTSc        ! Coal. Energy,             [ET]    =     "
 
-!.....SHIFT TO BREAKUP GRID
+     IF(ET<50.0d0) THEN    ! ET < 5 uJ (= 50 g*cm^2/s^2)
 
-      DO K=1,KE
-         FA(K) = FT(K+JDIFF)
-      ENDDO
+         qq0=1.0d0+(Dkl/Dgr)
+         qq1=aka/qq0**2
+         qq2=akb*sigma*(ET**2)/(Sc+epsi)
+         Ecl=qq1*dexp(-qq2)
 
-!.....BREAKUP: BLECK'S FIRST ORDER METHOD
-!
-!     PKIJ: GAIN COEFFICIENTS
-!     QKJ : LOSS COEFFICIENTS
-!
+     !if(i_breakup==24.and.j_breakup==25) then
+     !print*, 'IF(ET<50.0d0) THEN'
+     !print*, 'Ecl=qq1*dexp(-qq2)'
+     !print*, 'qq1,qq2,Ecl'
+     !print*,  qq1,qq2,Ecl
+     !endif
 
-      DO K=1,KE
-         GAIN = 0.0
-         DO I=1,IE
-            DO J=1,I
-               GAIN = GAIN + FA(I)*FA(J)*PKIJ(K,I,J)
-            ENDDO
-         ENDDO
-         LOSS = 0.0
-         DO J=1,JE
-            LOSS = LOSS + FA(J)*QKJ(K,J)
-         ENDDO
-         DBREAK(K) = BRKWEIGHT(K) * (GAIN - FA(K)*LOSS)
-      ENDDO
+     ELSE
 
-!.....SHIFT RATE TO COAGULATION GRID
+         Ecl=0.0d0
 
-      DO J=1,JDIFF
-         DF(J) = 0.0
-      ENDDO
-      DO J=1,KE
-         DF(J+JDIFF) = DBREAK(J)
-      ENDDO
-!.....TRANSFORMATION TO MASS DISTRIBUTION FUNCTION G(LN X)
+     ENDIF
 
-      DO J=1,JMAX
-         DG(J) = DF(J) * XT_MG(J)**2
-      ENDDO
+     ecoalLowList=Ecl
 
-!.....TIME INTEGRATION
-
-      DO J=1,JMAX
-      HLP(J) = 0.0
-      NEGSUM = 0.0
-         GT_MG(J) = GT_MG(J) + DG(J) * DT
-         IF (GT_MG(J).LT.0) THEN
-            HLP(J) = MIN(GT_MG(J),HLP(J))
-            GT_MG(J) = EPS
-!           NEGSUM = NEGSUM+GT_MG(J)
-!           GT_MG(J) = 0.D0
-         ENDIF
-      ENDDO
-!     DO J=1,JMAX
-!      IF (HLP(J).LT.0.) THEN
-!        GT_MG(J-1)=GT_MG(J-1)-NEGSUM -EPS
-!      END IF
-!      GO TO 10
-!     END DO
-!10    CONTINUE
-!     IF (HLP.LT.-1E-7) THEN
-! BARRY
-!     LTHAN=.FALSE.
-!     DO J=1,JMAX
-!      IF (HLP(J).LT.0.OR.LTHAN) THEN
-!        WRITE (*,'(1X,A,E10.4)')
-!    F        'COLL_BREAKUP: WARNING! G(J) < 0, MIN = ' 
-!        IF(HLP(J).LT.0.OR.LTHAN)WRITE(6,*)
-!    F      'J,G(J)  = ',J,HLP(J),GT_MG(J)
-!        LTHAN=.TRUE.  C     ENDIF
-!     END DO
-
-!     DO J=1,JMAX
-!        GT_MG(J) = GT_MG(J) * 1E3
-!     ENDDO
-
-!.....THAT'S IT
-      RETURN
+     RETURN
+     END FUNCTION ecoalLowList
 
-      END SUBROUTINE BREAKUP
+ !coalescence efficiency (Beard and Ochs)
+ !---------------------------------------------------------------------------+
+     double precision FUNCTION ecoalOchs(D_l,D_s,DROPRADII, VR1_BREAKUP,NKR)
 
-      SUBROUTINE BOUNDNUM(MASSMM5,FCONC,RHOX,COL,NZERO, &
-     &       RADXX,MASSXX,HYDROSUM, &
-     &       NKR)
-      IMPLICIT NONE
-     
-      INTEGER NKR,NKRI,KRBEG,KREND,IP,IPCNT
-      REAL NZERO,LAMBDAHYD,MASSMM5,RHOX,HYDROMASS,COL
-      REAL RADXX(NKR),MASSXX(NKR)
-      REAL TERM1,TERM2A,TERM2B,TERM2C
-      REAL FCONC(NKR),HYDROSUM 
-      DOUBLE PRECISION D1,D2,D3,D4,D5,D6,D7A,D7B 
-      DOUBLE PRECISION VAR1,VAR2,VAR3,VAR4,VAR5,VAR6
-!     HYDROMASS IN kg/kg
-!     VAR1=NZERO           
-!     VAR2=RHOX            
-!     VAR3=MASSXX(1,IHYDR)
-!     VAR4=RADXX(1,IHYDR)
-!     VAR5=MASSMM5       
-!     VAR6=(6.*VAR1/VAR2)*VAR3/(8.*VAR4**3)*(1./VAR5)
-!     var6 =sqrt(sqrt(var6))
-!     print*,'radxx(1) = ',RADXX(1)
-!     print*,'rhox = ',rhox
-!     print*,'massmm5 = ',massmm5
-!     print*,'nzero = ',nzerO
-!     print*,'massxx = ',MASSXX(1)
-      LAMBDAHYD=(6.*NZERO/RHOX)*MASSXX(1)/(8.*RADXX(1)**3) &
-     &     *(1./MASSMM5)
-      LAMBDAHYD=SQRT(SQRT(LAMBDAHYD))
-      HYDROSUM  =0
-      TERM1=(NZERO/RHOX)*(MASSXX(1)/(8.*RADXX(1)**3))
-      DO NKRI=1,NKR
-       IF(NKRI.EQ.1)THEN
-        D1=LAMBDAHYD*2.*RADXX(NKRI)
-        D2=0
-       ELSE
-        D1=LAMBDAHYD*2.*RADXX(NKRI)
-        D2=LAMBDAHYD*2.*RADXX(NKRI-1)
-       END IF
-       D3=DEXP(-D1)
-       D4=DEXP(-D2)
-       D5 = (1./LAMBDAHYD**4)
-       D6=TERM1
-       IF (NKRI.EQ.1)THEN
-        D7A= -D5*D3*(D1**3+3.*D1**2+6.*D1+6)
-        D7B=-6.*D5
-       ELSE
-        D7A= -D5*D3*(D1**3+3.*D1**2+6.*D1+6)
-        D7B= -D5*D4*(D2**3+3.*D2**2+6.*D2+6)
-       END IF
-       HYDROMASS= D6*(D7A-D7B)
-       HYDROSUM=HYDROSUM+HYDROMASS   
-       FCONC(NKRI)=HYDROMASS*RHOX/(COL  &
-     &          *MASSXX(NKRI)*MASSXX(NKRI)*3)
-        IF (HYDROMASS .LT.0)THEN
-        call wrf_error_fatal("fatal error in module_mp_fast_sbm,(HYDROMASS.LT.0) , model stop")
-        END IF
-      END DO
-!     print*, 'massmm5,hydrosum  =',massmm5,hydrosum  
-      IF (HYDROSUM.LT.MASSMM5)THEN
-       D1=LAMBDAHYD*2.*RADXX(NKR)
-       D2=LAMBDAHYD*2.*RADXX(NKR-1)
-       D3=DEXP(-D1)
-       D4=DEXP(-D2)
-       D5 = (1./LAMBDAHYD**4)
-       D6=TERM1
-       D7A= -D5*D3*(D1**3+3.*D1**2+6.*D1+6)
-       D7B= -D5*D4*(D2**3+3.*D2**2+6.*D2+6)
-       HYDROMASS= D6*(D7A-D7B)+(MASSMM5-HYDROSUM)
-       FCONC(NKR)=HYDROMASS*RHOX/(COL &
-     &          *MASSXX(NKR)*MASSXX(NKR)*3)
-       HYDROSUM=HYDROSUM+(MASSMM5-HYDROSUM)
-      END IF
-!     print*, 'massmm5,hydrosum adj  =',massmm5,hydrosum  
-      RETURN
-      END SUBROUTINE BOUNDNUM
+     implicit none
 
-! from module_mp_morr_two_moment.F
-      subroutine refl10cm_hm (qv1d, qr1d, nr1d, qs1d, ns1d, qg1d, ng1d, &
-                      t1d, p1d, dBZ, kts, kte, ii, jj)
+     integer,intent(in) :: NKR
+     real(kind=r8size),intent(in) :: DROPRADII(NKR), VR1_BREAKUP(NKR), D_l, D_s
 
-      IMPLICIT NONE
+     real(kind=r8size) :: PI, sigma, R_s, R_l, p, vTl, vTs, dv, Weber_number, pa1, pa2, pa3, g, x, e
+     real(kind=r8size),PARAMETER :: epsf=1.d-30 , FPMIN=1.d-30
 
-!..Sub arguments
-      INTEGER, INTENT(IN):: kts, kte, ii, jj
-      REAL, DIMENSION(kts:kte), INTENT(IN)::                            &
-                      qv1d, qr1d, nr1d, qs1d, ns1d, qg1d, ng1d, t1d, p1d
-      REAL, DIMENSION(kts:kte), INTENT(INOUT):: dBZ
+     PI=3.1415927d0
+     sigma=72.8d0       ! Surface Tension [sigma] = g/s^2 (7.28E-2 N/m)
+                    ! Alles in CGS (1 J = 10^7 g cm^2/s^2)
+     R_s=0.5d0*D_s
+     R_l=0.5d0*D_l
+     p=R_s/R_l
 
-!..Local variables
-      REAL, DIMENSION(kts:kte):: temp, pres, qv, rho
-      REAL, DIMENSION(kts:kte):: rr, nr, rs, ns, rg, ng
+     vTl=vTBeard(D_l,DROPRADII, VR1_BREAKUP,NKR)
 
-      DOUBLE PRECISION, DIMENSION(kts:kte):: ilamr, ilamg, ilams
-      DOUBLE PRECISION, DIMENSION(kts:kte):: N0_r, N0_g, N0_s
-      DOUBLE PRECISION:: lamr, lamg, lams
-      LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg
+     vTs=vTBeard(D_s,DROPRADII, VR1_BREAKUP,NKR)
 
-      REAL, DIMENSION(kts:kte):: ze_rain, ze_snow, ze_graupel
-      DOUBLE PRECISION:: fmelt_s, fmelt_g
-      DOUBLE PRECISION:: cback, x, eta, f_d
+     dv=dabs(vTl-vTs)
 
-      INTEGER:: i, k, k_0, kbot, n
-      LOGICAL:: melti
+     if(dv DROPRADII(NKR)) vTBeard=VR1_BREAKUP(NKR)
+
+     DO KR=1,NKR-1
+         IF(aa>DROPRADII(KR).and.aa<=DROPRADII(KR+1)) then
+             vTBeard=VR1_BREAKUP(KR+1)
+         ENDIF
+     ENDDO
+
+     RETURN
+     END FUNCTION vTBeard
+     !vTBeard
+ ! new change 23.07.07                                           (end)
+ !........................................................................
+       END MODULE module_mp_fast_sbm
diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F
index 0c4d355b12..4c5b0a0873 100644
--- a/phys/module_physics_init.F
+++ b/phys/module_physics_init.F
@@ -49,7 +49,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          re_cloud, re_ice, re_snow,              & ! G. Thompson
                          has_reqc, has_reqi, has_reqs,           & ! G. Thompson
 #if ( EM_CORE == 1 )
-                         re_cloud_gsfc, re_ice_gsfc,             & 
+                         re_cloud_gsfc, re_ice_gsfc,             &
                          re_snow_gsfc,                           & ! Goddard
                          re_graupel_gsfc, re_hail_gsfc,          &
                          re_rain_gsfc,                           & ! Goddard
@@ -96,7 +96,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          urban_map_fbd,                          &
                          NUM_URBAN_HI,                           &
                          raincv_a,raincv_b,                      &
-                         gd_cloud,gd_cloud2,                     & 
+                         gd_cloud,gd_cloud2,                     &
                          gd_cloud_a,gd_cloud2_a,                 &
                          QC_CU,QI_CU,                            &
                          ozmixm,pin,                             &    ! Optional
@@ -117,11 +117,11 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          STMASSXY, WOODXY, STBLCPXY, FASTCPXY,            & ! Optional Noah-MP
                          GRAINXY, GDDXY,                                  & ! Optional Noah-MP
                          croptype, cropcat,                      &           ! Noah-MP Crop model
-                         iopt_crop,                                       &  
+                         iopt_crop,                                       &
                          gecros_state,                                    & ! Optional gecros crop
                          XSAIXY, LAI,                                     & ! Optional Noah-MP
                          T2MVXY, T2MBXY, CHSTARXY ,                       & ! Optional Noah-MP
-                         SMOISEQ  ,SMCWTDXY ,RECHXY, DEEPRECHXY, AREAXY,  & ! Optional Noah-MP 
+                         SMOISEQ  ,SMCWTDXY ,RECHXY, DEEPRECHXY, AREAXY,  & ! Optional Noah-MP
                          WTDDT , STEPWTD ,QRFSXY ,QSPRINGSXY ,QSLATXY,    & ! Optional Noah-MP
                          FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, & ! Optional Noah-MP
                          rechclim  ,                                       & ! Optional Noah-MP
@@ -217,7 +217,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 ! next 2 flags for Explicit lightning:
                          nssl_ipelec,                             &
                          nssl_isaund,                             &
-   ! OPTIONAL 
+   ! OPTIONAL
                          RQCNCUTEN, RQINCUTEN,                   &
                          rliq,                                   &  !BSINGH:01/31/2013 - Added rliq and is_CAMMGMP_used for CAM5 physics
                          cldfra_dp,cldfra_sh                     & !ckay for subgrid cloud
@@ -232,7 +232,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          ,ca_rad, cw_rad                        &
                          ,pblmax, wub, ltopb, clddpthb, cldtopb &
                          ,capesave, ainckfsa, radsave           &
-                         ,rainsh, rainshvb, kdcldtop, kdcldbas  & 
+                         ,rainsh, rainshvb, kdcldtop, kdcldbas  &
                          ,xtime1, PBLHAVG, TKEAVG               &
                          ,ccn_conc                             & ! RAS
                          ,QKE                                  & !for MYNN
@@ -240,18 +240,18 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          ,TSK_mosaic,TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic                                     & ! danli mosaic
                          ,CANWAT_mosaic,SNOW_mosaic,SNOWH_mosaic,SNOWC_mosaic                                 & ! danli mosaic
                          ,ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic      & ! danli mosaic
-                         ,TR_URB2D_mosaic,TB_URB2D_mosaic                                                     & ! danli mosaic 
-                         ,TG_URB2D_mosaic,TC_URB2D_mosaic                                                     & ! danli mosaic 
+                         ,TR_URB2D_mosaic,TB_URB2D_mosaic                                                     & ! danli mosaic
+                         ,TG_URB2D_mosaic,TC_URB2D_mosaic                                                     & ! danli mosaic
                          ,QC_URB2D_mosaic                                                                     & ! danli mosaic
-                         ,TRL_URB3D_mosaic,TBL_URB3D_mosaic                                                   & ! danli mosaic 
-                         ,TGL_URB3D_mosaic                                                                    & ! danli mosaic 
-                         ,SH_URB2D_mosaic,LH_URB2D_mosaic                                                     & ! danli mosaic 
-                         ,G_URB2D_mosaic,RN_URB2D_mosaic                                                      & ! danli mosaic 
-                         ,TS_URB2D_mosaic                                                                     & ! danli mosaic 
+                         ,TRL_URB3D_mosaic,TBL_URB3D_mosaic                                                   & ! danli mosaic
+                         ,TGL_URB3D_mosaic                                                                    & ! danli mosaic
+                         ,SH_URB2D_mosaic,LH_URB2D_mosaic                                                     & ! danli mosaic
+                         ,G_URB2D_mosaic,RN_URB2D_mosaic                                                      & ! danli mosaic
+                         ,TS_URB2D_mosaic                                                                     & ! danli mosaic
                          ,TS_RUL2D_mosaic                                                                     & ! danli mosaic
 #if ( EM_CORE == 1 )
                          ,QR_CU,QS_CU,NC_CU,NI_CU,NR_CU,NS_CU,CCN_CU              & ! TWG
-                         ,alevsiz_cu,num_months,no_src_types_cu,aeromcu,aeropcu   & ! PSH/TWG 06/10/16                         
+                         ,alevsiz_cu,num_months,no_src_types_cu,aeromcu,aeropcu   & ! PSH/TWG 06/10/16
                          ,EFCG,EFCS,EFIG,EFIS,EFSG,EFSS                           & ! TWG
 #endif
                           )
@@ -307,8 +307,8 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
   !PSH/TWG 06/10/16
    INTEGER,      INTENT(IN   )    ::   alevsiz_cu, num_months, no_src_types_cu !PSH/TWG 06/10/16
    REAL,  DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months, no_src_types_cu), OPTIONAL, &
-          INTENT(INOUT) ::                                  aeromcu 
-   REAL,  DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months), OPTIONAL,INTENT(INOUT)  :: aeropcu 
+          INTENT(INOUT) ::                                  aeromcu
+   REAL,  DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months), OPTIONAL,INTENT(INOUT)  :: aeropcu
 
    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,         &
           OPTIONAL, INTENT(INOUT   ) ::                              &
@@ -347,7 +347,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                                                          XICEM, &
                                                         VEGFRA, &
                                                         ACSNOM
-   REAL,    DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::   rliq    
+   REAL,    DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::   rliq
 
    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
             OPTIONAL, INTENT(INOUT)    ::                ACHFX, &
@@ -411,7 +411,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    !BSINGH -ENDS
 #endif
 
-   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT), OPTIONAL :: RQCNCUTEN, RQINCUTEN 
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT), OPTIONAL :: RQCNCUTEN, RQINCUTEN
 
    REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
 
@@ -447,7 +447,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT), OPTIONAL :: QKE
 
   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT), OPTIONAL :: &
-                                            massflux_EDKF, entr_EDKF, detr_EDKF & 
+                                            massflux_EDKF, entr_EDKF, detr_EDKF &
                                                    ,thl_up, thv_up, rt_up       &
                                                    ,rv_up, rc_up, u_up, v_up    &
                                                    ,frac_up
@@ -515,13 +515,13 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: T2MVXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: T2MBXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: CHSTARXY
-   REAL,    OPTIONAL, DIMENSION(ims:ime,1:num_soil_layers,jms:jme) :: SMOISEQ 
-   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: SMCWTDXY   
+   REAL,    OPTIONAL, DIMENSION(ims:ime,1:num_soil_layers,jms:jme) :: SMOISEQ
+   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: SMCWTDXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: DEEPRECHXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: RECHXY
-   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QRFSXY       
+   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QRFSXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSPRINGSXY
-   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSLATXY 
+   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSLATXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: AREAXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: FDEPTHXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: RIVERBEDXY
@@ -652,7 +652,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: HGT_URB2D !multi-layer UCM
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: MH_URB2D  !SLUCM
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: STDH_URB2D !SLUCM
-   REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(INOUT) :: LF_URB2D  !SLUCM 
+   REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(INOUT) :: LF_URB2D  !SLUCM
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP
@@ -674,7 +674,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                                                                              h2osno2d,       &
                                                                              snl2d,          &
                                                                              t_grnd2d
- 
+
   real,    dimension( ims:ime,1:nlevlake, jms:jme ),INTENT(out)            :: t_lake3d,       &
                                                                              lake_icefrac3d, &
                                                                              z_lake3d,       &
@@ -701,7 +701,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 #endif
   INTEGER, INTENT(INOUT)      ::   lake_depth_flag
   INTEGER, INTENT(IN)      ::   use_lakedepth
- 
+
 
 !CLM
    INTEGER, INTENT(IN) ::       maxpatch
@@ -753,7 +753,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 
 ! WA 12/21/09
    REAL,OPTIONAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
-          INTENT(OUT) ::    te_temf, cf3d_temf    
+          INTENT(OUT) ::    te_temf, cf3d_temf
 ! WA 2/22/11
    REAL,OPTIONAL, DIMENSION( ims:ime , jms:jme ) , &
           INTENT(OUT) ::    wm_temf
@@ -796,8 +796,8 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    INTEGER :: mfshconv
    INTEGER :: icloud_cu
    INTEGER :: iopt_run
-   INTEGER :: aercu_opt !PSH/TWG 
-   REAL    :: aercu_fct !PSH/TWG 
+   INTEGER :: aercu_opt !PSH/TWG
+   REAL    :: aercu_fct !PSH/TWG
 
 
    INTEGER :: i, j, k, itf, jtf, ktf, n
@@ -806,12 +806,12 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 !-------------------------------------------------
 ! Noah-mosaic related variables are added to declaration  (danli)
 !-------------------------------------------------
-  
-  INTEGER, INTENT(IN) :: sf_surface_mosaic, NLCAT   
+
+  INTEGER, INTENT(IN) :: sf_surface_mosaic, NLCAT
   INTEGER, INTENT(IN) :: mosaic_cat
   REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(IN) , OPTIONAL::   LANDUSEF
-  REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(INOUT) , OPTIONAL::   LANDUSEF2 
-  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT), OPTIONAL :: mosaic_cat_index 
+  REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(INOUT) , OPTIONAL::   LANDUSEF2
+  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT), OPTIONAL :: mosaic_cat_index
 
   REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT):: &
         TSK_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic
@@ -821,17 +821,17 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
         TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic
   REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::                &
         TR_URB2D_mosaic, TB_URB2D_mosaic, TG_URB2D_mosaic, TC_URB2D_mosaic,QC_URB2D_mosaic,    &
-        SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic  
-                  
+        SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic
+
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TRL_URB3D_mosaic
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TBL_URB3D_mosaic
-   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic  
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic
    LOGICAL :: IPRINT
- 
+
 !-------------------------------------------------
-! End of Noah-mosaic 
-!-------------------------------------------------  
-   
+! End of Noah-mosaic
+!-------------------------------------------------
+
 !-----------------------------------------------------------------
 
    aercu_opt=config_flags%aercu_opt !PSH/TWG 06/10/16
@@ -1008,7 +1008,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
      !rliq can have undefined behaviour
  IF (config_flags%cu_physics == CAMZMSCHEME .or. config_flags%shcu_physics == CAMUWSHCUSCHEME ) THEN
      IF(PRESENT(rliq)) THEN
-        rliq(:,:) = 0.0 
+        rliq(:,:) = 0.0
      ENDIF
  ENDIF
    IF ( .NOT. moved ) THEN
@@ -1183,12 +1183,12 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    cam_mam_aerosols = .FALSE.
    if(config_flags%chem_opt == CBMZ_CAM_MAM3_NOAQ .OR. config_flags%chem_opt == CBMZ_CAM_MAM3_AQ &
         .OR. config_flags%chem_opt == CBMZ_CAM_MAM7_NOAQ .OR. config_flags%chem_opt == CBMZ_CAM_MAM7_AQ) cam_mam_aerosols = .TRUE.
-      
+
 #endif
 
 
    if(       config_flags%bl_pbl_physics == CAMUWPBLSCHEME     .OR. config_flags%cu_physics == CAMZMSCHEME      &
-        .OR. config_flags%shcu_physics   == CAMUWSHCUSCHEME                                                     & 
+        .OR. config_flags%shcu_physics   == CAMUWSHCUSCHEME                                                     &
 # if (EM_CORE == 1)
         .OR. config_flags%mp_physics == CAMMGMPSCHEME                                                           &
 # endif
@@ -1238,7 +1238,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
                 config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
                 num_soil_layers,TKE_PBL,mfshconv,               &
-                massflux_EDKF, entr_EDKF, detr_EDKF, & 
+                massflux_EDKF, entr_EDKF, detr_EDKF, &
                 thl_up, thv_up, rt_up,       &
                 rv_up, rc_up, u_up, v_up,    &
                 frac_up, &
@@ -1266,12 +1266,12 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 STMASSXY, WOODXY, STBLCPXY, FASTCPXY,           &
                 GRAINXY, GDDXY,                                 & ! Noah-MP Crop model
                 croptype, cropcat,                              & ! Noah-MP Crop model
-                iopt_crop,                                      & 
+                iopt_crop,                                      &
                 gecros_state,                                   & ! Optional gecros crop
                 XSAIXY, LAI,                                    &
                 SMOISEQ, SMCWTDXY, RECHXY, DEEPRECHXY, AREAXY,  &
                 WTDDT, STEPWTD, QRFSXY ,QSPRINGSXY ,QSLATXY,   &
-                FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, & 
+                FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, &
                 rechclim  ,                                     &
                 ISICE,                                 &
                 T2MVXY,T2MBXY,CHSTARXY ,                        &
@@ -1294,7 +1294,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,    & !Optional urban
                 TRL_URB3D, TBL_URB3D, TGL_URB3D,                & !Optional urban
                 SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D,          & !Optional urban
-                TS_URB2D, FRC_URB2D, UTYPE_URB2D,               & 
+                TS_URB2D, FRC_URB2D, UTYPE_URB2D,               &
                 SF_URBAN_PHYSICS,                               & !Optional urban
                 CMCR_URB2D,TGR_URB2D,TGRL_URB3D,SMR_URB3D,      & !Optional urban
                 DRELR_URB2D,DRELB_URB2D,DRELG_URB2D,            & !Optional urban
@@ -1334,7 +1334,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 TML,T0ML,HML,H0ML,HUML,HVML,TMOML,              & !Optional oml
                 is_CAMMGMP_used                                 &
                ,TSK_SAVE                                        & !Optional fractional seaice
-! CLM vraiables 
+! CLM vraiables
                ,numc,nump,snl,                                      &
                 snowdp,wtc,wtp,h2osno,t_grnd,t_veg,         &
                 h2ocan,h2ocan_col,t2m_max,t2m_min,t_ref2m,          &
@@ -1364,26 +1364,26 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid,     &
                 Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,       &
                 SWUPsubgrid,lhsoi,lhveg,lhtran                      &
-! end of CLM vraiables 
+! end of CLM vraiables
                 ,landusef,landusef2,NLCAT                       & ! danli mosaic
                 ,sf_surface_mosaic, mosaic_cat                  & ! danli mosaic
-                ,mosaic_cat_index                               & ! danli mosaic  
+                ,mosaic_cat_index                               & ! danli mosaic
                 ,TSK_mosaic,TSLB_mosaic                         & ! danli mosaic
-                ,SMOIS_mosaic,SH2O_mosaic                       & ! danli mosaic 
+                ,SMOIS_mosaic,SH2O_mosaic                       & ! danli mosaic
                 ,CANWAT_mosaic,SNOW_mosaic                      & ! danli mosaic
                 ,SNOWH_mosaic,SNOWC_mosaic                      & ! danli mosaic
-                ,ALBEDO,ALBBCK, EMISS, EMBCK                    & ! danli mosaic          
+                ,ALBEDO,ALBBCK, EMISS, EMBCK                    & ! danli mosaic
                 ,ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic   &         ! danli mosaic
-                ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic 
-                ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic 
-                ,QC_URB2D_mosaic                                &  !danli mosaic                  
-                ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic 
-                ,TGL_URB3D_mosaic                               &  !danli mosaic 
-                ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic 
-                ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic 
-                ,TS_URB2D_mosaic                                &  !danli mosaic 
-                ,TS_RUL2D_mosaic                                &  !danli mosaic 
-               ) 
+                ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic
+                ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic
+                ,QC_URB2D_mosaic                                &  !danli mosaic
+                ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic
+                ,TGL_URB3D_mosaic                               &  !danli mosaic
+                ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic
+                ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic
+                ,TS_URB2D_mosaic                                &  !danli mosaic
+                ,TS_RUL2D_mosaic                                &  !danli mosaic
+               )
 
    CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to cu_init' )
 
@@ -1538,7 +1538,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 !  Initialize cloud droplet effective radius for Goddard MP and Radiation
 !  Must be (Goddard LW and SW) AND must be (Goddard 3ice OR 4ice)
 #if ( EM_CORE == 1 )
-    
+
    if ( ( ( config_flags%ra_lw_physics .EQ. GODDARDLWSCHEME )   .AND. &
           ( config_flags%ra_sw_physics .EQ. GODDARDSWSCHEME ) ) .AND. &
         ( ( config_flags%mp_physics    .EQ. NUWRF3ICESCHEME )   .OR.  &
@@ -1583,7 +1583,7 @@ SUBROUTINE landuse_init(lu_index, snowc, albedo, albbck, snoalb, mavail, emiss,
    REAL    , INTENT(IN)           :: cen_lat
    CHARACTER(LEN=*), INTENT(IN)        :: mminlu
    LOGICAL,  INTENT(IN)           :: allowed_to_read , usemonalb
-   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: lu_index, snowc, xice, snoalb 
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: lu_index, snowc, xice, snoalb
    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT  ) :: albedo, albbck, mavail, emiss, &
                                                                embck,                         &
                                                                znt, Z0, thc, xland, xicem
@@ -1766,7 +1766,7 @@ SUBROUTINE landuse_init(lu_index, snowc, albedo, albbck, snoalb, mavail, emiss,
           ENDIF
           IF(.NOT.usemonalb)ALBBCK(I,J)=ALBD(IS,ISN)/100.
           ALBEDO(I,J)=ALBBCK(I,J)
-          IF(SNOWC(I,J) .GT. 0.5) THEN 
+          IF(SNOWC(I,J) .GT. 0.5) THEN
              IF (usemonalb) THEN
                  ALBEDO(I,J)=SNOALB(I,J)
              ELSE
@@ -1991,12 +1991,12 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
    ENDIF
 
 !-- ww: attempt to use CAM ozone and some aerosol profiles in all rad schemes
-!   note that CAM option will still do the same. 
+!   note that CAM option will still do the same.
 !   n_ozmixm: no of months; levsiz: = 59, vertical dim
 !   Read in CAM ozone data, and interpolate data to model grid
 !   Interpolation is done on domain 1 only
 
-#if (EM_CORE==1) 
+#if (EM_CORE==1)
    IF ( config_flags%o3input .EQ. 2 .AND. id .EQ. 1 ) THEN
 #else
    IF ( config_flags%o3input .EQ. 2 ) THEN
@@ -2034,7 +2034,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
                            ims, ime, jms, jme, kms, kme,    &
                            its, ite, jts, jte, kts, kte     )
 
-              
+
         CASE (RRTMSCHEME)
              CALL rrtminit(                                 &
                            p_top, allowed_to_read ,         &
@@ -2074,7 +2074,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
 
             aclwalloc = .true.
 #if ( EM_CORE == 1 )
-        CASE (RRTMK_LWSCHEME)  
+        CASE (RRTMK_LWSCHEME)
 
              CALL rrtmg_lwinit_k(                           &
                            allowed_to_read ,                &
@@ -2238,7 +2238,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
 
    END SELECT swrad_select
 
-#if ( EM_CORE == 1 ) 
+#if ( EM_CORE == 1 )
    ! test for conditionally allocated arrays when using bucket_J
 
    IF(config_flags%bucket_J .gt. 0.0)THEN
@@ -2254,7 +2254,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
                 config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
                 num_soil_layers,TKE_PBL,mfshconv,               &
-                massflux_EDKF, entr_EDKF, detr_EDKF, & 
+                massflux_EDKF, entr_EDKF, detr_EDKF, &
                 thl_up, thv_up, rt_up,       &
                 rv_up, rc_up, u_up, v_up,    &
                 frac_up, &
@@ -2284,7 +2284,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 XSAIXY, LAI,                                    &
                 SMOISEQ, SMCWTDXY, RECHXY, DEEPRECHXY, AREAXY,  &
                 WTDDT, STEPWTD,QRFSXY ,QSPRINGSXY ,QSLATXY,     &
-                FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, & 
+                FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, &
                 rechclim  ,                                     &
                 ISICE,                                 &
                 T2MVXY, T2MBXY ,CHSTARXY,                       &
@@ -2348,7 +2348,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 TML,T0ML,HML,H0ML,HUML,HVML,TMOML,              &
                 is_CAMMGMP_used                                 &
                ,TSK_SAVE                                        & !Optional fractional seaice
-! CLM vraiables 
+! CLM vraiables
                ,numc,nump,snl,                                      &
                 snowdp,wtc,wtp,h2osno,t_grnd,t_veg,         &
                 h2ocan,h2ocan_col,t2m_max,t2m_min,t_ref2m,          &
@@ -2378,25 +2378,25 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid,     &
                 Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,       &
                 SWUPsubgrid,lhsoi,lhveg,lhtran                      &
-! end of CLM vraiables 
+! end of CLM vraiables
                 ,landusef,landusef2,NLCAT                       & ! danli mosaic
                 ,sf_surface_mosaic, mosaic_cat                  & ! danli mosaic
-                ,mosaic_cat_index                               & ! danli mosaic  
+                ,mosaic_cat_index                               & ! danli mosaic
                 ,TSK_mosaic,TSLB_mosaic                         & ! danli mosaic
                 ,SMOIS_mosaic,SH2O_mosaic                       & ! danli mosaic
                 ,CANWAT_mosaic,SNOW_mosaic                      & ! danli mosaic
                 ,SNOWH_mosaic,SNOWC_mosaic                      & ! danli mosaic
-                ,ALBEDO,ALBBCK, EMISS, EMBCK                    & ! danli mosaic 
+                ,ALBEDO,ALBBCK, EMISS, EMBCK                    & ! danli mosaic
                 ,ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic   &         ! danli mosaic
-                ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic 
-                ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic 
-                ,QC_URB2D_mosaic                                &  !danli mosaic                  
-                ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic 
-                ,TGL_URB3D_mosaic                               &  !danli mosaic 
-                ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic 
-                ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic 
-                ,TS_URB2D_mosaic                                &  !danli mosaic 
-                ,TS_RUL2D_mosaic                                &  !danli mosaic  
+                ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic
+                ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic
+                ,QC_URB2D_mosaic                                &  !danli mosaic
+                ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic
+                ,TGL_URB3D_mosaic                               &  !danli mosaic
+                ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic
+                ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic
+                ,TS_URB2D_mosaic                                &  !danli mosaic
+                ,TS_RUL2D_mosaic                                &  !danli mosaic
                                                                 ) !Optional oml
 !--------------------------------------------------------------------
    USE module_sf_sfclay
@@ -2460,7 +2460,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                                       ims, ime, jms, jme, kms, kme, &
                                       its, ite, jts, jte, kts, kte
    INTEGER , INTENT(IN)        ::     num_soil_layers
-   INTEGER , INTENT(IN)        ::     SF_URBAN_PHYSICS 
+   INTEGER , INTENT(IN)        ::     SF_URBAN_PHYSICS
    INTEGER , INTENT(IN)        ::     IOPT_RUN
 
 !   INTEGER , INTENT(IN)        ::     LakeModel
@@ -2524,7 +2524,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
    REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT), OPTIONAL :: QKE
 
    REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT), OPTIONAL :: &
-                              massflux_EDKF, entr_EDKF, detr_EDKF & 
+                              massflux_EDKF, entr_EDKF, detr_EDKF &
                                      ,thl_up, thv_up, rt_up       &
                                      ,rv_up, rc_up, u_up, v_up    &
                                      ,frac_up
@@ -2540,7 +2540,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
    INTEGER :: k
 
    REAL, OPTIONAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
-            INTENT(OUT) :: te_temf, cf3d_temf !WA 
+            INTENT(OUT) :: te_temf, cf3d_temf !WA
    REAL, OPTIONAL, DIMENSION( ims:ime , jms:jme ) , &
             INTENT(OUT) :: wm_temf
 
@@ -2585,7 +2585,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: SMCWTDXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: DEEPRECHXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: RECHXY
-   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QRFSXY  
+   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QRFSXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSPRINGSXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSLATXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: AREAXY
@@ -2682,18 +2682,18 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: MH_URB2D !SLUCM
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: STDH_URB2D !SLUCM
     REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(INOUT) :: LF_URB2D !SLUCM
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_Q_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_E_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_U_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_V_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_T_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_Q_BEP 
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_E_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_Q_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_E_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_U_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_V_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_T_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_Q_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_E_BEP
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: VL_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DLG_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DLG_BEP
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme,jms:jme),INTENT(INOUT) :: SF_BEP
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DL_U_BEP
 ! lake varibles:
@@ -2703,7 +2703,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                                                                              h2osno2d,       &
                                                                              snl2d,          &
                                                                              t_grnd2d
- 
+
   real,    dimension( ims:ime,1:nlevlake, jms:jme ),INTENT(out)            :: t_lake3d,       &
                                                                              lake_icefrac3d, &
                                                                              z_lake3d,       &
@@ -2720,7 +2720,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                                                                              tkdry3d,        &
                                                                              tksatu3d
   real,    dimension( ims:ime,-nlevsnow+0:nlevsoil, jms:jme ),INTENT(inout) :: zi3d
- 
+
   logical,    dimension(ims:ime,jms:jme ),intent(out)                        :: lake2d
   REAL, OPTIONAL,    DIMENSION( ims:ime, jms:jme ), INTENT(IN)    ::  lake_depth
 #if ( EM_CORE == 1 )
@@ -2780,37 +2780,37 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 !-------------------------------------------------
 ! Noah-mosaic related variables are added to declaration  (danli)
 !-------------------------------------------------
-  
-  INTEGER, INTENT(IN) :: sf_surface_mosaic, NLCAT   
+
+  INTEGER, INTENT(IN) :: sf_surface_mosaic, NLCAT
   INTEGER, INTENT(IN) :: mosaic_cat
   REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(IN)::   LANDUSEF
   REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(INOUT)::   LANDUSEF2
-  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT) :: mosaic_cat_index 
+  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT) :: mosaic_cat_index
 
-  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSK_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic 
-  REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ALBEDO,ALBBCK, EMISS, EMBCK 
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSK_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic
+  REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ALBEDO,ALBBCK, EMISS, EMBCK
 
   REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic
-  
+
   REAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), OPTIONAL, INTENT(INOUT)::   TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic
-  
+
   REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TR_URB2D_mosaic, TB_URB2D_mosaic, TG_URB2D_mosaic, TC_URB2D_mosaic,QC_URB2D_mosaic,  &
-                                                                                     SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic  
-                    
+                                                                                     SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic
+
   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TRL_URB3D_mosaic
   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TBL_URB3D_mosaic
-  REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic  
-   
+  REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic
+
   REAL :: xice_threshold   ! lake input
-   
+
   LOGICAL :: IPRINT
-  
+
+!-------------------------------------------------
+! End of Noah-mosaic related variables
 !-------------------------------------------------
-! End of Noah-mosaic related variables 
-!-------------------------------------------------  
 
 #if ( EM_CORE == 1 )
-!local mynn 
+!local mynn
    INTEGER :: mynn_closure_level
 #endif
 
@@ -2819,7 +2819,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
   else if ( config_flags%fractional_seaice == 1 ) then
      xice_threshold = 0.02
   endif
- 
+
 !-- calculate pbl time step
 
    STEPBL = nint(BLDT*60./DT)
@@ -2920,7 +2920,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 #endif
 
 #if ( EM_CORE == 1 )
-!mynn 
+!mynn
 
         CASE (MYNNSFCSCHEME)
 
@@ -2969,7 +2969,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 
 #endif
       CASE (LSMSCHEME)
-          
+
           IF(TRIM(mminlu) .EQ. 'NLCD40')THEN
             CALL wrf_message('Using NLCD40 for Noah, redefine urban categories ')
             DO j=jts,jte
@@ -2979,7 +2979,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
             ENDDO
             ENDDO
           ENDIF
- 
+
           CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,  &
                      SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
                      ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
@@ -2996,12 +2996,12 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
           IF ((SF_URBAN_PHYSICS.eq.1).OR.(SF_URBAN_PHYSICS.EQ.2).OR.(SF_URBAN_PHYSICS.EQ.3)) THEN
 
              IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN
-                
+
                 CALL urban_param_init(DZR,DZB,DZG,num_soil_layers,                   & !urban
                                 sf_urban_physics)
 !                                num_roof_layers,num_wall_layers,road_soil_layers)   !urban
-                               
-                
+
+
                 CALL urban_var_init(ISURBAN,TSK,TSLB,TMN,IVGTYP,                     & !urban
                               ims,ime,jms,jme,kms,kme,num_soil_layers,               & !urban
 !                              num_roof_layers,num_wall_layers,num_road_layers, & !urban
@@ -3047,42 +3047,42 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 CALL wrf_error_fatal ( 'arguments not present for calling urban model' )
              ENDIF
           ENDIF
-          
+
 !danli mosaic
 
           IF (SF_surface_mosaic.eq.1) THEN
 
-CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_flags%ISICE, XLAND, XICE,config_flags%fractional_seaice,TSK,TSLB,SMOIS,SH2O,SNOW,SNOWC,SNOWH,CANWAT,  &                
+CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_flags%ISICE, XLAND, XICE,config_flags%fractional_seaice,TSK,TSLB,SMOIS,SH2O,SNOW,SNOWC,SNOWH,CANWAT,  &
                   ids,ide, jds,jde, kds,kde,  &
                   ims,ime, jms,jme, kms,kme,  &
                   its,ite, jts,jte, kts,kte, restart,             &
-                  landusef,landusef2,NLCAT,num_soil_layers                  & 
-                  ,sf_surface_mosaic, mosaic_cat                    & 
-                  , mosaic_cat_index                              &   
+                  landusef,landusef2,NLCAT,num_soil_layers                  &
+                  ,sf_surface_mosaic, mosaic_cat                    &
+                  , mosaic_cat_index                              &
                   ,TSK_mosaic,TSLB_mosaic                         &
-                  ,SMOIS_mosaic,SH2O_mosaic                       & 
+                  ,SMOIS_mosaic,SH2O_mosaic                       &
                   ,CANWAT_mosaic,SNOW_mosaic                      &
                   ,SNOWH_mosaic,SNOWC_mosaic                      &
-                  ,ALBEDO,ALBBCK, EMISS, EMBCK,                    &         !danli  
+                  ,ALBEDO,ALBBCK, EMISS, EMBCK,                    &         !danli
 #if ( NMM_CORE == 1 )
                                                             Z0, &
 #else
                                                            ZNT, &
-#endif  
+#endif
                   ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic   &         !danli
-                 ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic 
-                 ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic 
-                 ,QC_URB2D_mosaic                                &  !danli mosaic                  
-                 ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic 
-                 ,TGL_URB3D_mosaic                               &  !danli mosaic 
-                 ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic 
-                 ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic 
-                 ,TS_URB2D_mosaic                                &  !danli mosaic 
-                 ,TS_RUL2D_mosaic                                &  !danli mosaic                        
+                 ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic
+                 ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic
+                 ,QC_URB2D_mosaic                                &  !danli mosaic
+                 ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic
+                 ,TGL_URB3D_mosaic                               &  !danli mosaic
+                 ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic
+                 ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic
+                 ,TS_URB2D_mosaic                                &  !danli mosaic
+                 ,TS_RUL2D_mosaic                                &  !danli mosaic
                    )
 
-          ENDIF               
-          
+          ENDIF
+
 !
 
       CASE (NOAHMPSCHEME)
@@ -3215,7 +3215,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 ! CLM Init Coupling
       CASE (CLMSCHEME)
         IF ((SF_URBAN_PHYSICS.eq.1).OR.(SF_URBAN_PHYSICS.EQ.2).OR.(SF_URBAN_PHYSICS.EQ.3)) THEN
-                CALL wrf_error_fatal ( 'CLM DOES NOT WORK WITH URBAN SCHEME' ) 
+                CALL wrf_error_fatal ( 'CLM DOES NOT WORK WITH URBAN SCHEME' )
         ENDIF
         IF ( TRIM(mminlu) .EQ. 'NLCD40' ) THEN
            CALL wrf_error_fatal ( 'CLM does not work with NLCD input. Stop' )
@@ -3296,7 +3296,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 #endif
 
      IF ( LakeModel == 1 ) THEN
- 
+
              call  lakeini(IVGTYP,         ISLTYP,          HT,              SNOW,           & !i
                            lake_min_elev,     restart,         lakedepth_default, lake_depth,     &
                            lakedepth2d,    savedtke12d,     snowdp2d,        h2osno2d,       & !o
@@ -3312,7 +3312,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                            tkdry3d,        tksatu3d,        lake2d,          its, ite, jts, jte, &
                            ims,ime, jms,jme)
      ENDIF
- 
+
 !-- initialize pbl scheme
 
    pbl_select: SELECT CASE(config_flags%bl_pbl_physics)
@@ -3428,17 +3428,17 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                         ids, ide, jds, jde, kds, kde,         &
                         ims, ime, jms, jme, kms, kme,         &
                         its, ite, jts, jte, kts, kte          )
-           
+
 !          IF ( PRESENT (mfshconv) ) THEN
               if (mfshconv.EQ.1) &
-              CALL mfshconvpblinit( massflux_EDKF, entr_EDKF, detr_EDKF & 
+              CALL mfshconvpblinit( massflux_EDKF, entr_EDKF, detr_EDKF &
                                     ,thl_up, thv_up, rt_up              &
                                     ,rv_up, rc_up, u_up, v_up           &
                                     ,frac_up, restart,                  &
                                     allowed_to_read ,                   &
                                     ids, ide, jds, jde, kds, kde,       &
                                     ims, ime, jms, jme, kms, kme,       &
-                                    its, ite, jts, jte, kts, kte   )  
+                                    its, ite, jts, jte, kts, kte   )
 !          ENDIF
 
 #if (NMM_CORE != 1)
@@ -3463,14 +3463,14 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 
 #if ( EM_CORE == 1 )
 
-!mynn 
-           
+!mynn
+
         CASE (MYNNPBLSCHEME2, MYNNPBLSCHEME3)
            IF(isfc .NE. 5 .AND. isfc .NE. 1 .AND. isfc .NE. 2) CALL wrf_error_fatal &
                 ( 'module_physics_init: use mynnsfc or sfclay or myjsfc scheme for this pbl option')
            IF ((SF_URBAN_PHYSICS.eq.2).OR.(SF_URBAN_PHYSICS.EQ.3)) CALL wrf_error_fatal &
             ( 'module_physics_init: use myj (option 2) or boulac (option 8) with BEP/BEM urban scheme' )
-           
+
            SELECT CASE(config_flags%bl_pbl_physics)
 
              CASE(MYNNPBLSCHEME2)
@@ -3515,7 +3515,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 
 #endif
 
-      CASE (GBMPBLSCHEME) 
+      CASE (GBMPBLSCHEME)
            if(isfc .ne. 1)CALL wrf_error_fatal &
             ( 'module_physics_init: Use sf_sfclay_physics= 1 or 91 for this pbl option' )
          CALL gbmpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,   &
@@ -3587,7 +3587,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
    USE module_cu_du, ONLY : ducuinit
 #endif
 !------------------------------------------------------------------
-   IMPLICIT NONE 
+   IMPLICIT NONE
 !------------------------------------------------------------------
    TYPE (grid_config_rec_type) ::     config_flags
    LOGICAL , INTENT(IN)        :: restart
@@ -3601,18 +3601,18 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
    LOGICAL , INTENT(IN)        :: allowed_to_read
    INTEGER , INTENT(INOUT)     :: STEPCU
 
-   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &    
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &
             RUCUTEN, RVCUTEN, RTHCUTEN, &
             RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN
 #if ( EM_CORE == 1 )
    !BSINGH - For WRFCuP Scheme
-   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &    
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &
         cldfra_cup,cldfratend_cup                               !CuP, wig 18-Sep-2006
    !BSINGH -ENDS
 #endif
 
-   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &    
-                        cugd_tten,cugd_ttens,cugd_qvten,            &    
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &
+                        cugd_tten,cugd_ttens,cugd_qvten,            &
                         cugd_qvtens,cugd_qcten, RQCNCUTEN, RQINCUTEN
 
    REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
@@ -3634,7 +3634,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
    REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
 
    REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX,   &
-                                   APR_GR,APR_W,APR_MC,APR_ST,APR_AS,    &    
+                                   APR_GR,APR_W,APR_MC,APR_ST,APR_AS,    &
                                    APR_CAPMA,APR_CAPME,APR_CAPMI
    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR
 
@@ -3718,7 +3718,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
                       its, ite, jts, jte, kts, kte                )
      CASE (KSASSCHEME,NSASSCHEME)
          CALL nsasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,       &
-                      RUCUTEN,RVCUTEN,                            & 
+                      RUCUTEN,RVCUTEN,                            &
                       restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
                       allowed_to_read ,                           &
                       ids, ide, jds, jde, kds, kde,               &
@@ -3751,7 +3751,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
 
      CASE (SCALESASSCHEME)
           CALL scalesasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,  &
-                      RUCUTEN,RVCUTEN,                            &   
+                      RUCUTEN,RVCUTEN,                            &
                       restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
                       allowed_to_read ,                           &
                       ids, ide, jds, jde, kds, kde,               &
@@ -3801,7 +3801,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
 ! Tiedtke Scheme - ZCX&YQW
       CASE (TIEDTKESCHEME)
           CALL tiedtkeinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,   &
-                      RUCUTEN,RVCUTEN,                            & 
+                      RUCUTEN,RVCUTEN,                            &
                       restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
                       allowed_to_read ,                           &
                       ids, ide, jds, jde, kds, kde,               &
@@ -3978,7 +3978,7 @@ SUBROUTINE shcu_init(STEPCU,CUDT,DT,RUSHTEN,RVSHTEN,RTHSHTEN,   &
                      ims, ime, jms, jme, kms, kme,                  &
                      its, ite, jts, jte, kts, kte                   )
 #endif
- 
+
    CASE DEFAULT
 
    END SELECT shcu_select
@@ -3993,7 +3993,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
                       mp_restart_state,tbpvs_state,tbpvs0_state,   & ! eta mp
                       allowed_to_read, start_of_simulation,       &
 !CAMMGMP specific variables
-                      ixcldliq, ixcldice, ixnumliq, ixnumice,     &       
+                      ixcldliq, ixcldice, ixnumliq, ixnumice,     &
                       nssl_cccn, nssl_alphah, nssl_alphahl,       &
                       nssl_ipelec, nssl_isaund,                  &
                          nssl_cnoh, nssl_cnohl,                  &
@@ -4085,7 +4085,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
      ENDDO
      ENDDO
    ENDIF
-   
+
    IF ( present( nssl_cccn ) ) THEN
      SELECT CASE(config_flags%mp_physics)
      CASE (NSSL_2MOM,NSSL_2MOMCCN)
@@ -4097,7 +4097,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
      CASE DEFAULT
        nssl_ipelec_tmp = 0.0
      END SELECT
-     
+
      nssl_params(1)  = nssl_cccn
      nssl_params(2)  = nssl_alphah
      nssl_params(3)  = nssl_alphahl
@@ -4153,7 +4153,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
                           ids, ide, jds, jde, kds, kde,           &
                           ims, ime, jms, jme, kms, kme,           &
                           its, ite, jts, jte, kts, kte            )
-#endif 
+#endif
      CASE (THOMPSON)
          IF(start_of_simulation.or.restart.or.config_flags%cycling)     &
             CALL thompson_init(HGT=z_at_q,                              &
@@ -4207,7 +4207,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
      IF(start_of_simulation.or.restart)THEN
           CALL full_hucminit(dt)
      END IF
-    CASE (FAST_KHAIN_LYNN)
+    CASE (FAST_KHAIN_LYNN_SHPUND)
      IF(start_of_simulation.or.restart)THEN
           CALL fast_hucminit(dt)
      END IF
@@ -4227,7 +4227,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
      CASE (CAMMGMPSCHEME) ! CAM5's microphysics
           CALL CAMMGMP_INIT(ixcldliq, ixcldice, ixnumliq, ixnumice &
              ,config_flags%chem_opt                          &
-             ,ids, ide, jds, jde, kds, kde                   & 
+             ,ids, ide, jds, jde, kds, kde                   &
              ,ims, ime, jms, jme, kms, kme                   &
              ,its, ite, jts, jte, kts, kte                   )
 #endif
@@ -4419,7 +4419,7 @@ SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid,       &
    INTEGER , INTENT(IN)    :: no_pbl_nudge_q(maxdom)   ! flags for no moisture nudging in pbl
    INTEGER , INTENT(IN)    :: sfc_scheme_horiz ! horizontal spreading scheme for surf obs (wrf or orig mm5)
    INTEGER , INTENT(IN)    :: sfc_scheme_vert  ! vertical   spreading scheme for surf obs (orig or regime vif)
-   REAL    , INTENT(IN)    :: maxsnd_gap       ! max allowed pressure gap in soundings for interp (centibars) 
+   REAL    , INTENT(IN)    :: maxsnd_gap       ! max allowed pressure gap in soundings for interp (centibars)
    REAL    , INTENT(IN)    :: sfcfact      ! scale factor applied to time window for surface obs
    REAL    , INTENT(IN)    :: sfcfacr      ! scale fac applied to horiz rad of infl for sfc obs
    REAL    , INTENT(IN)    :: dpsmx        ! max pressure change allowed within horiz. infl. range
@@ -4579,7 +4579,7 @@ END SUBROUTINE z2sigma
 
 !--------------------------------------------------------------------
    SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
-!  Purpose: To initialize a set of variables and arrays required by 
+!  Purpose: To initialize a set of variables and arrays required by
 !           the CAM Parameterizations ported to WRF
 !
 !  Called by: Phy_init
@@ -4593,7 +4593,7 @@ SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
      USE constituents,               ONLY : cnst_add
      USE module_cam_support,         ONLY : pcnst =>pcnst_runtime, pcnst_mp
      USE modal_aero_initialize_data_phys, ONLY : modal_aero_initialize_phys
-     
+
      implicit none
 
      TYPE (grid_config_rec_type)              :: config_flags
@@ -4602,12 +4602,12 @@ SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
 
      !Local variables
      !Following variable declarations are from CAM's stratiform.F90 module
-     integer, parameter  :: ncnstmax = 4                    ! Number of constituents     
+     integer, parameter  :: ncnstmax = 4                    ! Number of constituents
      integer             :: mm
-     character(len=8), dimension(ncnstmax), parameter :: cnst_names = & 
+     character(len=8), dimension(ncnstmax), parameter :: cnst_names = &
           (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE'/)         ! Constituent names
      !Variables with dummy values
-     integer  :: dumind 
+     integer  :: dumind
      real(r8) :: one
 
      !set dynamic (runtime)pcnst
@@ -4641,34 +4641,34 @@ SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
      ENDIF
 
 
-     !For assisting decoupled microphysics (MP) CAM MAM simulations (simulations, where MAM package is coupled with 
+     !For assisting decoupled microphysics (MP) CAM MAM simulations (simulations, where MAM package is coupled with
      !radiation but uncoupled with MP- i.e. MP runs with 'prescribed' aerosols) 'pcnst_mp' is defined.'pcnst_mp' will
      !only be used in the CAMMGMP driver and its supporting modules (ndrop and microp_aero)
      pcnst_mp = pcnst
      if(.NOT.config_flags%CAM_MP_MAM_cpled)pcnst_mp = 12
 #endif
 
-     ! Initialize the saturation vapor pressure look-up table...      
+     ! Initialize the saturation vapor pressure look-up table...
      call esinti(epsilo, latvap, latice, rh2o, cpair, tmelt)
-     
+
      IF(.NOT.CAM_INITIALIZED) THEN
-        
+
         !Allocate module level CAM arrays
-        call ALLOCATE_CAM_ARRAYS()     
-        
+        call ALLOCATE_CAM_ARRAYS()
+
         !-------------------------------------------------------------------------------------!
         !Calls to add constituents (these calls are imported from in initindx.F90 in CAM)     !
         !                                                                                     !
         ! Register water vapor.                                                               !
         ! ** This must be the first call to cnst_add so that water vapor is constituent 1.**  !
         !-------------------------------------------------------------------------------------!
-        
+
         call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, &
              longname='Specific humidity', readiv=.true. )
-        
-        
+
+
         !Following add constituent calls are imported from the stratiform.F90 in CAM
-        
+
         call cnst_add(cnst_names(1), mwdry, cpair, 0._r8, ixcldliq, &
              longname='Grid box averaged cloud liquid amount')
         call cnst_add(cnst_names(2), mwdry, cpair, 0._r8, ixcldice, &
@@ -4700,17 +4700,17 @@ SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
                 longname='Grid box averaged coarse mode2 mass')
            call cnst_add('COARSE_NUM' , one, cpair, 0._r8, dumind, &
                 longname='Grid box averaged coarse mode number')
-           
+
         ENDIF
 #endif
-        
+
         CAM_INITIALIZED = .TRUE.
      ENDIF
-     
+
 #if ( EM_CORE == 1 )
      IF(config_flags%mp_physics == CAMMGMPSCHEME)THEN
 #if ( WRF_CHEM != 1 )
-        !Aerosols must be initialized after adding the constituents otherwise the code may crash in WRF-Chem simulations     
+        !Aerosols must be initialized after adding the constituents otherwise the code may crash in WRF-Chem simulations
         CALL modal_aero_initialize_phys
 #else
         if(config_flags%chem_opt==0) then
@@ -4734,7 +4734,7 @@ SUBROUTINE ALLOCATE_CAM_ARRAYS ()
    USE constituents,         ONLY : cnst_name,cnst_longname,cnst_cp,&
         cnst_cv,cnst_mw,cnst_type,cnst_rgas,qmin,qmincg,            &
         cnst_fixed_ubc,apcnst,bpcnst,hadvnam,vadvnam,dcconnam,      &
-        fixcnam,tendnam,ptendnam,dmetendnam,sflxnam,tottnam  
+        fixcnam,tendnam,ptendnam,dmetendnam,sflxnam,tottnam
 
    USE module_cam_support,   ONLY : pcnst =>pcnst_runtime, pcnst_mp
 
@@ -4758,7 +4758,7 @@ SUBROUTINE ALLOCATE_CAM_ARRAYS ()
    !Allocate module_cam_mp_modal_aero_data_phys.F arrays
    Allocate(cnst_name_cw(pcnst),cnst_name_cw_mp(pcnst_mp),          &
         species_class(pcnst),qneg3_worst_thresh_amode(pcnst)        )
-   
+
  END SUBROUTINE ALLOCATE_CAM_ARRAYS
 
 subroutine aerosol_in(aerodm,pina,alevsiz,no_months,no_src_types,XLAT,XLONG,   &
@@ -4766,14 +4766,14 @@ subroutine aerosol_in(aerodm,pina,alevsiz,no_months,no_src_types,XLAT,XLONG,   &
                      ims, ime, jms, jme, kms, kme,                  &
                      its, ite, jts, jte, kts, kte)
 !
-! Adaped from oznini in CAM 
+! Adaped from oznini in CAM
 ! It should be replaced by monthly climatology that varies latitudinally and vertically
 !
    IMPLICIT NONE
 
    INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde, &
                                        ims,ime, jms,jme, kms,kme, &
-                                       its,ite, jts,jte, kts,kte   
+                                       its,ite, jts,jte, kts,kte
 
    INTEGER,      INTENT(IN   )    ::   alevsiz, no_months, no_src_types
 
@@ -4786,7 +4786,7 @@ subroutine aerosol_in(aerodm,pina,alevsiz,no_months,no_src_types,XLAT,XLONG,   &
 
 ! Local
 !  Data from Ryan Torn, computed from EC 6 types of aerosol data:
-!    organic carbon, sea salt, dust, black carbon, sulfalte 
+!    organic carbon, sea salt, dust, black carbon, sulfalte
 !    and stratospheric aerosol (volcanic ashes)
 !  The data dimensions are 46 x 72 x 12 (pressure levels), and in unit of AOD per Pa
 
@@ -5077,7 +5077,7 @@ subroutine aerosol_in_cu(aeromcu,alevsiz,no_months,no_src_types,XLAT,XLONG,aerop
              END IF
           END IF
 
-          ! Read aerosol information 
+          ! Read aerosol information
           OPEN(UNIT=iunit, FILE='CESM_RCP4.5_Aerosol_Data.dat', FORM='unformatted', &
                STATUS='old', IOSTAT=istatus)
             IF (istatus == 0) THEN

From 00d3db272b24b3806b6d79b80340f89806b3c75e Mon Sep 17 00:00:00 2001
From: JS-WRF-SBM <48547778+JS-WRF-SBM@users.noreply.github.com>
Date: Fri, 5 Apr 2019 03:12:25 +0300
Subject: [PATCH 02/29] Update registry.polrad

---
 Registry/registry.polrad | 112 +++++++++++++++++++--------------------
 1 file changed, 56 insertions(+), 56 deletions(-)

diff --git a/Registry/registry.polrad b/Registry/registry.polrad
index 8dacaed828..9de9c9818b 100644
--- a/Registry/registry.polrad
+++ b/Registry/registry.polrad
@@ -3,59 +3,59 @@ rconfig   integer sbm_diagnostics          namelist,physics         max_domains
 
 
 # sbm radar variables
-state   real    -                 ikjf sbmradar      1         -     -   -
-state   real    Water_zh            ikjf  sbmradar        1         -    rh03   "Water_zh"    "Water Horizontal Refl."      "dBZ"
-state   real    Water_zv            ikjf  sbmradar        1         -    rh03   "Water_zv"    "Water Vertical Refl."      "dBZ"
-state   real    Water_zdr           ikjf  sbmradar        1         -    rh03   "Water_zdr"    "Water Differential Refl."      "dBZ"
-state   real    Water_ldr           ikjf  sbmradar        1         -    rh03   "Water_ldr"    "Water Linear Differntial Refl."      "dB"
-state   real    Water_kdp            ikjf   sbmradar        1         -    rh03   "Water_kdp"    " Water KDP  "      "dBZ"
-state   real    Water_crs            ikjf   sbmradar        1         -    rh03   "Water_crs"    "Water Cross-Correlation"      "   "
-state   real    Hail_zh            ikjf  sbmradar        1         -    rh03   "Hail_zh"    "Hail Horizontal Refl."      "dBZ"
-state   real    Hail_zv            ikjf  sbmradar        1         -    rh03   "Hail_zv"    "Hail Vertical Refl."      "dBZ"
-state   real    Hail_zdr            ikjf  sbmradar        1         -    rh03   "Hail_zdr"    "Hail Differential Refl."      "dBZ"
-state   real    Hail_ldr           ikjf  sbmradar        1         -    rh03   "Hail_ldr"    "Hail Linear Differntial Refl."      "dB"
-state   real    Hail_kdp            ikjf  sbmradar        1         -    rh03   "Hail_kdp"    "  Hail KDP   "      "deg km^-1"
-state   real    Hail_crs            ikjf  sbmradar        1         -    rh03   "Hail_crs"    "Hail Cross-Correlation"      "   "
-state   real    Freezing_D_zh            ikjf  sbmradar        1         -    rh03   "Freezing_D_zh"    "F.Dx Horizontal Refl."      "dBZ"
-state   real    Freezing_D_zv            ikjf  sbmradar        1         -    rh03   "Freezing_D_zv"    "F.Dx Vertical Refl."      "dBZ"
-state   real    Freezing_D_zdr            ikjf  sbmradar        1         -    rh03   "Freezing_D_zdr"    "F.Dx Differential Refl."      "dBZ"
-state   real    Freezing_D_ldr           ikjf  sbmradar        1         -    rh03   "Freezing_D_ldr"    "F.Dx Linear Differntial Refl."      "dB"
-state   real    Freezing_D_kdp            ikjf  sbmradar        1         -    rh03   "Freezing_D_kdp"    "  F.Dx KDP   "      "deg km^-1"
-state   real    Freezing_D_crs            ikjf  sbmradar        1         -    rh03   "Freezing_D_crs"    "F.Dx Cross-Correlation"      "   "
-state   real    Graupel_zh            ikjf  sbmradar        1         -    rh03   "Graupel_zh"    "Graupel Horizontal Refl."      "dBZ"
-state   real    Graupel_zv            ikjf  sbmradar        1         -    rh03   "Graupel_zv"    "Graupel Vertical Refl."      "dBZ"
-state   real    Graupel_zdr            ikjf  sbmradar        1         -    rh03   "Graupel_zdr"    "Graupel Differential Refl."      "dBZ"
-state   real    Graupel_ldr           ikjf  sbmradar        1         -    rh03   "Graupel_ldr"    "Graupel Linear Differntial Refl."      "dB"
-state   real    Graupel_kdp            ikjf  sbmradar        1         -    rh03   "Graupel_kdp"    "  Graupel KDP   "      "deg km^-1"
-state   real    Graupel_crs            ikjf sbmradar        1         -    rh03   "Graupel_crs"    "Graupel Cross-Correlation"      "   "
-state   real    Plates_zh            ikjf  sbmradar        1         -    rh03   "Plates_zh"    "Plates Horizontal Refl."      "dBZ"
-state   real    Plates_zv            ikjf  sbmradar        1         -    rh03   "Plates_zv"    "Plates Vertical Refl."      "dBZ"
-state   real    Plates_zdr            ikjf  sbmradar        1         -    rh03   "Plates_zdr"    "Plates Differential Refl."      "dBZ"
-state   real    Plates_ldr           ikjf  sbmradar        1         -    rh03   "Plates_ldr"    "Plates Linear Differntial Refl."      "dB"
-state   real    Plates_kdp            ikjf  sbmradar        1         -    rh03   "Plates_kdp"    "  Plates KDP   "      "deg km^-1"
-state   real    Plates_crs            ikjf  sbmradar        1         -    rh03   "Plates_crs"    "Plates Cross-Correlation"      "   "
-state   real    Dendrites_zh            ikjf  sbmradar        1         -    rh03   "Dendrites_zh"    "Dendrites Horizontal Refl."      "dBZ"
-state   real    Dendrites_zv            ikjf  sbmradar        1         -    rh03   "Dendrites_zv"    "Dendrites Vertical Refl."      "dBZ"
-state   real    Dendrites_zdr            ikjf  sbmradar        1         -    rh03   "Dendrites_zdr"    "Dendrites Differential Refl."      "dBZ"
-state   real    Dendrites_ldr           ikjf  sbmradar        1         -    rh03   "Dendrites_ldr"    "Dendrites Linear Differntial Refl."      "dB"
-state   real    Dendrites_kdp            ikjf  sbmradar        1         -    rh03   "Dendrites_kdp"    "  Dendrites KDP   "      "deg km^-1"
-state   real    Dendrites_crs            ikjf  sbmradar        1         -    rh03   "Dendrites_crs"    "Dendrites Cross-Correlation"      "   "
-state   real    Snow_zh            ikjf  sbmradar        1         -    rh03   "Snow_zh"    "Snow Horizontal Refl."      "dBZ"
-state   real    Snow_zv            ikjf  sbmradar        1         -    rh03   "Snow_zv"    "Snow Vertical Refl."      "dBZ"
-state   real    Snow_zdr            ikjf  sbmradar        1         -    rh03   "Snow_zdr"    "Snow Differential Refl."      "dBZ"
-state   real    Snow_ldr           ikjf  sbmradar        1         -    rh03   "Snow_ldr"    "Snow Linear Differntial Refl."      "dB"
-state   real    Snow_kdp            ikjf  sbmradar        1         -    rh03   "Snow_kdp"    "  Snow KDP   "      "deg km^-1"
-state   real    Snow_crs            ikjf  sbmradar        1         -    rh03   "Snow_crs"    "Snow Cross-Correlation"      "   "
-state   real    Columns_zh            ikjf  sbmradar        1         -    rh03   "Columns_zh"    "Columns Horizontal Refl."      "dBZ"
-state   real    Columns_zv            ikjf  sbmradar        1         -    rh03   "Columns_zv"    "Columns Vertical Refl."      "dBZ"
-state   real    Columns_zdr            ikjf  sbmradar        1         -    rh03   "Columns_zdr"    "Columns Differential Refl."      "dBZ"
-state   real    Columns_ldr           ikjf  sbmradar        1         -    rh03   "Columns_ldr"    "Columns Linear Differntial Refl."      "dB"
-state   real    Columns_kdp            ikjf  sbmradar        1         -    rh03   "Columns_kdp"    "  Columns KDP   "      "deg km^-1"
-state   real    Columns_crs            ikjf  sbmradar        1         -    rh03   "Columns_crs"    "Columns Cross-Correlation"      "   "
-state   real    Total_zh            ikjf  sbmradar        1         -    rh03   "Total_zh"    "Total Horizontal Refl."      "dBZ"
-state   real    Total_zv            ikjf  sbmradar        1         -    rh03   "Total_zv"    "Total Vertical Refl."      "dBZ"
-state   real    Total_zdr            ikjf  sbmradar        1         -    rh03   "Total_zdr"    "Total Differential Refl."      "dBZ"
-state   real    Total_ldr           ikjf  sbmradar        1         -    rh03   "Total_ldr"    "Total Linear Differntial Refl."      "dB"
-state   real    Total_kdp            ikjf  sbmradar        1         -    rh03   "Total_kdp"    "  Total KDP   "      "deg km^-1"
-state   real    Total_crs            ikjf  sbmradar        1         -    rh03   "Total_crs"    "Total Cross-Correlation"      "   "
-package  sbm_output sbm_diagnostics==1   -   sbmradar:Water_zh,Water_zv,Water_zdr,Water_ldr,Water_kdp,Water_crs,Hail_zh,Hail_zv,Hail_zdr,Hail_ldr,Hail_kdp,Hail_crs,Freezing_D_zh,Freezing_D_zv,Freezing_D_zdr,Freezing_D_ldr,Freezing_D_kdp,Freezing_D_crs,Graupel_zh,Graupel_zv,Graupel_zdr,Graupel_ldr,Graupel_kdp,Graupel_crs,Plates_zh,Plates_zv,Plates_zdr,Plates_ldr,Plates_kdp,Plates_crs,Dendrites_zh,Dendrites_zv,Dendrites_zdr,Dendrites_ldr,Dendrites_kdp,,Dendrites_crs,Snow_zh,Snow_zv,Snow_zdr,Snow_ldr,Snow_kdp,Snow_crs,Columns_zh,Columns_zv,Columns_zdr,Columns_ldr,Columns_kdp,Columns_crs,Total_zh,Total_zv,Total_zdr,Total_ldr,Total_kdp,Total_crs
+state   real    -                 ikjf sbmradar         1         -     -   -
+state   real    Drops_zh          ikjf  sbmradar        1         -    rh03   "Drops_zh"         "Drops Horizontal Refl."          "dBZ"
+state   real    Drops_zv          ikjf  sbmradar        1         -    rh03   "Drops_zv"         "Drops Vertical Refl."            "dBZ"
+state   real    Drops_zdr         ikjf  sbmradar        1         -    rh03   "Drops_zdr"        "Drops Differential Refl."        "dBZ"
+state   real    Drops_ldr         ikjf  sbmradar        1         -    rh03   "Drops_ldr"        "Drops Linear Differntial Refl."  "dBz"
+state   real    Drops_kdp         ikjf   sbmradar       1         -    rh03   "Drops_kdp"        "Drops KDP"                       "deg km^-1"
+state   real    Drops_crs         ikjf   sbmradar       1         -    rh03   "Drops_crs"        "Drops Cross-Correlation"         "   "
+state   real    Hail_zh           ikjf  sbmradar        1         -    rh03   "Hail_zh"          "Hail Horizontal Refl."           "dBZ"
+state   real    Hail_zv           ikjf  sbmradar        1         -    rh03   "Hail_zv"          "Hail Vertical Refl."             "dBZ"
+state   real    Hail_zdr          ikjf  sbmradar        1         -    rh03   "Hail_zdr"         "Hail Differential Refl."         "dBZ"
+state   real    Hail_ldr          ikjf  sbmradar        1         -    rh03   "Hail_ldr"         "Hail Linear Differntial Refl."   "dB"
+state   real    Hail_kdp          ikjf  sbmradar        1         -    rh03   "Hail_kdp"         "  Hail KDP   "                   "deg km^-1"
+state   real    Hail_crs          ikjf  sbmradar        1         -    rh03   "Hail_crs"         "Hail Cross-Correlation"          "   "
+state   real    Freezing_D_zh     ikjf  sbmradar        1         -    rh03   "Freezing_D_zh"    "F.Dx Horizontal Refl."           "dBZ"
+state   real    Freezing_D_zv     ikjf  sbmradar        1         -    rh03   "Freezing_D_zv"    "F.Dx Vertical Refl."             "dBZ"
+state   real    Freezing_D_zdr    ikjf  sbmradar        1         -    rh03   "Freezing_D_zdr"   "F.Dx Differential Refl."         "dBZ"
+state   real    Freezing_D_ldr    ikjf  sbmradar        1         -    rh03   "Freezing_D_ldr"   "F.Dx Linear Differntial Refl."   "dB"
+state   real    Freezing_D_kdp    ikjf  sbmradar        1         -    rh03   "Freezing_D_kdp"   "  F.Dx KDP   "                   "deg km^-1"
+state   real    Freezing_D_crs    ikjf  sbmradar        1         -    rh03   "Freezing_D_crs"   "F.Dx Cross-Correlation"          "   "
+state   real    Graupel_zh        ikjf  sbmradar        1         -    rh03   "Graupel_zh"       "Graupel Horizontal Refl."        "dBZ"
+state   real    Graupel_zv        ikjf  sbmradar        1         -    rh03   "Graupel_zv"       "Graupel Vertical Refl."          "dBZ"
+state   real    Graupel_zdr       ikjf  sbmradar        1         -    rh03   "Graupel_zdr"      "Graupel Differential Refl."      "dBZ"
+state   real    Graupel_ldr       ikjf  sbmradar        1         -    rh03   "Graupel_ldr"      "Graupel Linear Differntial Refl." "dB"
+state   real    Graupel_kdp       ikjf  sbmradar        1         -    rh03   "Graupel_kdp"      "  Graupel KDP   "                 "deg km^-1"
+state   real    Graupel_crs       ikjf sbmradar         1         -    rh03   "Graupel_crs"      "Graupel Cross-Correlation"        "   "
+state   real    Plates_zh         ikjf  sbmradar        1         -    rh03   "Plates_zh"        "Plates Horizontal Refl."          "dBZ"
+state   real    Plates_zv         ikjf  sbmradar        1         -    rh03   "Plates_zv"        "Plates Vertical Refl."            "dBZ"
+state   real    Plates_zdr        ikjf  sbmradar        1         -    rh03   "Plates_zdr"       "Plates Differential Refl."        "dBZ"
+state   real    Plates_ldr        ikjf  sbmradar        1         -    rh03   "Plates_ldr"       "Plates Linear Differntial Refl."   "dB"
+state   real    Plates_kdp        ikjf  sbmradar        1         -    rh03   "Plates_kdp"       "  Plates KDP   "                   "deg km^-1"
+state   real    Plates_crs        ikjf  sbmradar        1         -    rh03   "Plates_crs"       "Plates Cross-Correlation"         "   "
+state   real    Dendrites_zh      ikjf  sbmradar        1         -    rh03   "Dendrites_zh"     "Dendrites Horizontal Refl."       "dBZ"
+state   real    Dendrites_zv      ikjf  sbmradar        1         -    rh03   "Dendrites_zv"     "Dendrites Vertical Refl."         "dBZ"
+state   real    Dendrites_zdr     ikjf  sbmradar        1         -    rh03   "Dendrites_zdr"    "Dendrites Differential Refl."     "dBZ"
+state   real    Dendrites_ldr     ikjf  sbmradar        1         -    rh03   "Dendrites_ldr"    "Dendrites Linear Differntial Refl." "dB"
+state   real    Dendrites_kdp     ikjf  sbmradar        1         -    rh03   "Dendrites_kdp"    "  Dendrites KDP   "               "deg km^-1"
+state   real    Dendrites_crs     ikjf  sbmradar        1         -    rh03   "Dendrites_crs"    "Dendrites Cross-Correlation"      "   "
+state   real    Snow_zh           ikjf  sbmradar        1         -    rh03   "Snow_zh"          "Snow Horizontal Refl."            "dBZ"
+state   real    Snow_zv           ikjf  sbmradar        1         -    rh03   "Snow_zv"          "Snow Vertical Refl."              "dBZ"
+state   real    Snow_zdr          ikjf  sbmradar        1         -    rh03   "Snow_zdr"         "Snow Differential Refl."          "dBZ"
+state   real    Snow_ldr          ikjf  sbmradar        1         -    rh03   "Snow_ldr"         "Snow Linear Differntial Refl."    "dB"
+state   real    Snow_kdp          ikjf  sbmradar        1         -    rh03   "Snow_kdp"         "  Snow KDP   "                    "deg km^-1"
+state   real    Snow_crs          ikjf  sbmradar        1         -    rh03   "Snow_crs"         "Snow Cross-Correlation"           "   "
+state   real    Columns_zh        ikjf  sbmradar        1         -    rh03   "Columns_zh"       "Columns Horizontal Refl."         "dBZ"
+state   real    Columns_zv        ikjf  sbmradar        1         -    rh03   "Columns_zv"       "Columns Vertical Refl."           "dBZ"
+state   real    Columns_zdr       ikjf  sbmradar        1         -    rh03   "Columns_zdr"      "Columns Differential Refl."       "dBZ"
+state   real    Columns_ldr       ikjf  sbmradar        1         -    rh03   "Columns_ldr"      "Columns Linear Differntial Refl." "dB"
+state   real    Columns_kdp       ikjf  sbmradar        1         -    rh03   "Columns_kdp"      "  Columns KDP   "                 "deg km^-1"
+state   real    Columns_crs       ikjf  sbmradar        1         -    rh03   "Columns_crs"      "Columns Cross-Correlation"        "   "
+state   real    Total_zh          ikjf  sbmradar        1         -    rh03   "Total_zh"         "Total Horizontal Refl."           "dBZ"
+state   real    Total_zv          ikjf  sbmradar        1         -    rh03   "Total_zv"         "Total Vertical Refl."             "dBZ"
+state   real    Total_zdr         ikjf  sbmradar        1         -    rh03   "Total_zdr"        "Total Differential Refl."         "dBZ"
+state   real    Total_ldr         ikjf  sbmradar        1         -    rh03   "Total_ldr"        "Total Linear Differntial Refl."   "dB"
+state   real    Total_kdp         ikjf  sbmradar        1         -    rh03   "Total_kdp"        "  Total KDP   "                   "deg km^-1"
+state   real    Total_crs         ikjf  sbmradar        1         -    rh03   "Total_crs"        "Total Cross-Correlation"          "   "
+package  sbm_output sbm_diagnostics==1   -   sbmradar:Drops_zh,Drops_zv,Drops_zdr,Drops_ldr,Drops_kdp,Drops_crs,Hail_zh,Hail_zv,Hail_zdr,Hail_ldr,Hail_kdp,Hail_crs,Freezing_D_zh,Freezing_D_zv,Freezing_D_zdr,Freezing_D_ldr,Freezing_D_kdp,Freezing_D_crs,Graupel_zh,Graupel_zv,Graupel_zdr,Graupel_ldr,Graupel_kdp,Graupel_crs,Plates_zh,Plates_zv,Plates_zdr,Plates_ldr,Plates_kdp,Plates_crs,Dendrites_zh,Dendrites_zv,Dendrites_zdr,Dendrites_ldr,Dendrites_kdp,,Dendrites_crs,Snow_zh,Snow_zv,Snow_zdr,Snow_ldr,Snow_kdp,Snow_crs,Columns_zh,Columns_zv,Columns_zdr,Columns_ldr,Columns_kdp,Columns_crs,Total_zh,Total_zv,Total_zdr,Total_ldr,Total_kdp,Total_crs

From d4bea5c135db84ce7949d71718ee72dd3590519b Mon Sep 17 00:00:00 2001
From: JS-WRF-SBM <48547778+JS-WRF-SBM@users.noreply.github.com>
Date: Fri, 5 Apr 2019 03:13:47 +0300
Subject: [PATCH 03/29] Update registry.sbm

---
 Registry/registry.sbm | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/Registry/registry.sbm b/Registry/registry.sbm
index 2a519592b2..201cb0ee25 100644
--- a/Registry/registry.sbm
+++ b/Registry/registry.sbm
@@ -315,5 +315,5 @@ state    real    kext_ft_qs      ikj      misc        1         -      rh05
 state    real    kext_ft_qg      ikj      misc        1         -      rh05        "KEXT_FT_QG"          " Extinction Adj. Coefficient for graupel "         "m-1"
 state    real    height          ikj      misc        1         -      rh5         "HEIGHT"              " Height "                                          "m"
 state    real    tempc           ikj      misc        1         -      rh5         "TEMPC"               " Temperature "                                     "C"
-package   fast_khain_lynn_shpund    mp_physics==30               -             moist:qv,qc,qr,qi,qs,qg;scalar:ff1i01,ff1i02,ff1i03,ff1i04,ff1i05,ff1i06,ff1i07,ff1i08,ff1i09,ff1i10,ff1i11,ff1i12,ff1i13,ff1i14,ff1i15,ff1i16,ff1i17,ff1i18,ff1i19,ff1i20,ff1i21,ff1i22,ff1i23,ff1i24,ff1i25,ff1i26,ff1i27,ff1i28,ff1i29,ff1i30,ff1i31,ff1i32,ff1i33,ff5i01,ff5i02,ff5i03,ff5i04,ff5i05,ff5i06,ff5i07,ff5i08,ff5i09,ff5i10,ff5i11,ff5i12,ff5i13,ff5i14,ff5i15,ff5i16,ff5i17,ff5i18,ff5i19,ff5i20,ff5i21,ff5i22,ff5i23,ff5i24,ff5i25,ff5i26,ff5i27,ff5i28,ff5i29,ff5i30,ff5i31,ff5i32,ff5i33,ff6i01,ff6i02,ff6i03,ff6i04,ff6i05,ff6i06,ff6i07,ff6i08,ff6i09,ff6i10,ff6i11,ff6i12,ff6i13,ff6i14,ff6i15,ff6i16,ff6i17,ff6i18,ff6i19,ff6i20,ff6i21,ff6i22,ff6i23,ff6i24,ff6i25,ff6i26,ff6i27,ff6i28,ff6i29,ff6i30,ff6i31,ff6i32,ff6i33,ff8i01,ff8i02,ff8i03,ff8i04,ff8i05,ff8i06,ff8i07,ff8i08,ff8i09,ff8i10,ff8i11,ff8i12,ff8i13,ff8i14,ff8i15,ff8i16,ff8i17,ff8i18,ff8i19,ff8i20,ff8i21,ff8i22,ff8i23,ff8i24,ff8i25,ff8i26,ff8i27,ff8i28,ff8i29,ff8i30,ff8i31,ff8i32,ff8i33,ff8i34,ff8i35,ff8i36,ff8i37,ff8i38,ff8i39,ff8i40,ff8i41,ff8i42,ff8i43,qnn,qnc,qnr,qni,qns,qng,effr,ice_effr,tot_effr,th_old,qv_old,tempc,height
-package   full_khain_lynn    mp_physics==32               -             moist:qv,qc,qr,qi,qic,qip,qid,qs,qg,qh;scalar:ff1i01,ff1i02,ff1i03,ff1i04,ff1i05,ff1i06,ff1i07,ff1i08,ff1i09,ff1i10,ff1i11,ff1i12,ff1i13,ff1i14,ff1i15,ff1i16,ff1i17,ff1i18,ff1i19,ff1i20,ff1i21,ff1i22,ff1i23,ff1i24,ff1i25,ff1i26,ff1i27,ff1i28,ff1i29,ff1i30,ff1i31,ff1i32,ff1i33,ff5i01,ff5i02,ff5i03,ff5i04,ff5i05,ff5i06,ff5i07,ff5i08,ff5i09,ff5i10,ff5i11,ff5i12,ff5i13,ff5i14,ff5i15,ff5i16,ff5i17,ff5i18,ff5i19,ff5i20,ff5i21,ff5i22,ff5i23,ff5i24,ff5i25,ff5i26,ff5i27,ff5i28,ff5i29,ff5i30,ff5i31,ff5i32,ff5i33,ff6i01,ff6i02,ff6i03,ff6i04,ff6i05,ff6i06,ff6i07,ff6i08,ff6i09,ff6i10,ff6i11,ff6i12,ff6i13,ff6i14,ff6i15,ff6i16,ff6i17,ff6i18,ff6i19,ff6i20,ff6i21,ff6i22,ff6i23,ff6i24,ff6i25,ff6i26,ff6i27,ff6i28,ff6i29,ff6i30,ff6i31,ff6i32,ff6i33,ff8i01,ff8i02,ff8i03,ff8i04,ff8i05,ff8i06,ff8i07,ff8i08,ff8i09,ff8i10,ff8i11,ff8i12,ff8i13,ff8i14,ff8i15,ff8i16,ff8i17,ff8i18,ff8i19,ff8i20,ff8i21,ff8i22,ff8i23,ff8i24,ff8i25,ff8i26,ff8i27,ff8i28,ff8i29,ff8i30,ff8i31,ff8i32,ff8i33,ff2i01,ff2i02,ff2i03,ff2i04,ff2i05,ff2i06,ff2i07,ff2i08,ff2i09,ff2i10,ff2i11,ff2i12,ff2i13,ff2i14,ff2i15,ff2i16,ff2i17,ff2i18,ff2i19,ff2i20,ff2i21,ff2i22,ff2i23,ff2i24,ff2i25,ff2i26,ff2i27,ff2i28,ff2i29,ff2i30,ff2i31,ff2i32,ff2i33,ff3i01,ff3i02,ff3i03,ff3i04,ff3i05,ff3i06,ff3i07,ff3i08,ff3i09,ff3i10,ff3i11,ff3i12,ff3i13,ff3i14,ff3i15,ff3i16,ff3i17,ff3i18,ff3i19,ff3i20,ff3i21,ff3i22,ff3i23,ff3i24,ff3i25,ff3i26,ff3i27,ff3i28,ff3i29,ff3i30,ff3i31,ff3i32,ff3i33,ff4i01,ff4i02,ff4i03,ff4i04,ff4i05,ff4i06,ff4i07,ff4i08,ff4i09,ff4i10,ff4i11,ff4i12,ff4i13,ff4i14,ff4i15,ff4i16,ff4i17,ff4i18,ff4i19,ff4i20,ff4i21,ff4i22,ff4i23,ff4i24,ff4i25,ff4i26,ff4i27,ff4i28,ff4i29,ff4i30,ff4i31,ff4i32,ff4i33,ff7i01,ff7i02,ff7i03,ff7i04,ff7i05,ff7i06,ff7i07,ff7i08,ff7i09,ff7i10,ff7i11,ff7i12,ff7i13,ff7i14,ff7i15,ff7i16,ff7i17,ff7i18,ff7i19,ff7i20,ff7i21,ff7i22,ff7i23,ff7i24,ff7i25,ff7i26,ff7i27,ff7i28,ff7i29,ff7i30,ff7i31,ff7i32,ff7i33,qnn,qnc,qnr,qni,qnic,qnip,qnid,qns,qng,qnh,effr,ice_effr,tot_effr,qic_effr,qip_effr,qid_effr;state:kext_ql,kext_qic,kext_qip,kext_qid,kext_qs,kext_qg,kext_qh,kext_qa,kext_ft_qic,kext_ft_qip,kext_ft_qid,kext_ft_qs,kext_ft_qg,th_old,qv_old,tempc,height
+package   fast_khain_lynn_shpund    mp_physics==30               -      moist:qv,qc,qr,qi,qs,qg;scalar:ff1i01,ff1i02,ff1i03,ff1i04,ff1i05,ff1i06,ff1i07,ff1i08,ff1i09,ff1i10,ff1i11,ff1i12,ff1i13,ff1i14,ff1i15,ff1i16,ff1i17,ff1i18,ff1i19,ff1i20,ff1i21,ff1i22,ff1i23,ff1i24,ff1i25,ff1i26,ff1i27,ff1i28,ff1i29,ff1i30,ff1i31,ff1i32,ff1i33,ff5i01,ff5i02,ff5i03,ff5i04,ff5i05,ff5i06,ff5i07,ff5i08,ff5i09,ff5i10,ff5i11,ff5i12,ff5i13,ff5i14,ff5i15,ff5i16,ff5i17,ff5i18,ff5i19,ff5i20,ff5i21,ff5i22,ff5i23,ff5i24,ff5i25,ff5i26,ff5i27,ff5i28,ff5i29,ff5i30,ff5i31,ff5i32,ff5i33,ff6i01,ff6i02,ff6i03,ff6i04,ff6i05,ff6i06,ff6i07,ff6i08,ff6i09,ff6i10,ff6i11,ff6i12,ff6i13,ff6i14,ff6i15,ff6i16,ff6i17,ff6i18,ff6i19,ff6i20,ff6i21,ff6i22,ff6i23,ff6i24,ff6i25,ff6i26,ff6i27,ff6i28,ff6i29,ff6i30,ff6i31,ff6i32,ff6i33,ff8i01,ff8i02,ff8i03,ff8i04,ff8i05,ff8i06,ff8i07,ff8i08,ff8i09,ff8i10,ff8i11,ff8i12,ff8i13,ff8i14,ff8i15,ff8i16,ff8i17,ff8i18,ff8i19,ff8i20,ff8i21,ff8i22,ff8i23,ff8i24,ff8i25,ff8i26,ff8i27,ff8i28,ff8i29,ff8i30,ff8i31,ff8i32,ff8i33,ff8i34,ff8i35,ff8i36,ff8i37,ff8i38,ff8i39,ff8i40,ff8i41,ff8i42,ff8i43,qnn,qnc,qnr,qni,qns,qng,effr,ice_effr,tot_effr,th_old,qv_old,tempc,height
+package   full_khain_lynn           mp_physics==32               -      moist:qv,qc,qr,qi,qic,qip,qid,qs,qg,qh;scalar:ff1i01,ff1i02,ff1i03,ff1i04,ff1i05,ff1i06,ff1i07,ff1i08,ff1i09,ff1i10,ff1i11,ff1i12,ff1i13,ff1i14,ff1i15,ff1i16,ff1i17,ff1i18,ff1i19,ff1i20,ff1i21,ff1i22,ff1i23,ff1i24,ff1i25,ff1i26,ff1i27,ff1i28,ff1i29,ff1i30,ff1i31,ff1i32,ff1i33,ff5i01,ff5i02,ff5i03,ff5i04,ff5i05,ff5i06,ff5i07,ff5i08,ff5i09,ff5i10,ff5i11,ff5i12,ff5i13,ff5i14,ff5i15,ff5i16,ff5i17,ff5i18,ff5i19,ff5i20,ff5i21,ff5i22,ff5i23,ff5i24,ff5i25,ff5i26,ff5i27,ff5i28,ff5i29,ff5i30,ff5i31,ff5i32,ff5i33,ff6i01,ff6i02,ff6i03,ff6i04,ff6i05,ff6i06,ff6i07,ff6i08,ff6i09,ff6i10,ff6i11,ff6i12,ff6i13,ff6i14,ff6i15,ff6i16,ff6i17,ff6i18,ff6i19,ff6i20,ff6i21,ff6i22,ff6i23,ff6i24,ff6i25,ff6i26,ff6i27,ff6i28,ff6i29,ff6i30,ff6i31,ff6i32,ff6i33,ff8i01,ff8i02,ff8i03,ff8i04,ff8i05,ff8i06,ff8i07,ff8i08,ff8i09,ff8i10,ff8i11,ff8i12,ff8i13,ff8i14,ff8i15,ff8i16,ff8i17,ff8i18,ff8i19,ff8i20,ff8i21,ff8i22,ff8i23,ff8i24,ff8i25,ff8i26,ff8i27,ff8i28,ff8i29,ff8i30,ff8i31,ff8i32,ff8i33,ff2i01,ff2i02,ff2i03,ff2i04,ff2i05,ff2i06,ff2i07,ff2i08,ff2i09,ff2i10,ff2i11,ff2i12,ff2i13,ff2i14,ff2i15,ff2i16,ff2i17,ff2i18,ff2i19,ff2i20,ff2i21,ff2i22,ff2i23,ff2i24,ff2i25,ff2i26,ff2i27,ff2i28,ff2i29,ff2i30,ff2i31,ff2i32,ff2i33,ff3i01,ff3i02,ff3i03,ff3i04,ff3i05,ff3i06,ff3i07,ff3i08,ff3i09,ff3i10,ff3i11,ff3i12,ff3i13,ff3i14,ff3i15,ff3i16,ff3i17,ff3i18,ff3i19,ff3i20,ff3i21,ff3i22,ff3i23,ff3i24,ff3i25,ff3i26,ff3i27,ff3i28,ff3i29,ff3i30,ff3i31,ff3i32,ff3i33,ff4i01,ff4i02,ff4i03,ff4i04,ff4i05,ff4i06,ff4i07,ff4i08,ff4i09,ff4i10,ff4i11,ff4i12,ff4i13,ff4i14,ff4i15,ff4i16,ff4i17,ff4i18,ff4i19,ff4i20,ff4i21,ff4i22,ff4i23,ff4i24,ff4i25,ff4i26,ff4i27,ff4i28,ff4i29,ff4i30,ff4i31,ff4i32,ff4i33,ff7i01,ff7i02,ff7i03,ff7i04,ff7i05,ff7i06,ff7i07,ff7i08,ff7i09,ff7i10,ff7i11,ff7i12,ff7i13,ff7i14,ff7i15,ff7i16,ff7i17,ff7i18,ff7i19,ff7i20,ff7i21,ff7i22,ff7i23,ff7i24,ff7i25,ff7i26,ff7i27,ff7i28,ff7i29,ff7i30,ff7i31,ff7i32,ff7i33,qnn,qnc,qnr,qni,qnic,qnip,qnid,qns,qng,qnh,effr,ice_effr,tot_effr,qic_effr,qip_effr,qid_effr;state:kext_ql,kext_qic,kext_qip,kext_qid,kext_qs,kext_qg,kext_qh,kext_qa,kext_ft_qic,kext_ft_qip,kext_ft_qid,kext_ft_qs,kext_ft_qg,th_old,qv_old,tempc,height

From 74b7f3edbe34df8443cfd33e8a6cb049bbb370a2 Mon Sep 17 00:00:00 2001
From: Jacob Shpund 
Date: Fri, 5 Apr 2019 13:06:01 +0300
Subject: [PATCH 04/29] An single line updated in dyn_em/solve_em.F

---
 dyn_em/solve_em.F | 286 +++++++++++++++++++---------------------------
 1 file changed, 119 insertions(+), 167 deletions(-)

diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F
index 7866c67502..9992928eee 100644
--- a/dyn_em/solve_em.F
+++ b/dyn_em/solve_em.F
@@ -117,17 +117,17 @@ SUBROUTINE solve_em ( grid , config_flags  &
    LOGICAL                         :: specified_bdy, channel_bdy
 
    REAL                            :: t_new, time_duration_of_lbcs
-
+   
    ! Changes in tendency at this timestep
    real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: h_tendency, &
                                                                                    z_tendency
-
+                                                                                   
    ! Whether advection should produce decoupled horizontal and vertical advective tendency outputs
    LOGICAL                        :: tenddec
-
+   
    ! Flag for producing diagnostic fields (e.g., radar reflectivity)
    LOGICAL                        :: diag_flag
-
+   
 #if (WRF_CHEM == 1)
    ! Index cross-referencing array for tendency accumulation
    INTEGER, DIMENSION( num_chem ) :: adv_ct_indices
@@ -142,7 +142,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! time.  Potential problem on stack-limited architectures: increases
 ! amount of data on program stack by making these automatic arrays.
 
-   INTEGER :: rc
+   INTEGER :: rc 
    INTEGER :: number_of_small_timesteps, rk_step
    INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2    ! for prints/plots only
    INTEGER :: idum1, idum2, dynamics_option
@@ -189,27 +189,27 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 !
 ! solve_em is the main driver for advancing a grid a single timestep.
-! It is a mediation-layer routine -> DM and SM calls are made where
-! needed for parallel processing.
+! It is a mediation-layer routine -> DM and SM calls are made where 
+! needed for parallel processing.  
 !
 ! solve_em can integrate the equations using 3 time-integration methods
-!
+!      
 !    - 3rd order Runge-Kutta time integration (recommended)
-!
+!      
 !    - 2nd order Runge-Kutta time integration
-!
+!      
 ! The main sections of solve_em are
-!
+!     
 ! (1) Runge-Kutta (RK) loop
-!
+!     
 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
 !     model state variables during the first RK sub-step (loop)
-!
+!     
 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
-!
+!     
 ! (4) scalar advance for moist and chem scalar variables (and TKE)
 !     within the RK sub-steps.
-!
+!     
 ! (5) time-split physics (after the RK step), currently this includes
 !     only microphyics
 !
@@ -234,7 +234,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              ipsx, ipex, jpsx, jpex, kpsx, kpex,    &
                              imsy, imey, jmsy, jmey, kmsy, kmey,    &
                              ipsy, ipey, jpsy, jpey, kpsy, kpey )
-
+ 
    CALL get_ijk_from_subgrid (  grid ,                   &
                              sids, side, sjds, sjde, skds, skde,    &
                              sims, sime, sjms, sjme, skms, skme,    &
@@ -299,7 +299,6 @@ SUBROUTINE solve_em ( grid , config_flags  &
    if ( Is_alarm_tstep(grid%domain_clock, grid%alarms(HISTORY_ALARM)) ) then
       diag_flag = .true.
    endif
-   IF (config_flags%nwp_diagnostics == 1) diag_flag = .true.
 
    grid%itimestep = grid%itimestep + 1
    grid%dtbc = grid%dtbc + grid%dt
@@ -393,7 +392,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    dts = grid%dt/float(num_sound_steps)
 
    IF (config_flags%use_adaptive_time_step) THEN
-
+  
      CALL get_wrf_debug_level( debug_level )
      IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
 #ifdef DM_PARALLEL
@@ -456,7 +455,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP END PARALLEL DO
 
      !  Now that we have initialized the moist_old values with P_Qv for
-     !  computing a moist t_tendf after rk_step part2, fill in the halo
+     !  computing a moist t_tendf after rk_step part2, fill in the halo 
      !  and period boundaries.
 
 #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
@@ -509,7 +508,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    !  each part of the timestep
 
      dtm = grid%dt
-     IF ( rk_order == 1 ) THEN
+     IF ( rk_order == 1 ) THEN   
 
        write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
        CALL wrf_error_fatal( wrf_err_message )
@@ -550,7 +549,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      END IF
 
 !  Ensure that polar meridional velocity is zero
-     IF (config_flags%polar) THEN
+     IF (config_flags%polar) THEN 
        !$OMP PARALLEL DO   &
        !$OMP PRIVATE ( ij )
        DO ij = 1 , grid%num_tiles
@@ -570,7 +569,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
        !$OMP END PARALLEL DO
      END IF
 !
-!  Time level t is in the *_2 variable in the first part
+!  Time level t is in the *_2 variable in the first part 
 !  of the step, and in the *_1 variable after the predictor.
 !  the latest predicted values are stored in the *_2 variables.
 !
@@ -605,15 +604,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #ifdef DM_PARALLEL
 !-----------------------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the
-!         fact that we are carrying the uncoupled variables
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
 !         as state variables in the mass coordinate model, as
 !         opposed to the coupled variables as in the height
 !         coordinate model.
 !
 !                           * * * * *
 !         *        * * *    * * * * *
-!       * + *      * + *    * * + * *
+!       * + *      * + *    * * + * * 
 !         *        * * *    * * * * *
 !                           * * * * *
 !
@@ -636,7 +635,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_A.inc"
 #endif
 
-! set boundary conditions on variables
+! set boundary conditions on variables 
 ! from big_step_prep for use in big_step_proc
 
 #ifdef DM_PARALLEL
@@ -651,7 +650,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
        CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
 
-       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      &
+       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      & 
                               grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p,        &
                               ids, ide, jds, jde, kds, kde,      &
                               ims, ime, jms, jme, kms, kme,      &
@@ -674,7 +673,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               grid%j_start(ij), grid%j_end(ij),        &
                               k_start, k_end                )
 
-       IF (config_flags%polar) THEN
+       IF (config_flags%polar) THEN 
 
 !-------------------------------------------------------
 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
@@ -686,14 +685,14 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               grid%i_start(ij), grid%i_end(ij), &
                               grid%j_start(ij), grid%j_end(ij), &
                               k_start, k_end                   )
-
+ 
          CALL pole_point_bc ( grid%v_2,                      &
                               ids, ide, jds, jde, kds, kde,     &
                               ims, ime, jms, jme, kms, kme,     &
                               grid%i_start(ij), grid%i_end(ij), &
                               grid%j_start(ij), grid%j_end(ij), &
                               k_start, k_end                   )
-
+ 
 !-------------------------------------------------------
 ! end lat-lon grid pole-point (v) specification
 !-------------------------------------------------------
@@ -778,8 +777,8 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              , cu_act_flag , hol , th_phy       &
                              , pi_phy , p_phy , grid%t_phy      &
                              , dz8w , p8w , t8w                 &
-                             , nba_mij, num_nba_mij             & !JDM
-                             , nba_rij, num_nba_rij             & !JDM
+                             , nba_mij, num_nba_mij             & !JDM 
+                             , nba_rij, num_nba_rij             & !JDM  
                              , ids, ide, jds, jde, kds, kde     &
                              , ims, ime, jms, jme, kms, kme     &
                              , ips, ipe, jps, jpe, kps, kpe     &
@@ -840,7 +839,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
            grid%max_vert_cfl = max_vert_cfl_tmp(ij)
          ENDIF
        END DO
-
+     
        IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
          grid%max_cfl_val = grid%max_horiz_cfl
        ENDIF
@@ -854,7 +853,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP PRIVATE ( ij )
      DO ij = 1 , grid%num_tiles
 
-       IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN
+       IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN 
 
          CALL relax_bdy_dry ( config_flags,                                &
                               grid%u_save, grid%v_save, ph_save, grid%t_save,             &
@@ -899,7 +898,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                             grid%j_start(ij), grid%j_end(ij),                &
                             k_start, k_end                                  )
 
-       IF( config_flags%specified .or. config_flags%nested ) THEN
+       IF( config_flags%specified .or. config_flags%nested ) THEN 
          CALL spec_bdy_dry ( config_flags,                                    &
                              grid%ru_tend, grid%rv_tend, ph_tend, t_tend,               &
                              rw_tend, mu_tend,                                &
@@ -927,11 +926,11 @@ SUBROUTINE solve_em ( grid , config_flags  &
        ENDIF
 
 !---------------------------------------------------------------------------------------------
-! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS
+! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS 
 ! pattern passed in for perturbing the specified boundry conditions.  If peturb_bdy=2, user
 ! must provide pattern.  mu_2, mub, msf* also passed in for coupling needed for tendecies.
 !---------------------------------------------------------------------------------------------
-       IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN
+       IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN 
          CALL spec_bdy_dry_perturb ( config_flags,                                 &
                              grid%ru_tend, grid%rv_tend, t_tend,                   &
                              grid%mu_2, grid%mub, grid%c1h, grid%c2h,              &
@@ -945,7 +944,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                &
                              grid%j_start(ij), grid%j_end(ij),                &
                              k_start, k_end                                  )
-
+     
        ENDIF
 
        IF( config_flags%specified .and. config_flags%perturb_bdy==2 ) THEN
@@ -962,7 +961,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                &
                              grid%j_start(ij), grid%j_end(ij),                &
                              k_start, k_end                                  )
-
+  
        ENDIF
 
      END DO
@@ -973,15 +972,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 ! (3) Small (acoustic,sound) steps.
 !
-!    Several acoustic steps are taken each RK pass.  A small step
-!    sequence begins with calculating perturbation variables
-!    and coupling them to the column dry-air-mass mu
+!    Several acoustic steps are taken each RK pass.  A small step 
+!    sequence begins with calculating perturbation variables 
+!    and coupling them to the column dry-air-mass mu 
 !    (call to small_step_prep).  This is followed by computing
 !    coefficients for the vertically implicit part of the
-!    small timestep (call to calc_coef_w).
+!    small timestep (call to calc_coef_w).  
 !
 !    The small steps are taken
-!    in the named loop "small_steps:".  In the small_steps loop, first
+!    in the named loop "small_steps:".  In the small_steps loop, first 
 !    the horizontal momentum (u and v) are advanced (call to advance_uv),
 !    next mu and theta are advanced (call to advance_mu_t) followed by
 !    advancing w and the geopotential (call to advance_w).  Diagnostic
@@ -1001,7 +1000,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
     ! Calculate coefficients for the vertically implicit acoustic/gravity wave
     ! integration.  We only need calculate these for the first pass through -
     ! the predictor step.  They are reused as is for the corrector step.
-    ! For third-order RK, we need to recompute these after the first
+    ! For third-order RK, we need to recompute these after the first 
     ! predictor because we may have changed the small timestep -> grid%dts.
 
        CALL wrf_debug ( 200 , ' call small_step_prep ' )
@@ -1025,7 +1024,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                        &
                              grid%j_start(ij), grid%j_end(ij),                        &
                              k_start    , k_end                                       )
-
+ 
        CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
                         grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
                         grid%mu_2, grid%muts,                       &
@@ -1062,15 +1061,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #ifdef DM_PARALLEL
 !-----------------------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the
-!         fact that we are carrying the uncoupled variables
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
 !         as state variables in the mass coordinate model, as
 !         opposed to the coupled variables as in the height
 !         coordinate model.
 !
 !                              * * * * *
 !            *        * * *    * * * * *
-!          * + *      * + *    * * + * *
+!          * + *      * + *    * * + * * 
 !            *        * * *    * * * * *
 !                              * * * * *
 !
@@ -1185,7 +1184,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_END(set_phys_bc2_tim)
      small_steps : DO iteration = 1 , number_of_small_timesteps
 
-       ! Boundary condition time (or communication time).
+       ! Boundary condition time (or communication time).  
 #ifdef DM_PARALLEL
 #      include "PERIOD_BDY_EM_B.inc"
 #endif
@@ -1363,7 +1362,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
 
          grid%muts = grid%mut + grid%mu_2  ! reset muts using filtered mu_2
-
+ 
        END IF
 
 !-----------------------------------------------------------
@@ -1644,7 +1643,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
        CALL wrf_debug ( 200 , ' call rk_small_finish' )
 
-      ! change time-perturbation variables back to
+      ! change time-perturbation variables back to 
       ! full perturbation variables.
       ! first get updated mu at u and v points
 
@@ -1661,7 +1660,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
        CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1,     &
                                grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1,    &
                                grid%mu_2, grid%mu_1,                       &
-                               grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs,  &
+                               grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs,  & 
                                grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
                                grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
                                grid%u_save, grid%v_save, w_save,           &
@@ -1716,7 +1715,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                  ips, ipe, jps, jpe,                &
                                  grid%i_start(ij), grid%i_end(ij),  &
                                  grid%j_start(ij), grid%j_end(ij) )
-
+ 
        END IF
 
 BENCH_END(small_step_finish_tim)
@@ -1725,7 +1724,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP END PARALLEL DO
 
 !-----------------------------------------------------------
-!  polar filter for full dynamics variables and time-averaged mass fluxes
+!  polar filter for full dynamics variables and time-averaged mass fluxes 
 !-----------------------------------------------------------
 
      IF (config_flags%polar) THEN
@@ -1758,7 +1757,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      END IF
 
 !-----------------------------------------------------------
-!  end polar filter for full dynamics variables and time-averaged mass fluxes
+!  end polar filter for full dynamics variables and time-averaged mass fluxes 
 !-----------------------------------------------------------
 
 !-----------------------------------------------------------------------
@@ -1869,7 +1868,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #else
          WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
          CALL wrf_error_fatal(TRIM(wrf_err_message))
-#endif
+#endif   
   endif
 #endif
 
@@ -1951,7 +1950,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                         grid%i_start(ij), grid%i_end(ij),                &
                                         grid%j_start(ij), grid%j_end(ij),                &
                                         k_start    , k_end                              )
-             END DO
+             END DO 
            ENDIF
          END DO
          !$OMP END PARALLEL DO
@@ -2013,7 +2012,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                         grid%i_start(ij), grid%i_end(ij),                &
                                         grid%j_start(ij), grid%j_end(ij),                &
                                         k_start    , k_end                              )
-             END DO
+             END DO 
            ENDIF
          END DO
          !$OMP END PARALLEL DO
@@ -2083,11 +2082,11 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!          * * * * *
-!          * * * * *
-!          * * + * *
-!          * * * * *
-!          * * * * *
+!          * * * * *            
+!          * * * * *            
+!          * * + * *            
+!          * * * * *            
+!          * * * * *            
 !
 ! ru_m         x
 ! rv_m         x
@@ -2108,7 +2107,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !    For the moist and chem variables, each one is advanced
 !    individually, using named loops "moist_variable_loop:"
 !    and "chem_variable_loop:".  Each RK substep begins by
-!    calculating the advective tendency, and, for the first RK step,
+!    calculating the advective tendency, and, for the first RK step, 
 !    3D mixing (calling rk_scalar_tend) followed by an update
 !    of the scalar (calling rk_update_scalar).
 !

@@ -2132,7 +2131,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                tenddec = .false.
 
 BENCH_START(rk_scalar_tend_tim)
-               CALL rk_scalar_tend (  im, im, config_flags, tenddec,         &
+               CALL rk_scalar_tend (  im, im, config_flags, tenddec,         & 
                            rk_step, dt_rk,                                   &
                            grid%ru_m, grid%rv_m, grid%ww_m,                  &
                            grid%muts, grid%mub, grid%mu_1,                   &
@@ -2141,10 +2140,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
                            moist_old(ims,kms,jms,im),                        &
                            moist(ims,kms,jms,im),                            &
                            moist_tend(ims,kms,jms,im),                       &
-                           advect_tend,h_tendency,z_tendency,grid%rqvften,   &
+                           advect_tend,h_tendency,z_tendency,grid%rqvften,   & 
                            grid%qv_base, .true., grid%fnm, grid%fnp,         &
                            grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
-                           grid%msfvy, grid%msftx,grid%msfty,                &
+                           grid%msfvy, grid%msftx,grid%msfty,                & 
                            grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
                            grid%kvdif, grid%xkhh,                            &
                            grid%diff_6th_opt, grid%diff_6th_factor,          &
@@ -2160,7 +2159,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
                IF( rk_step == 1 .AND. config_flags%use_q_diabatic == 1 )THEN
                IF( im.eq.p_qv .or. im.eq.p_qc )THEN
-                   CALL q_diabatic_add  ( im, im,            &
+                   CALL q_diabatic_add  ( im, im,            & 
                            dt_rk, grid%mut,                  &
                            grid%c1h, grid%c2h,               &
                            grid%qv_diabatic,                 &
@@ -2177,10 +2176,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_END(rk_scalar_tend_tim)
 
 BENCH_START(rlx_bdy_scalar_tim)
-               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
+               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN 
                  IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
                     ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
-                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            &
+                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            & 
                                      moist(ims,kms,jms,im),  grid%mut,         &
                                      grid%c1h, grid%c2h,                       &
                                      moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
@@ -2230,12 +2229,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                scalar_2=moist(ims,kms,jms,im),                         &
                                sc_tend=moist_tend(ims,kms,jms,im),                     &
                                advect_tend=advect_tend,                                &
-                               h_tendency=h_tendency, z_tendency=z_tendency,           &
+                               h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                msftx=grid%msftx,msfty=grid%msfty,                      &
                                c1=grid%c1h, c2=grid%c2h,                               &
                                mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                               config_flags=config_flags, tenddec=tenddec,             &
+                               config_flags=config_flags, tenddec=tenddec,             & 
                                ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2243,7 +2242,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                kts=k_start    , kte=k_end                              )
                IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
                IF( im.eq.p_qv .or. im.eq.p_qc )THEN
-                   CALL q_diabatic_subtr( im, im,            &
+                   CALL q_diabatic_subtr( im, im,            & 
                            dt_rk,                            &
                            grid%qv_diabatic,                 &
                            grid%qc_diabatic,                 &
@@ -2300,7 +2299,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
            CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
            tenddec = .false.
-           CALL rk_scalar_tend ( 1, 1, config_flags, tenddec,                      &
+           CALL rk_scalar_tend ( 1, 1, config_flags, tenddec,                      & 
                             rk_step, dt_rk,                                        &
                             grid%ru_m, grid%rv_m, grid%ww_m,                       &
                             grid%muts, grid%mub, grid%mu_1,                        &
@@ -2309,7 +2308,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                             grid%tke_1,                                            &
                             grid%tke_2,                                            &
                             tke_tend(ims,kms,jms),                                 &
-                            advect_tend,h_tendency,z_tendency,grid%rqvften,        &
+                            advect_tend,h_tendency,z_tendency,grid%rqvften,        & 
                             grid%qv_base, .false., grid%fnm, grid%fnp,             &
                             grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,     &
                             grid%msfvy, grid%msftx,grid%msfty,                     &
@@ -2340,12 +2339,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_2=grid%tke_2,                                    &
                                   sc_tend=tke_tend(ims,kms,jms),                          &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             &
+                                  config_flags=config_flags, tenddec=tenddec,             & 
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2392,7 +2391,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
              tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
                         ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
-             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                &
+             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                & 
                               rk_step, dt_rk,                                    &
                               grid%ru_m, grid%rv_m, grid%ww_m,                   &
                               grid%muts, grid%mub, grid%mu_1,                    &
@@ -2401,7 +2400,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               chem_old(ims,kms,jms,ic),                          &
                               chem(ims,kms,jms,ic),                              &
                               chem_tend(ims,kms,jms,ic),                         &
-                              advect_tend,h_tendency,z_tendency,grid%rqvften,    &
+                              advect_tend,h_tendency,z_tendency,grid%rqvften,    & 
                               grid%qv_base, .false., grid%fnm, grid%fnp,         &
                               grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                               grid%msfvy, grid%msftx,grid%msfty,                 &
@@ -2421,7 +2420,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! Currently, chemistry species with specified boundaries (i.e. the mother
 ! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
 !
            IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
              IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
@@ -2480,12 +2479,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   advh_t=advh_ct(ims,kms,jms,adv_ct_indices(ic)),         &
                                   advz_t=advz_ct(ims,kms,jms,adv_ct_indices(ic)),         &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             &
+                                  config_flags=config_flags, tenddec=tenddec,             & 
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2553,7 +2552,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
              CALL wrf_debug ( 15 , ' call rk_scalar_tend in tracer_tile_loop_1' )
              tenddec = .false.
-             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                &
+             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                & 
                               rk_step, dt_rk,                                    &
                               grid%ru_m, grid%rv_m, grid%ww_m,                   &
                               grid%muts, grid%mub, grid%mu_1,                    &
@@ -2562,7 +2561,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               tracer_old(ims,kms,jms,ic),                        &
                               tracer(ims,kms,jms,ic),                            &
                               tracer_tend(ims,kms,jms,ic),                       &
-                              advect_tend,h_tendency,z_tendency,grid%rqvften,    &
+                              advect_tend,h_tendency,z_tendency,grid%rqvften,    & 
                               grid%qv_base, .false., grid%fnm, grid%fnp,         &
                               grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                               grid%msfvy, grid%msftx,grid%msfty,                 &
@@ -2582,7 +2581,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! Currently, chemistry species with specified boundaries (i.e. the mother
 ! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
 !
            IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
              IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
@@ -2631,15 +2630,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_1=tracer_old(ims,kms,jms,ic),                    &
                                   scalar_2=tracer(ims,kms,jms,ic),                        &
                                   sc_tend=tracer_tend(ims,kms,jms,ic),                    &
-!                                 advh_t=advh_t(ims,kms,jms,1),                           &
-!                                 advz_t=advz_t(ims,kms,jms,1),                           &
+!                                 advh_t=advh_t(ims,kms,jms,1),                           & 
+!                                 advz_t=advz_t(ims,kms,jms,1),                           & 
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             &
+                                  config_flags=config_flags, tenddec=tenddec,             & 
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2694,7 +2693,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
            CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
            tenddec = .false.
-           CALL rk_scalar_tend ( is, is, config_flags, tenddec,                   &
+           CALL rk_scalar_tend ( is, is, config_flags, tenddec,                   & 
                                  rk_step, dt_rk,                                  &
                                  grid%ru_m, grid%rv_m, grid%ww_m,                 &
                                  grid%muts, grid%mub, grid%mu_1,                  &
@@ -2703,7 +2702,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                  scalar_old(ims,kms,jms,is),                      &
                                  scalar(ims,kms,jms,is),                          &
                                  scalar_tend(ims,kms,jms,is),                     &
-                                 advect_tend,h_tendency,z_tendency,grid%rqvften,  &
+                                 advect_tend,h_tendency,z_tendency,grid%rqvften,  & 
                                  grid%qv_base, .false., grid%fnm, grid%fnp,       &
                                  grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                                  grid%msfvy, grid%msftx,grid%msfty,               &
@@ -2772,15 +2771,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_1=scalar_old(ims,kms,jms,is),                    &
                                   scalar_2=scalar(ims,kms,jms,is),                        &
                                   sc_tend=scalar_tend(ims,kms,jms,is),                    &
-!                                 advh_t=advh_t(ims,kms,jms,1),                           &
-!                                 advz_t=advz_t(ims,kms,jms,1),                           &
+!                                 advh_t=advh_t(ims,kms,jms,1),                           & 
+!                                 advz_t=advz_t(ims,kms,jms,1),                           & 
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             &
+                                  config_flags=config_flags, tenddec=tenddec,             & 
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2810,7 +2809,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !     B = config_flags%use_aero_icbc
 !     C = config_glags%have_bcs_scalar
 
-! Test| A  | B  | C | ( A AND NOT B ) OR ( NOT A AND NOT C )
+! Test| A  | B  | C | ( A AND NOT B ) OR ( NOT A AND NOT C ) 
 ! ----+----+----+---+-----------------------------------------------
 !  1  | T  | T  | T |                 F = DO NOT CALL flow_dep_bdy
 !  2  | T  | T  | F |                 F = DO NOT CALL flow_dep_bdy
@@ -2824,7 +2823,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
 !  If this is     the special friendly fields AND are to use the aero icbc, then NO calls to flow dep: tests 1 and 2
 !  If this is     the special friendly fields AND do not use the aero icbc, then    call     flow dep: tests 3 and 4
-!  If this is not the special friendly fields AND:
+!  If this is not the special friendly fields AND: 
 !           If we        have bcs for scalars, do not call flow dep: tests 5 and 7
 !           If we do not have bcs for scalars,        call flow dep: tests 6 and 8
 
@@ -2883,7 +2882,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !  rk3 substep polar filter for scalars (moist,chem,scalar)
 !-----------------------------------------------------------
 
-       IF (config_flags%polar) THEN
+       IF (config_flags%polar) THEN 
          IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter moist ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_m
@@ -2929,7 +2928,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              END IF
            END DO
          END IF
-
+   
          IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter chem ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_c
@@ -3020,7 +3019,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              END IF
            END DO
          END IF
-
+   
          IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter scalar ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_s
@@ -3075,7 +3074,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !-----------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!  here's where we need a wide comm stencil - these are the
+!  here's where we need a wide comm stencil - these are the 
 !  uncoupled variables so are used for high order calc in
 !  advection and mixong routines.
 !
@@ -3117,7 +3116,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_D2_3.inc"
        ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
 #    include "HALO_EM_D2_5.inc"
-       ELSE
+       ELSE 
          WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
          CALL wrf_error_fatal(TRIM(wrf_err_message))
        ENDIF
@@ -3162,7 +3161,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
          IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
 
            moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
-
+  
              CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags,   &
                                      ids, ide, jds, jde, kds, kde,             &
                                      ims, ime, jms, jme, kms, kme,             &
@@ -3406,7 +3405,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       IF (CurrTime .lt. temp_time + dtInterval) THEN
          WRITE ( message , FMT = '("solve_em: initializing avgflx at time ",A," on domain ",I3)' ) &
               & TRIM(message2), grid%id
-         CALL wrf_message(trim(message))
+         CALL wrf_message(trim(message)) 
          grid%avgflx_count = 0
 !tile-loop for zero_avgflx
    !$OMP PARALLEL DO   &
@@ -3442,7 +3441,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
               &   grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
               &   grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
          CALL wrf_debug(200,'In solve_em, after upd_avgflx call')
-
+         
       ENDDO
       grid%avgflx_count = grid%avgflx_count + 1
    ENDIF
@@ -3501,10 +3500,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 ! (5) time-split physics.
 !
-!     Microphysics are the only time  split physics in the WRF model
+!     Microphysics are the only time  split physics in the WRF model 
 !     at this time.  Split-physics begins with the calculation of
 !     needed diagnostic quantities (pressure, temperature, etc.)
-!     followed by a call to the microphysics driver,
+!     followed by a call to the microphysics driver, 
 !     and finishes with a clean-up, storing off of a diabatic tendency
 !     from the moist physics, and a re-calulation of the  diagnostic
 !     quantities pressure and density.
@@ -3573,7 +3572,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_START(micro_driver_tim)
 
 !
-! WRFU_AlarmIsRinging always returned false, so using an alternate  method to find out if it is time
+! WRFU_AlarmIsRinging always returned false, so using an alternate  method to find out if it is time 
 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
 !
 !     diagflag = .false.
@@ -3606,18 +3605,9 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,vmi3d=grid%vmi3d                                          & ! for P3
       &        ,di3d=grid%di3d                                            & ! for P3
       &        ,rhopo3d=grid%rhopo3d                                      & ! for P3
-      &        ,phii3d=grid%phii3d                                        & ! for Jensen ISHMAEL
       &        ,vmi3d_2=grid%vmi3d_2                                      & ! for P3
       &        ,di3d_2=grid%di3d_2                                        & ! for P3
       &        ,rhopo3d_2=grid%rhopo3d_2                                  & ! for P3
-      &        ,phii3d_2=grid%phii3d_2                                    & ! for Jensen ISHMAEL
-      &        ,vmi3d_3=grid%vmi3d_3                                      & ! for Jensen ISHMAEL
-      &        ,di3d_3=grid%di3d_3                                        & ! for Jensen ISHMAEL
-      &        ,rhopo3d_3=grid%rhopo3d_3                                  & ! for Jensen ISHMAEL
-      &        ,phii3d_3=grid%phii3d_3                                    & ! for Jensen ISHMAEL
-      &        ,itype=grid%itype                                          & ! for Jensen ISHMAEL
-      &        ,itype_2=grid%itype_2                                      & ! for Jensen ISHMAEL
-      &        ,itype_3=grid%itype_3                                      & ! for Jensen ISHMAEL
       &        ,WARM_RAIN=grid%warm_rain                                  &
       &        ,T8W=t8w                                                   &
       &        ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
@@ -3710,18 +3700,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        , QNID_CURR=scalar(ims,kms,jms,P_QNID), F_QNID=F_QNID          &
       &        , QIR_CURR=scalar(ims,kms,jms,P_QIR), F_QIR=F_QIR          & ! for P3
       &        , QIB_CURR=scalar(ims,kms,jms,P_QIB), F_QIB=F_QIB          & ! for P3
-      &        , QVOLI_CURR=scalar(ims,kms,jms,P_QVOLI), F_QVOLI=F_QVOLI  & ! for Jensen ISHMAEL
-      &        , QAOLI_CURR=scalar(ims,kms,jms,P_QAOLI), F_QAOLI=F_QAOLI  & ! for Jensen ISHMAEL
       &        , QI2_CURR=moist(ims,kms,jms,P_QI2), F_QI2=F_QI2           & ! for P3
       &        , QNI2_CURR=scalar(ims,kms,jms,P_QNI2), F_QNI2=F_QNI2      & ! for P3
       &        , QIR2_CURR=scalar(ims,kms,jms,P_QIR2), F_QIR2=F_QIR2      & ! for P3
       &        , QIB2_CURR=scalar(ims,kms,jms,P_QIB2), F_QIB2=F_QIB2      & ! for P3
-      &        , QVOLI2_CURR=scalar(ims,kms,jms,P_QVOLI2), F_QVOLI2=F_QVOLI2  & ! for Jensen ISHMAEL
-      &        , QAOLI2_CURR=scalar(ims,kms,jms,P_QAOLI2), F_QAOLI2=F_QAOLI2  & ! for Jensen ISHMAEL
-      &        , QI3_CURR=moist(ims,kms,jms,P_QI3), F_QI3=F_QI3           & ! for Jensen ISHMAEL
-      &        , QNI3_CURR=scalar(ims,kms,jms,P_QNI3), F_QNI3=F_QNI3      & ! for Jensen ISHMAEL
-      &        , QVOLI3_CURR=scalar(ims,kms,jms,P_QVOLI3), F_QVOLI3=F_QVOLI3  & ! for Jensen ISHMAEL
-      &        , QAOLI3_CURR=scalar(ims,kms,jms,P_QAOLI3), F_QAOLI3=F_QAOLI3  & ! for Jensen ISHMAEL
 !       &        , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR          & ! for milbrandt3mom
 !       &        , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI          & ! "
 !       &        , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS          & ! "
@@ -3734,36 +3716,6 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        , qicuten=grid%rqicuten, qccuten=grid%rqccuten             &
       &        , HAIL=config_flags%gsfcgce_hail                           & ! for gsfcgce
       &        , ICE2=config_flags%gsfcgce_2ice                           & ! for gsfcgce
-      &        , PHYS_TOT=grid%phys_tot                                   & ! for gsfcgce
-      &        , PHYSC=grid%physc                                         & ! for gsfcgce
-      &        , PHYSE=grid%physe                                         & ! for gsfcgce
-      &        , PHYSD=grid%physd                                         & ! for gsfcgce
-      &        , PHYSS=grid%physs                                         & ! for gsfcgce
-      &        , PHYSM=grid%physm                                         & ! for gsfcgce
-      &        , PHYSF=grid%physf                                         & ! for gsfcgce
-
-      &        , ACPHYS_TOT=grid%acphys_tot                               & ! for gsfcgce
-      &        , ACPHYSC=grid%acphysc                                     & ! for gsfcgce
-      &        , ACPHYSE=grid%acphyse                                     & ! for gsfcgce
-      &        , ACPHYSD=grid%acphysd                                     & ! for gsfcgce
-      &        , ACPHYSS=grid%acphyss                                     & ! for gsfcgce
-      &        , ACPHYSM=grid%acphysm                                     & ! for gsfcgce
-      &        , ACPHYSF=grid%acphysf                                     & ! for gsfcgce
-
-      &        , RE_CLOUD_GSFC=grid%re_cloud_gsfc                         & ! for gsfcgce
-      &        , RE_RAIN_GSFC=grid%re_rain_gsfc                           & ! for gsfcgce
-      &        , RE_ICE_GSFC=grid%re_ice_gsfc                             & ! for gsfcgce
-      &        , RE_SNOW_GSFC=grid%re_snow_gsfc                           & ! for gsfcgce
-      &        , RE_GRAUPEL_GSFC=grid%re_graupel_gsfc                     & ! for gsfcgce
-      &        , RE_HAIL_GSFC=grid%re_hail_gsfc                           & ! for gsfcgce
-      &        , PRECR3D=grid%precr3d, PRECI3D=grid%preci3d, PRECS3D=grid%precs3d  &
-      &        , PRECG3D=grid%precg3d, PRECH3D=grid%prech3d               &
-#if ( WRF_CHEM == 1)
-      &        , GSFCGCE_GOCART_COUPLING=config_flags%gsfcgce_gocart_coupling &
-      &        , ICN_DIAG=grid%icn_diag                                   & ! inline gocart
-      &        , NC_DIAG=grid%nc_diag                                     & ! inline gocart
-#endif
-!NUWRF JJS 20110525 ^^^^^
 !     &        , ccntype=config_flags%milbrandt_ccntype                   & ! for milbrandt (2mom)
 ! YLIN
 ! RI_CURR INPUT
@@ -3783,6 +3735,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        , QIC_EFFR_CURR=scalar(ims,kms,jms,P_QIC_EFFR), F_QIC_EFFR=F_QIC_EFFR          & ! for SBM
       &        , QIP_EFFR_CURR=scalar(ims,kms,jms,P_QIP_EFFR), F_QIP_EFFR=F_QIP_EFFR          & ! for SBM
       &        , QID_EFFR_CURR=scalar(ims,kms,jms,P_QID_EFFR), F_QID_EFFR=F_QID_EFFR          & ! for SBM
+      &        ,sbmradar=sbmradar,num_sbmradar=num_sbmradar                &  ! for SBM
       &        ,kext_ql=grid%kext_ql                                       &
       &        ,kext_qs=grid%kext_qs                                       &
       &        ,kext_qg=grid%kext_qg                                       &
@@ -3799,7 +3752,6 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,height=grid%height                                         &
       &        ,tempc=grid%tempc                                         &
       &        ,ccn_conc=grid%ccn_conc                                   & ! RAS
-      &        ,sbmradar=sbmradar,num_sbmradar=num_sbmradar              & ! for SBM
       &        ,aerocu=aerocu                                            &
       &        ,aercu_fct=config_flags%aercu_fct                         &
       &        ,aercu_opt=config_flags%aercu_opt                         &
@@ -3809,7 +3761,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,CCN4_GS=grid%CCN4_GS,CCN5_GS=grid%CCN5_GS,CCN6_GS=grid%CCN6_GS &
       &        ,CCN7_GS=grid%CCN7_GS,NR_CU=grid%NR_CU,QR_CU=grid%QR_CU,NS_CU=grid%NS_CU &
       &        ,QS_CU=grid%QS_CU,CU_UAF=grid%CU_UAF,mskf_refl_10cm=grid%mskf_refl_10cm)
-
+                                                                          
 BENCH_END(micro_driver_tim)
 
 #if 0
@@ -3949,7 +3901,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                     ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
                     ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
          END IF
-
+ 
          CALL pxft ( grid=grid                                                 &
                   ,lineno=__LINE__                                             &
                   ,flag_uv            = 0                                      &
@@ -3974,7 +3926,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                   ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
                   ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
                   ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-
+ 
          IF ( config_flags%coupled_filtering ) THEN
            CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)      &
                     ,MU=grid%mu_2 , MUB=grid%mub                                 &
@@ -4204,7 +4156,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
    ! b.c. routine for data within patch.
 
-   ! we need to do both time levels of
+   ! we need to do both time levels of 
    ! data because the time filter only works in the physical solution space.
 
    ! First, do patch communications for boundary conditions (periodicity)
@@ -4212,13 +4164,13 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !-----------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!  here's where we need a wide comm stencil - these are the
+!  here's where we need a wide comm stencil - these are the 
 !  uncoupled variables so are used for high order calc in
 !  advection and mixong routines.
 !
 !                              * * * * *
 !            *        * * *    * * * * *
-!          * + *      * + *    * * + * *
+!          * + *      * + *    * * + * * 
 !            *        * * *    * * * * *
 !                              * * * * *
 !
@@ -4251,7 +4203,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_D3_3.inc"
    ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
 #    include "HALO_EM_D3_5.inc"
-   ELSE
+   ELSE 
       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
       CALL wrf_error_fatal(TRIM(wrf_err_message))
    ENDIF
@@ -4352,7 +4304,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
 !  this code forces boundary values to specified values to avoid drift
 
-   IF( config_flags%specified .or. config_flags%nested ) THEN
+   IF( config_flags%specified .or. config_flags%nested ) THEN 
    !$OMP PARALLEL DO   &
    !$OMP PRIVATE ( ij )
    tile_bc_loop_3: DO ij = 1 , grid%num_tiles
@@ -4573,7 +4525,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
   CALL after_all_rk_steps ( grid, config_flags,                  &
                             moist, chem, tracer, scalar,         &
-                            th_phy, pi_phy, p_phy, rho_phy,      &
+                            th_phy, pi_phy, p_phy, rho_phy,      &   
                             p8w, t8w, dz8w,                      &
                             REAL(curr_secs,8), curr_secs2,       &
                             diag_flag,                           &
@@ -4669,7 +4621,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    CALL wrf_debug ( 200 , ' call end of solve_em' )
 
 !  Are we about to read SST input from the wrflowinput file?  That data is saved
-!  for use in fractional merging of external/coupled SST and input SST.
+!  for use in fractional merging of external/coupled SST and input SST. 
    IF ( coupler_on )   grid%just_read_auxinput4 = Is_alarm_tstep(grid%domain_clock, grid%alarms(AUXINPUT4_ALARM))
 
 !  Are we about to read the lateral boundary file?  This is a domain one action only.

From af4b5d3ce7b2b58da9549518eef1a7e791aa14dd Mon Sep 17 00:00:00 2001
From: Jacob Shpund 
Date: Fri, 5 Apr 2019 13:37:12 +0300
Subject: [PATCH 05/29] Restoring from previous commit

---
 dyn_em/solve_em.F | 286 +++++++++++++++++++++++++++-------------------
 1 file changed, 167 insertions(+), 119 deletions(-)

diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F
index 9992928eee..7866c67502 100644
--- a/dyn_em/solve_em.F
+++ b/dyn_em/solve_em.F
@@ -117,17 +117,17 @@ SUBROUTINE solve_em ( grid , config_flags  &
    LOGICAL                         :: specified_bdy, channel_bdy
 
    REAL                            :: t_new, time_duration_of_lbcs
-   
+
    ! Changes in tendency at this timestep
    real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: h_tendency, &
                                                                                    z_tendency
-                                                                                   
+
    ! Whether advection should produce decoupled horizontal and vertical advective tendency outputs
    LOGICAL                        :: tenddec
-   
+
    ! Flag for producing diagnostic fields (e.g., radar reflectivity)
    LOGICAL                        :: diag_flag
-   
+
 #if (WRF_CHEM == 1)
    ! Index cross-referencing array for tendency accumulation
    INTEGER, DIMENSION( num_chem ) :: adv_ct_indices
@@ -142,7 +142,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! time.  Potential problem on stack-limited architectures: increases
 ! amount of data on program stack by making these automatic arrays.
 
-   INTEGER :: rc 
+   INTEGER :: rc
    INTEGER :: number_of_small_timesteps, rk_step
    INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2    ! for prints/plots only
    INTEGER :: idum1, idum2, dynamics_option
@@ -189,27 +189,27 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 !
 ! solve_em is the main driver for advancing a grid a single timestep.
-! It is a mediation-layer routine -> DM and SM calls are made where 
-! needed for parallel processing.  
+! It is a mediation-layer routine -> DM and SM calls are made where
+! needed for parallel processing.
 !
 ! solve_em can integrate the equations using 3 time-integration methods
-!      
+!
 !    - 3rd order Runge-Kutta time integration (recommended)
-!      
+!
 !    - 2nd order Runge-Kutta time integration
-!      
+!
 ! The main sections of solve_em are
-!     
+!
 ! (1) Runge-Kutta (RK) loop
-!     
+!
 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
 !     model state variables during the first RK sub-step (loop)
-!     
+!
 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
-!     
+!
 ! (4) scalar advance for moist and chem scalar variables (and TKE)
 !     within the RK sub-steps.
-!     
+!
 ! (5) time-split physics (after the RK step), currently this includes
 !     only microphyics
 !
@@ -234,7 +234,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              ipsx, ipex, jpsx, jpex, kpsx, kpex,    &
                              imsy, imey, jmsy, jmey, kmsy, kmey,    &
                              ipsy, ipey, jpsy, jpey, kpsy, kpey )
- 
+
    CALL get_ijk_from_subgrid (  grid ,                   &
                              sids, side, sjds, sjde, skds, skde,    &
                              sims, sime, sjms, sjme, skms, skme,    &
@@ -299,6 +299,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    if ( Is_alarm_tstep(grid%domain_clock, grid%alarms(HISTORY_ALARM)) ) then
       diag_flag = .true.
    endif
+   IF (config_flags%nwp_diagnostics == 1) diag_flag = .true.
 
    grid%itimestep = grid%itimestep + 1
    grid%dtbc = grid%dtbc + grid%dt
@@ -392,7 +393,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    dts = grid%dt/float(num_sound_steps)
 
    IF (config_flags%use_adaptive_time_step) THEN
-  
+
      CALL get_wrf_debug_level( debug_level )
      IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
 #ifdef DM_PARALLEL
@@ -455,7 +456,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP END PARALLEL DO
 
      !  Now that we have initialized the moist_old values with P_Qv for
-     !  computing a moist t_tendf after rk_step part2, fill in the halo 
+     !  computing a moist t_tendf after rk_step part2, fill in the halo
      !  and period boundaries.
 
 #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
@@ -508,7 +509,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    !  each part of the timestep
 
      dtm = grid%dt
-     IF ( rk_order == 1 ) THEN   
+     IF ( rk_order == 1 ) THEN
 
        write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
        CALL wrf_error_fatal( wrf_err_message )
@@ -549,7 +550,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      END IF
 
 !  Ensure that polar meridional velocity is zero
-     IF (config_flags%polar) THEN 
+     IF (config_flags%polar) THEN
        !$OMP PARALLEL DO   &
        !$OMP PRIVATE ( ij )
        DO ij = 1 , grid%num_tiles
@@ -569,7 +570,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
        !$OMP END PARALLEL DO
      END IF
 !
-!  Time level t is in the *_2 variable in the first part 
+!  Time level t is in the *_2 variable in the first part
 !  of the step, and in the *_1 variable after the predictor.
 !  the latest predicted values are stored in the *_2 variables.
 !
@@ -604,15 +605,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #ifdef DM_PARALLEL
 !-----------------------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the 
-!         fact that we are carrying the uncoupled variables 
+!  Note:  the small size of this halo exchange reflects the
+!         fact that we are carrying the uncoupled variables
 !         as state variables in the mass coordinate model, as
 !         opposed to the coupled variables as in the height
 !         coordinate model.
 !
 !                           * * * * *
 !         *        * * *    * * * * *
-!       * + *      * + *    * * + * * 
+!       * + *      * + *    * * + * *
 !         *        * * *    * * * * *
 !                           * * * * *
 !
@@ -635,7 +636,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_A.inc"
 #endif
 
-! set boundary conditions on variables 
+! set boundary conditions on variables
 ! from big_step_prep for use in big_step_proc
 
 #ifdef DM_PARALLEL
@@ -650,7 +651,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
        CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
 
-       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      & 
+       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      &
                               grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p,        &
                               ids, ide, jds, jde, kds, kde,      &
                               ims, ime, jms, jme, kms, kme,      &
@@ -673,7 +674,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               grid%j_start(ij), grid%j_end(ij),        &
                               k_start, k_end                )
 
-       IF (config_flags%polar) THEN 
+       IF (config_flags%polar) THEN
 
 !-------------------------------------------------------
 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
@@ -685,14 +686,14 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               grid%i_start(ij), grid%i_end(ij), &
                               grid%j_start(ij), grid%j_end(ij), &
                               k_start, k_end                   )
- 
+
          CALL pole_point_bc ( grid%v_2,                      &
                               ids, ide, jds, jde, kds, kde,     &
                               ims, ime, jms, jme, kms, kme,     &
                               grid%i_start(ij), grid%i_end(ij), &
                               grid%j_start(ij), grid%j_end(ij), &
                               k_start, k_end                   )
- 
+
 !-------------------------------------------------------
 ! end lat-lon grid pole-point (v) specification
 !-------------------------------------------------------
@@ -777,8 +778,8 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              , cu_act_flag , hol , th_phy       &
                              , pi_phy , p_phy , grid%t_phy      &
                              , dz8w , p8w , t8w                 &
-                             , nba_mij, num_nba_mij             & !JDM 
-                             , nba_rij, num_nba_rij             & !JDM  
+                             , nba_mij, num_nba_mij             & !JDM
+                             , nba_rij, num_nba_rij             & !JDM
                              , ids, ide, jds, jde, kds, kde     &
                              , ims, ime, jms, jme, kms, kme     &
                              , ips, ipe, jps, jpe, kps, kpe     &
@@ -839,7 +840,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
            grid%max_vert_cfl = max_vert_cfl_tmp(ij)
          ENDIF
        END DO
-     
+
        IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
          grid%max_cfl_val = grid%max_horiz_cfl
        ENDIF
@@ -853,7 +854,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP PRIVATE ( ij )
      DO ij = 1 , grid%num_tiles
 
-       IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN 
+       IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN
 
          CALL relax_bdy_dry ( config_flags,                                &
                               grid%u_save, grid%v_save, ph_save, grid%t_save,             &
@@ -898,7 +899,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                             grid%j_start(ij), grid%j_end(ij),                &
                             k_start, k_end                                  )
 
-       IF( config_flags%specified .or. config_flags%nested ) THEN 
+       IF( config_flags%specified .or. config_flags%nested ) THEN
          CALL spec_bdy_dry ( config_flags,                                    &
                              grid%ru_tend, grid%rv_tend, ph_tend, t_tend,               &
                              rw_tend, mu_tend,                                &
@@ -926,11 +927,11 @@ SUBROUTINE solve_em ( grid , config_flags  &
        ENDIF
 
 !---------------------------------------------------------------------------------------------
-! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS 
+! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS
 ! pattern passed in for perturbing the specified boundry conditions.  If peturb_bdy=2, user
 ! must provide pattern.  mu_2, mub, msf* also passed in for coupling needed for tendecies.
 !---------------------------------------------------------------------------------------------
-       IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN 
+       IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN
          CALL spec_bdy_dry_perturb ( config_flags,                                 &
                              grid%ru_tend, grid%rv_tend, t_tend,                   &
                              grid%mu_2, grid%mub, grid%c1h, grid%c2h,              &
@@ -944,7 +945,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                &
                              grid%j_start(ij), grid%j_end(ij),                &
                              k_start, k_end                                  )
-     
+
        ENDIF
 
        IF( config_flags%specified .and. config_flags%perturb_bdy==2 ) THEN
@@ -961,7 +962,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                &
                              grid%j_start(ij), grid%j_end(ij),                &
                              k_start, k_end                                  )
-  
+
        ENDIF
 
      END DO
@@ -972,15 +973,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 ! (3) Small (acoustic,sound) steps.
 !
-!    Several acoustic steps are taken each RK pass.  A small step 
-!    sequence begins with calculating perturbation variables 
-!    and coupling them to the column dry-air-mass mu 
+!    Several acoustic steps are taken each RK pass.  A small step
+!    sequence begins with calculating perturbation variables
+!    and coupling them to the column dry-air-mass mu
 !    (call to small_step_prep).  This is followed by computing
 !    coefficients for the vertically implicit part of the
-!    small timestep (call to calc_coef_w).  
+!    small timestep (call to calc_coef_w).
 !
 !    The small steps are taken
-!    in the named loop "small_steps:".  In the small_steps loop, first 
+!    in the named loop "small_steps:".  In the small_steps loop, first
 !    the horizontal momentum (u and v) are advanced (call to advance_uv),
 !    next mu and theta are advanced (call to advance_mu_t) followed by
 !    advancing w and the geopotential (call to advance_w).  Diagnostic
@@ -1000,7 +1001,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
     ! Calculate coefficients for the vertically implicit acoustic/gravity wave
     ! integration.  We only need calculate these for the first pass through -
     ! the predictor step.  They are reused as is for the corrector step.
-    ! For third-order RK, we need to recompute these after the first 
+    ! For third-order RK, we need to recompute these after the first
     ! predictor because we may have changed the small timestep -> grid%dts.
 
        CALL wrf_debug ( 200 , ' call small_step_prep ' )
@@ -1024,7 +1025,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                        &
                              grid%j_start(ij), grid%j_end(ij),                        &
                              k_start    , k_end                                       )
- 
+
        CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
                         grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
                         grid%mu_2, grid%muts,                       &
@@ -1061,15 +1062,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #ifdef DM_PARALLEL
 !-----------------------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the 
-!         fact that we are carrying the uncoupled variables 
+!  Note:  the small size of this halo exchange reflects the
+!         fact that we are carrying the uncoupled variables
 !         as state variables in the mass coordinate model, as
 !         opposed to the coupled variables as in the height
 !         coordinate model.
 !
 !                              * * * * *
 !            *        * * *    * * * * *
-!          * + *      * + *    * * + * * 
+!          * + *      * + *    * * + * *
 !            *        * * *    * * * * *
 !                              * * * * *
 !
@@ -1184,7 +1185,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_END(set_phys_bc2_tim)
      small_steps : DO iteration = 1 , number_of_small_timesteps
 
-       ! Boundary condition time (or communication time).  
+       ! Boundary condition time (or communication time).
 #ifdef DM_PARALLEL
 #      include "PERIOD_BDY_EM_B.inc"
 #endif
@@ -1362,7 +1363,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
 
          grid%muts = grid%mut + grid%mu_2  ! reset muts using filtered mu_2
- 
+
        END IF
 
 !-----------------------------------------------------------
@@ -1643,7 +1644,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
        CALL wrf_debug ( 200 , ' call rk_small_finish' )
 
-      ! change time-perturbation variables back to 
+      ! change time-perturbation variables back to
       ! full perturbation variables.
       ! first get updated mu at u and v points
 
@@ -1660,7 +1661,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
        CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1,     &
                                grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1,    &
                                grid%mu_2, grid%mu_1,                       &
-                               grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs,  & 
+                               grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs,  &
                                grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
                                grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
                                grid%u_save, grid%v_save, w_save,           &
@@ -1715,7 +1716,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                  ips, ipe, jps, jpe,                &
                                  grid%i_start(ij), grid%i_end(ij),  &
                                  grid%j_start(ij), grid%j_end(ij) )
- 
+
        END IF
 
 BENCH_END(small_step_finish_tim)
@@ -1724,7 +1725,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP END PARALLEL DO
 
 !-----------------------------------------------------------
-!  polar filter for full dynamics variables and time-averaged mass fluxes 
+!  polar filter for full dynamics variables and time-averaged mass fluxes
 !-----------------------------------------------------------
 
      IF (config_flags%polar) THEN
@@ -1757,7 +1758,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      END IF
 
 !-----------------------------------------------------------
-!  end polar filter for full dynamics variables and time-averaged mass fluxes 
+!  end polar filter for full dynamics variables and time-averaged mass fluxes
 !-----------------------------------------------------------
 
 !-----------------------------------------------------------------------
@@ -1868,7 +1869,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #else
          WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
          CALL wrf_error_fatal(TRIM(wrf_err_message))
-#endif   
+#endif
   endif
 #endif
 
@@ -1950,7 +1951,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                         grid%i_start(ij), grid%i_end(ij),                &
                                         grid%j_start(ij), grid%j_end(ij),                &
                                         k_start    , k_end                              )
-             END DO 
+             END DO
            ENDIF
          END DO
          !$OMP END PARALLEL DO
@@ -2012,7 +2013,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                         grid%i_start(ij), grid%i_end(ij),                &
                                         grid%j_start(ij), grid%j_end(ij),                &
                                         k_start    , k_end                              )
-             END DO 
+             END DO
            ENDIF
          END DO
          !$OMP END PARALLEL DO
@@ -2082,11 +2083,11 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!          * * * * *            
-!          * * * * *            
-!          * * + * *            
-!          * * * * *            
-!          * * * * *            
+!          * * * * *
+!          * * * * *
+!          * * + * *
+!          * * * * *
+!          * * * * *
 !
 ! ru_m         x
 ! rv_m         x
@@ -2107,7 +2108,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !    For the moist and chem variables, each one is advanced
 !    individually, using named loops "moist_variable_loop:"
 !    and "chem_variable_loop:".  Each RK substep begins by
-!    calculating the advective tendency, and, for the first RK step, 
+!    calculating the advective tendency, and, for the first RK step,
 !    3D mixing (calling rk_scalar_tend) followed by an update
 !    of the scalar (calling rk_update_scalar).
 !

@@ -2131,7 +2132,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                tenddec = .false.
 
 BENCH_START(rk_scalar_tend_tim)
-               CALL rk_scalar_tend (  im, im, config_flags, tenddec,         & 
+               CALL rk_scalar_tend (  im, im, config_flags, tenddec,         &
                            rk_step, dt_rk,                                   &
                            grid%ru_m, grid%rv_m, grid%ww_m,                  &
                            grid%muts, grid%mub, grid%mu_1,                   &
@@ -2140,10 +2141,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
                            moist_old(ims,kms,jms,im),                        &
                            moist(ims,kms,jms,im),                            &
                            moist_tend(ims,kms,jms,im),                       &
-                           advect_tend,h_tendency,z_tendency,grid%rqvften,   & 
+                           advect_tend,h_tendency,z_tendency,grid%rqvften,   &
                            grid%qv_base, .true., grid%fnm, grid%fnp,         &
                            grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
-                           grid%msfvy, grid%msftx,grid%msfty,                & 
+                           grid%msfvy, grid%msftx,grid%msfty,                &
                            grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
                            grid%kvdif, grid%xkhh,                            &
                            grid%diff_6th_opt, grid%diff_6th_factor,          &
@@ -2159,7 +2160,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
                IF( rk_step == 1 .AND. config_flags%use_q_diabatic == 1 )THEN
                IF( im.eq.p_qv .or. im.eq.p_qc )THEN
-                   CALL q_diabatic_add  ( im, im,            & 
+                   CALL q_diabatic_add  ( im, im,            &
                            dt_rk, grid%mut,                  &
                            grid%c1h, grid%c2h,               &
                            grid%qv_diabatic,                 &
@@ -2176,10 +2177,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_END(rk_scalar_tend_tim)
 
 BENCH_START(rlx_bdy_scalar_tim)
-               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN 
+               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
                  IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
                     ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
-                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            & 
+                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            &
                                      moist(ims,kms,jms,im),  grid%mut,         &
                                      grid%c1h, grid%c2h,                       &
                                      moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
@@ -2229,12 +2230,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                scalar_2=moist(ims,kms,jms,im),                         &
                                sc_tend=moist_tend(ims,kms,jms,im),                     &
                                advect_tend=advect_tend,                                &
-                               h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                               h_tendency=h_tendency, z_tendency=z_tendency,           &
                                msftx=grid%msftx,msfty=grid%msfty,                      &
                                c1=grid%c1h, c2=grid%c2h,                               &
                                mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                               config_flags=config_flags, tenddec=tenddec,             & 
+                               config_flags=config_flags, tenddec=tenddec,             &
                                ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2242,7 +2243,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                kts=k_start    , kte=k_end                              )
                IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
                IF( im.eq.p_qv .or. im.eq.p_qc )THEN
-                   CALL q_diabatic_subtr( im, im,            & 
+                   CALL q_diabatic_subtr( im, im,            &
                            dt_rk,                            &
                            grid%qv_diabatic,                 &
                            grid%qc_diabatic,                 &
@@ -2299,7 +2300,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
            CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
            tenddec = .false.
-           CALL rk_scalar_tend ( 1, 1, config_flags, tenddec,                      & 
+           CALL rk_scalar_tend ( 1, 1, config_flags, tenddec,                      &
                             rk_step, dt_rk,                                        &
                             grid%ru_m, grid%rv_m, grid%ww_m,                       &
                             grid%muts, grid%mub, grid%mu_1,                        &
@@ -2308,7 +2309,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                             grid%tke_1,                                            &
                             grid%tke_2,                                            &
                             tke_tend(ims,kms,jms),                                 &
-                            advect_tend,h_tendency,z_tendency,grid%rqvften,        & 
+                            advect_tend,h_tendency,z_tendency,grid%rqvften,        &
                             grid%qv_base, .false., grid%fnm, grid%fnp,             &
                             grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,     &
                             grid%msfvy, grid%msftx,grid%msfty,                     &
@@ -2339,12 +2340,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_2=grid%tke_2,                                    &
                                   sc_tend=tke_tend(ims,kms,jms),                          &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             & 
+                                  config_flags=config_flags, tenddec=tenddec,             &
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2391,7 +2392,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
              tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
                         ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
-             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                & 
+             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                &
                               rk_step, dt_rk,                                    &
                               grid%ru_m, grid%rv_m, grid%ww_m,                   &
                               grid%muts, grid%mub, grid%mu_1,                    &
@@ -2400,7 +2401,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               chem_old(ims,kms,jms,ic),                          &
                               chem(ims,kms,jms,ic),                              &
                               chem_tend(ims,kms,jms,ic),                         &
-                              advect_tend,h_tendency,z_tendency,grid%rqvften,    & 
+                              advect_tend,h_tendency,z_tendency,grid%rqvften,    &
                               grid%qv_base, .false., grid%fnm, grid%fnp,         &
                               grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                               grid%msfvy, grid%msftx,grid%msfty,                 &
@@ -2420,7 +2421,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! Currently, chemistry species with specified boundaries (i.e. the mother
 ! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
 !
            IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
              IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
@@ -2479,12 +2480,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   advh_t=advh_ct(ims,kms,jms,adv_ct_indices(ic)),         &
                                   advz_t=advz_ct(ims,kms,jms,adv_ct_indices(ic)),         &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             & 
+                                  config_flags=config_flags, tenddec=tenddec,             &
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2552,7 +2553,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
              CALL wrf_debug ( 15 , ' call rk_scalar_tend in tracer_tile_loop_1' )
              tenddec = .false.
-             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                & 
+             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                &
                               rk_step, dt_rk,                                    &
                               grid%ru_m, grid%rv_m, grid%ww_m,                   &
                               grid%muts, grid%mub, grid%mu_1,                    &
@@ -2561,7 +2562,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               tracer_old(ims,kms,jms,ic),                        &
                               tracer(ims,kms,jms,ic),                            &
                               tracer_tend(ims,kms,jms,ic),                       &
-                              advect_tend,h_tendency,z_tendency,grid%rqvften,    & 
+                              advect_tend,h_tendency,z_tendency,grid%rqvften,    &
                               grid%qv_base, .false., grid%fnm, grid%fnp,         &
                               grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                               grid%msfvy, grid%msftx,grid%msfty,                 &
@@ -2581,7 +2582,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! Currently, chemistry species with specified boundaries (i.e. the mother
 ! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
 !
            IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
              IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
@@ -2630,15 +2631,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_1=tracer_old(ims,kms,jms,ic),                    &
                                   scalar_2=tracer(ims,kms,jms,ic),                        &
                                   sc_tend=tracer_tend(ims,kms,jms,ic),                    &
-!                                 advh_t=advh_t(ims,kms,jms,1),                           & 
-!                                 advz_t=advz_t(ims,kms,jms,1),                           & 
+!                                 advh_t=advh_t(ims,kms,jms,1),                           &
+!                                 advz_t=advz_t(ims,kms,jms,1),                           &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             & 
+                                  config_flags=config_flags, tenddec=tenddec,             &
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2693,7 +2694,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
            CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
            tenddec = .false.
-           CALL rk_scalar_tend ( is, is, config_flags, tenddec,                   & 
+           CALL rk_scalar_tend ( is, is, config_flags, tenddec,                   &
                                  rk_step, dt_rk,                                  &
                                  grid%ru_m, grid%rv_m, grid%ww_m,                 &
                                  grid%muts, grid%mub, grid%mu_1,                  &
@@ -2702,7 +2703,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                  scalar_old(ims,kms,jms,is),                      &
                                  scalar(ims,kms,jms,is),                          &
                                  scalar_tend(ims,kms,jms,is),                     &
-                                 advect_tend,h_tendency,z_tendency,grid%rqvften,  & 
+                                 advect_tend,h_tendency,z_tendency,grid%rqvften,  &
                                  grid%qv_base, .false., grid%fnm, grid%fnp,       &
                                  grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                                  grid%msfvy, grid%msftx,grid%msfty,               &
@@ -2771,15 +2772,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_1=scalar_old(ims,kms,jms,is),                    &
                                   scalar_2=scalar(ims,kms,jms,is),                        &
                                   sc_tend=scalar_tend(ims,kms,jms,is),                    &
-!                                 advh_t=advh_t(ims,kms,jms,1),                           & 
-!                                 advz_t=advz_t(ims,kms,jms,1),                           & 
+!                                 advh_t=advh_t(ims,kms,jms,1),                           &
+!                                 advz_t=advz_t(ims,kms,jms,1),                           &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             & 
+                                  config_flags=config_flags, tenddec=tenddec,             &
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2809,7 +2810,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !     B = config_flags%use_aero_icbc
 !     C = config_glags%have_bcs_scalar
 
-! Test| A  | B  | C | ( A AND NOT B ) OR ( NOT A AND NOT C ) 
+! Test| A  | B  | C | ( A AND NOT B ) OR ( NOT A AND NOT C )
 ! ----+----+----+---+-----------------------------------------------
 !  1  | T  | T  | T |                 F = DO NOT CALL flow_dep_bdy
 !  2  | T  | T  | F |                 F = DO NOT CALL flow_dep_bdy
@@ -2823,7 +2824,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
 !  If this is     the special friendly fields AND are to use the aero icbc, then NO calls to flow dep: tests 1 and 2
 !  If this is     the special friendly fields AND do not use the aero icbc, then    call     flow dep: tests 3 and 4
-!  If this is not the special friendly fields AND: 
+!  If this is not the special friendly fields AND:
 !           If we        have bcs for scalars, do not call flow dep: tests 5 and 7
 !           If we do not have bcs for scalars,        call flow dep: tests 6 and 8
 
@@ -2882,7 +2883,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !  rk3 substep polar filter for scalars (moist,chem,scalar)
 !-----------------------------------------------------------
 
-       IF (config_flags%polar) THEN 
+       IF (config_flags%polar) THEN
          IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter moist ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_m
@@ -2928,7 +2929,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              END IF
            END DO
          END IF
-   
+
          IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter chem ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_c
@@ -3019,7 +3020,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              END IF
            END DO
          END IF
-   
+
          IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter scalar ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_s
@@ -3074,7 +3075,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !-----------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!  here's where we need a wide comm stencil - these are the 
+!  here's where we need a wide comm stencil - these are the
 !  uncoupled variables so are used for high order calc in
 !  advection and mixong routines.
 !
@@ -3116,7 +3117,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_D2_3.inc"
        ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
 #    include "HALO_EM_D2_5.inc"
-       ELSE 
+       ELSE
          WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
          CALL wrf_error_fatal(TRIM(wrf_err_message))
        ENDIF
@@ -3161,7 +3162,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
          IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
 
            moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
-  
+
              CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags,   &
                                      ids, ide, jds, jde, kds, kde,             &
                                      ims, ime, jms, jme, kms, kme,             &
@@ -3405,7 +3406,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       IF (CurrTime .lt. temp_time + dtInterval) THEN
          WRITE ( message , FMT = '("solve_em: initializing avgflx at time ",A," on domain ",I3)' ) &
               & TRIM(message2), grid%id
-         CALL wrf_message(trim(message)) 
+         CALL wrf_message(trim(message))
          grid%avgflx_count = 0
 !tile-loop for zero_avgflx
    !$OMP PARALLEL DO   &
@@ -3441,7 +3442,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
               &   grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
               &   grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
          CALL wrf_debug(200,'In solve_em, after upd_avgflx call')
-         
+
       ENDDO
       grid%avgflx_count = grid%avgflx_count + 1
    ENDIF
@@ -3500,10 +3501,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 ! (5) time-split physics.
 !
-!     Microphysics are the only time  split physics in the WRF model 
+!     Microphysics are the only time  split physics in the WRF model
 !     at this time.  Split-physics begins with the calculation of
 !     needed diagnostic quantities (pressure, temperature, etc.)
-!     followed by a call to the microphysics driver, 
+!     followed by a call to the microphysics driver,
 !     and finishes with a clean-up, storing off of a diabatic tendency
 !     from the moist physics, and a re-calulation of the  diagnostic
 !     quantities pressure and density.
@@ -3572,7 +3573,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_START(micro_driver_tim)
 
 !
-! WRFU_AlarmIsRinging always returned false, so using an alternate  method to find out if it is time 
+! WRFU_AlarmIsRinging always returned false, so using an alternate  method to find out if it is time
 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
 !
 !     diagflag = .false.
@@ -3605,9 +3606,18 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,vmi3d=grid%vmi3d                                          & ! for P3
       &        ,di3d=grid%di3d                                            & ! for P3
       &        ,rhopo3d=grid%rhopo3d                                      & ! for P3
+      &        ,phii3d=grid%phii3d                                        & ! for Jensen ISHMAEL
       &        ,vmi3d_2=grid%vmi3d_2                                      & ! for P3
       &        ,di3d_2=grid%di3d_2                                        & ! for P3
       &        ,rhopo3d_2=grid%rhopo3d_2                                  & ! for P3
+      &        ,phii3d_2=grid%phii3d_2                                    & ! for Jensen ISHMAEL
+      &        ,vmi3d_3=grid%vmi3d_3                                      & ! for Jensen ISHMAEL
+      &        ,di3d_3=grid%di3d_3                                        & ! for Jensen ISHMAEL
+      &        ,rhopo3d_3=grid%rhopo3d_3                                  & ! for Jensen ISHMAEL
+      &        ,phii3d_3=grid%phii3d_3                                    & ! for Jensen ISHMAEL
+      &        ,itype=grid%itype                                          & ! for Jensen ISHMAEL
+      &        ,itype_2=grid%itype_2                                      & ! for Jensen ISHMAEL
+      &        ,itype_3=grid%itype_3                                      & ! for Jensen ISHMAEL
       &        ,WARM_RAIN=grid%warm_rain                                  &
       &        ,T8W=t8w                                                   &
       &        ,CLDFRA=grid%cldfra, EXCH_H=grid%exch_h &
@@ -3700,10 +3710,18 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        , QNID_CURR=scalar(ims,kms,jms,P_QNID), F_QNID=F_QNID          &
       &        , QIR_CURR=scalar(ims,kms,jms,P_QIR), F_QIR=F_QIR          & ! for P3
       &        , QIB_CURR=scalar(ims,kms,jms,P_QIB), F_QIB=F_QIB          & ! for P3
+      &        , QVOLI_CURR=scalar(ims,kms,jms,P_QVOLI), F_QVOLI=F_QVOLI  & ! for Jensen ISHMAEL
+      &        , QAOLI_CURR=scalar(ims,kms,jms,P_QAOLI), F_QAOLI=F_QAOLI  & ! for Jensen ISHMAEL
       &        , QI2_CURR=moist(ims,kms,jms,P_QI2), F_QI2=F_QI2           & ! for P3
       &        , QNI2_CURR=scalar(ims,kms,jms,P_QNI2), F_QNI2=F_QNI2      & ! for P3
       &        , QIR2_CURR=scalar(ims,kms,jms,P_QIR2), F_QIR2=F_QIR2      & ! for P3
       &        , QIB2_CURR=scalar(ims,kms,jms,P_QIB2), F_QIB2=F_QIB2      & ! for P3
+      &        , QVOLI2_CURR=scalar(ims,kms,jms,P_QVOLI2), F_QVOLI2=F_QVOLI2  & ! for Jensen ISHMAEL
+      &        , QAOLI2_CURR=scalar(ims,kms,jms,P_QAOLI2), F_QAOLI2=F_QAOLI2  & ! for Jensen ISHMAEL
+      &        , QI3_CURR=moist(ims,kms,jms,P_QI3), F_QI3=F_QI3           & ! for Jensen ISHMAEL
+      &        , QNI3_CURR=scalar(ims,kms,jms,P_QNI3), F_QNI3=F_QNI3      & ! for Jensen ISHMAEL
+      &        , QVOLI3_CURR=scalar(ims,kms,jms,P_QVOLI3), F_QVOLI3=F_QVOLI3  & ! for Jensen ISHMAEL
+      &        , QAOLI3_CURR=scalar(ims,kms,jms,P_QAOLI3), F_QAOLI3=F_QAOLI3  & ! for Jensen ISHMAEL
 !       &        , QZR_CURR=scalar(ims,kms,jms,P_QZR), F_QZR=F_QZR          & ! for milbrandt3mom
 !       &        , QZI_CURR=scalar(ims,kms,jms,P_QZI), F_QZI=F_QZI          & ! "
 !       &        , QZS_CURR=scalar(ims,kms,jms,P_QZS), F_QZS=F_QZS          & ! "
@@ -3716,6 +3734,36 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        , qicuten=grid%rqicuten, qccuten=grid%rqccuten             &
       &        , HAIL=config_flags%gsfcgce_hail                           & ! for gsfcgce
       &        , ICE2=config_flags%gsfcgce_2ice                           & ! for gsfcgce
+      &        , PHYS_TOT=grid%phys_tot                                   & ! for gsfcgce
+      &        , PHYSC=grid%physc                                         & ! for gsfcgce
+      &        , PHYSE=grid%physe                                         & ! for gsfcgce
+      &        , PHYSD=grid%physd                                         & ! for gsfcgce
+      &        , PHYSS=grid%physs                                         & ! for gsfcgce
+      &        , PHYSM=grid%physm                                         & ! for gsfcgce
+      &        , PHYSF=grid%physf                                         & ! for gsfcgce
+
+      &        , ACPHYS_TOT=grid%acphys_tot                               & ! for gsfcgce
+      &        , ACPHYSC=grid%acphysc                                     & ! for gsfcgce
+      &        , ACPHYSE=grid%acphyse                                     & ! for gsfcgce
+      &        , ACPHYSD=grid%acphysd                                     & ! for gsfcgce
+      &        , ACPHYSS=grid%acphyss                                     & ! for gsfcgce
+      &        , ACPHYSM=grid%acphysm                                     & ! for gsfcgce
+      &        , ACPHYSF=grid%acphysf                                     & ! for gsfcgce
+
+      &        , RE_CLOUD_GSFC=grid%re_cloud_gsfc                         & ! for gsfcgce
+      &        , RE_RAIN_GSFC=grid%re_rain_gsfc                           & ! for gsfcgce
+      &        , RE_ICE_GSFC=grid%re_ice_gsfc                             & ! for gsfcgce
+      &        , RE_SNOW_GSFC=grid%re_snow_gsfc                           & ! for gsfcgce
+      &        , RE_GRAUPEL_GSFC=grid%re_graupel_gsfc                     & ! for gsfcgce
+      &        , RE_HAIL_GSFC=grid%re_hail_gsfc                           & ! for gsfcgce
+      &        , PRECR3D=grid%precr3d, PRECI3D=grid%preci3d, PRECS3D=grid%precs3d  &
+      &        , PRECG3D=grid%precg3d, PRECH3D=grid%prech3d               &
+#if ( WRF_CHEM == 1)
+      &        , GSFCGCE_GOCART_COUPLING=config_flags%gsfcgce_gocart_coupling &
+      &        , ICN_DIAG=grid%icn_diag                                   & ! inline gocart
+      &        , NC_DIAG=grid%nc_diag                                     & ! inline gocart
+#endif
+!NUWRF JJS 20110525 ^^^^^
 !     &        , ccntype=config_flags%milbrandt_ccntype                   & ! for milbrandt (2mom)
 ! YLIN
 ! RI_CURR INPUT
@@ -3735,7 +3783,6 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        , QIC_EFFR_CURR=scalar(ims,kms,jms,P_QIC_EFFR), F_QIC_EFFR=F_QIC_EFFR          & ! for SBM
       &        , QIP_EFFR_CURR=scalar(ims,kms,jms,P_QIP_EFFR), F_QIP_EFFR=F_QIP_EFFR          & ! for SBM
       &        , QID_EFFR_CURR=scalar(ims,kms,jms,P_QID_EFFR), F_QID_EFFR=F_QID_EFFR          & ! for SBM
-      &        ,sbmradar=sbmradar,num_sbmradar=num_sbmradar                &  ! for SBM
       &        ,kext_ql=grid%kext_ql                                       &
       &        ,kext_qs=grid%kext_qs                                       &
       &        ,kext_qg=grid%kext_qg                                       &
@@ -3752,6 +3799,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,height=grid%height                                         &
       &        ,tempc=grid%tempc                                         &
       &        ,ccn_conc=grid%ccn_conc                                   & ! RAS
+      &        ,sbmradar=sbmradar,num_sbmradar=num_sbmradar              & ! for SBM
       &        ,aerocu=aerocu                                            &
       &        ,aercu_fct=config_flags%aercu_fct                         &
       &        ,aercu_opt=config_flags%aercu_opt                         &
@@ -3761,7 +3809,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,CCN4_GS=grid%CCN4_GS,CCN5_GS=grid%CCN5_GS,CCN6_GS=grid%CCN6_GS &
       &        ,CCN7_GS=grid%CCN7_GS,NR_CU=grid%NR_CU,QR_CU=grid%QR_CU,NS_CU=grid%NS_CU &
       &        ,QS_CU=grid%QS_CU,CU_UAF=grid%CU_UAF,mskf_refl_10cm=grid%mskf_refl_10cm)
-                                                                          
+
 BENCH_END(micro_driver_tim)
 
 #if 0
@@ -3901,7 +3949,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                     ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
                     ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
          END IF
- 
+
          CALL pxft ( grid=grid                                                 &
                   ,lineno=__LINE__                                             &
                   ,flag_uv            = 0                                      &
@@ -3926,7 +3974,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                   ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
                   ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
                   ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
- 
+
          IF ( config_flags%coupled_filtering ) THEN
            CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)      &
                     ,MU=grid%mu_2 , MUB=grid%mub                                 &
@@ -4156,7 +4204,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
    ! b.c. routine for data within patch.
 
-   ! we need to do both time levels of 
+   ! we need to do both time levels of
    ! data because the time filter only works in the physical solution space.
 
    ! First, do patch communications for boundary conditions (periodicity)
@@ -4164,13 +4212,13 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !-----------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!  here's where we need a wide comm stencil - these are the 
+!  here's where we need a wide comm stencil - these are the
 !  uncoupled variables so are used for high order calc in
 !  advection and mixong routines.
 !
 !                              * * * * *
 !            *        * * *    * * * * *
-!          * + *      * + *    * * + * * 
+!          * + *      * + *    * * + * *
 !            *        * * *    * * * * *
 !                              * * * * *
 !
@@ -4203,7 +4251,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_D3_3.inc"
    ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
 #    include "HALO_EM_D3_5.inc"
-   ELSE 
+   ELSE
       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
       CALL wrf_error_fatal(TRIM(wrf_err_message))
    ENDIF
@@ -4304,7 +4352,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
 !  this code forces boundary values to specified values to avoid drift
 
-   IF( config_flags%specified .or. config_flags%nested ) THEN 
+   IF( config_flags%specified .or. config_flags%nested ) THEN
    !$OMP PARALLEL DO   &
    !$OMP PRIVATE ( ij )
    tile_bc_loop_3: DO ij = 1 , grid%num_tiles
@@ -4525,7 +4573,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
   CALL after_all_rk_steps ( grid, config_flags,                  &
                             moist, chem, tracer, scalar,         &
-                            th_phy, pi_phy, p_phy, rho_phy,      &   
+                            th_phy, pi_phy, p_phy, rho_phy,      &
                             p8w, t8w, dz8w,                      &
                             REAL(curr_secs,8), curr_secs2,       &
                             diag_flag,                           &
@@ -4621,7 +4669,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    CALL wrf_debug ( 200 , ' call end of solve_em' )
 
 !  Are we about to read SST input from the wrflowinput file?  That data is saved
-!  for use in fractional merging of external/coupled SST and input SST. 
+!  for use in fractional merging of external/coupled SST and input SST.
    IF ( coupler_on )   grid%just_read_auxinput4 = Is_alarm_tstep(grid%domain_clock, grid%alarms(AUXINPUT4_ALARM))
 
 !  Are we about to read the lateral boundary file?  This is a domain one action only.

From 2b3c02c5e3b45efc80ad10d256ce982c7b32314a Mon Sep 17 00:00:00 2001
From: JS-WRF-SBM <48547778+JS-WRF-SBM@users.noreply.github.com>
Date: Fri, 5 Apr 2019 13:44:27 +0300
Subject: [PATCH 06/29] Update Makefile

---
 phys/Makefile | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/phys/Makefile b/phys/Makefile
index 60d6ee4488..e4b3be4988 100644
--- a/phys/Makefile
+++ b/phys/Makefile
@@ -36,7 +36,7 @@ MODULES = \
 	module_bl_shinhong.o \
 	module_bl_mrf.o \
 	module_bl_gfs.o \
-	module_bl_gfsedmf.o \
+        module_bl_gfsedmf.o \
 	module_bl_myjpbl.o \
 	module_bl_qnsepbl.o \
 	module_bl_acm.o \

From 056d9542d1228d69b65d54cf30bb02542ba7b359 Mon Sep 17 00:00:00 2001
From: JS-WRF-SBM <48547778+JS-WRF-SBM@users.noreply.github.com>
Date: Fri, 5 Apr 2019 13:48:49 +0300
Subject: [PATCH 07/29] Update Makefile

---
 phys/Makefile | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/phys/Makefile b/phys/Makefile
index e4b3be4988..43a589d89b 100644
--- a/phys/Makefile
+++ b/phys/Makefile
@@ -95,9 +95,9 @@ MODULES = \
 	module_mp_gsfcgce_3ice_nuwrf.o \
 	module_mp_gsfcgce_4ice_nuwrf.o \
 	module_mp_morr_two_moment.o \
-	module_mp_p3.o \
-	module_mp_jensen_ishmael.o \
-	module_mp_morr_two_moment_aero.o \
+        module_mp_p3.o \
+        module_mp_jensen_ishmael.o \
+        module_mp_morr_two_moment_aero.o \
 	module_mp_milbrandt2mom.o \
 	module_mp_nssl_2mom.o \
 	module_mp_wdm5.o \
@@ -108,18 +108,18 @@ MODULES = \
 	module_ra_clWRF_support.o  \
 	module_ra_gsfcsw.o \
 	module_ra_goddard.o \
-	module_ra_effective_radius.o \
+        module_ra_effective_radius.o \
 	module_ra_rrtm.o  \
 	module_ra_rrtmg_lw.o  \
 	module_ra_rrtmg_sw.o  \
 	module_ra_rrtmg_lwf.o  \
 	module_ra_rrtmg_swf.o  \
-	module_ra_rrtmg_lwk.o  \
-	module_ra_rrtmg_swk.o  \
-	module_ra_cam_support.o \
+        module_ra_rrtmg_lwk.o  \
+        module_ra_rrtmg_swk.o  \
+        module_ra_cam_support.o \
 	module_ra_cam.o \
 	module_ra_gfdleta.o \
-	module_ra_flg.o \
+        module_ra_flg.o \
 	module_ra_HWRF.o \
 	module_ra_hs.o  \
 	module_ra_aerosol.o  \
@@ -132,19 +132,19 @@ MODULES = \
 	module_sf_noahdrv.o  \
 	module_sf_noahlsm.o  \
 	module_sf_clm.o  \
-	module_sf_ssib.o  \
+        module_sf_ssib.o  \
 	module_sf_noah_seaice.o \
 	module_sf_noah_seaice_drv.o \
 	module_sf_noahlsm_glacial_only.o \
-	module_sf_noahmp_groundwater.o \
+        module_sf_noahmp_groundwater.o \
 	module_sf_gecros.o \
 	module_sf_noahmpdrv.o \
 	module_sf_noahmplsm.o \
 	module_sf_noahmp_glacier.o \
-	module_sf_urban.o  \
-	module_sf_bep.o  \
-	module_sf_bep_bem.o \
-	module_sf_bem.o \
+        module_sf_urban.o  \
+        module_sf_bep.o  \
+        module_sf_bep_bem.o \
+        module_sf_bem.o \
 	module_sf_pxlsm.o \
 	module_sf_pxlsm_data.o \
 	module_sf_ruclsm.o \
@@ -172,7 +172,7 @@ MODULES = \
 	module_progtm.o \
 	module_pbl_driver.o \
 	module_data_gocart_dust.o \
-	module_dust_emis.o \
+        module_dust_emis.o \
 	module_cumulus_driver.o \
 	module_shallowcu_driver.o \
 	module_microphysics_driver.o \
@@ -187,7 +187,7 @@ MODULES = \
 	module_fdda_psufddagd.o \
 	module_fdda_spnudging.o \
 	module_fddagd_driver.o  \
-	module_fddaobs_rtfdda.o \
+        module_fddaobs_rtfdda.o \
 	module_fddaobs_driver.o \
 	module_wind_fitch.o \
 	module_sf_lake.o \
@@ -212,13 +212,13 @@ DIAGNOSTIC_MODULES_EM = \
 	module_diag_pld.o \
 	module_diag_zld.o \
 	module_diag_trad_fields.o
-
+ 
 DIAGNOSTIC_MODULES_NMM = \
 	module_diag_refl.o
 
 OBJS    =
 
-NMM_MODULES =
+NMM_MODULES = 
 
 LIBTARGET    =  physics
 TARGETDIR    =  ./

From 8036f294ee200ff57500aad6a0ff8590b0ed0ff0 Mon Sep 17 00:00:00 2001
From: JS-WRF-SBM <48547778+JS-WRF-SBM@users.noreply.github.com>
Date: Fri, 5 Apr 2019 13:50:37 +0300
Subject: [PATCH 08/29] Update Makefile

---
 phys/Makefile | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/phys/Makefile b/phys/Makefile
index 43a589d89b..258bc4748e 100644
--- a/phys/Makefile
+++ b/phys/Makefile
@@ -117,7 +117,7 @@ MODULES = \
         module_ra_rrtmg_lwk.o  \
         module_ra_rrtmg_swk.o  \
         module_ra_cam_support.o \
-	module_ra_cam.o \
+        module_ra_cam.o \
 	module_ra_gfdleta.o \
         module_ra_flg.o \
 	module_ra_HWRF.o \
@@ -137,7 +137,7 @@ MODULES = \
 	module_sf_noah_seaice_drv.o \
 	module_sf_noahlsm_glacial_only.o \
         module_sf_noahmp_groundwater.o \
-	module_sf_gecros.o \
+        module_sf_gecros.o \
 	module_sf_noahmpdrv.o \
 	module_sf_noahmplsm.o \
 	module_sf_noahmp_glacier.o \

From 6c3c915fa06cfcb9f022034574ffb5ce8673b2b2 Mon Sep 17 00:00:00 2001
From: JS-WRF-SBM <48547778+JS-WRF-SBM@users.noreply.github.com>
Date: Fri, 5 Apr 2019 13:51:50 +0300
Subject: [PATCH 09/29] Update Makefile

---
 phys/Makefile | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/phys/Makefile b/phys/Makefile
index 258bc4748e..2e2973ec73 100644
--- a/phys/Makefile
+++ b/phys/Makefile
@@ -212,7 +212,7 @@ DIAGNOSTIC_MODULES_EM = \
 	module_diag_pld.o \
 	module_diag_zld.o \
 	module_diag_trad_fields.o
- 
+
 DIAGNOSTIC_MODULES_NMM = \
 	module_diag_refl.o
 

From 94a1530d9f7ec856df99858bac5085fe1758bd25 Mon Sep 17 00:00:00 2001
From: JS-WRF-SBM <48547778+JS-WRF-SBM@users.noreply.github.com>
Date: Fri, 5 Apr 2019 13:55:21 +0300
Subject: [PATCH 10/29] Update module_diag_misc.F

---
 phys/module_diag_misc.F | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/phys/module_diag_misc.F b/phys/module_diag_misc.F
index 4ebde610e6..e9bb6c2a98 100644
--- a/phys/module_diag_misc.F
+++ b/phys/module_diag_misc.F
@@ -166,8 +166,8 @@ SUBROUTINE diagnostic_output_calc(                                 &
                                                     ,   SNOWNCV  &
                                                     ,       HFX  &
                                                     ,        LH  &
-                                                    ,    SFCEVP  &
-                                                    ,        T2
+                                                    ,    SFCEVP  &   
+                                                    ,        T2   
 
    REAL, DIMENSION( ims:ime , jms:jme ),                         &
           INTENT(INOUT) ::                                DPSDT  &

From 38b5d6fa9454cbd8bf5c3f77cfa3040631fd40b1 Mon Sep 17 00:00:00 2001
From: JS-WRF-SBM <48547778+JS-WRF-SBM@users.noreply.github.com>
Date: Fri, 5 Apr 2019 13:56:23 +0300
Subject: [PATCH 11/29] Update module_diag_misc.F

---
 phys/module_diag_misc.F | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/phys/module_diag_misc.F b/phys/module_diag_misc.F
index e9bb6c2a98..4ebde610e6 100644
--- a/phys/module_diag_misc.F
+++ b/phys/module_diag_misc.F
@@ -166,8 +166,8 @@ SUBROUTINE diagnostic_output_calc(                                 &
                                                     ,   SNOWNCV  &
                                                     ,       HFX  &
                                                     ,        LH  &
-                                                    ,    SFCEVP  &   
-                                                    ,        T2   
+                                                    ,    SFCEVP  &
+                                                    ,        T2
 
    REAL, DIMENSION( ims:ime , jms:jme ),                         &
           INTENT(INOUT) ::                                DPSDT  &

From adbf42599a83bd8fc6ac2e47bfa0a38b9bcf48e9 Mon Sep 17 00:00:00 2001
From: Yago Riveiro 
Date: Mon, 2 Dec 2019 20:37:50 +0000
Subject: [PATCH 12/29] Fix incorrect use of whereis and which to find
 nf-config command (#952)

TYPE: bug fix

KEYWORDS: Linux, Darwin, nc-config, configure

SOURCE: Yago Riveiro (Air Quality and Odor Management - AQOM), internal

DESCRIPTION OF CHANGES:
This pull fixes the incorrect use of `whereis` when we try to locate `nc-config`
command.
 - Only the `which` command is valid.
 - The return code is used, not the value of the `which nc-config` command.
 - There is no need to determine the OS with this fix.

LIST OF MODIFIED FILES:
M       configure

TESTS CONDUCTED:
 - [x] Re-run configure script, the warning disappears
 - [x] Still works on Darwin (netcdf/3.6.3 and netcdf/4.5.0)
 - [x] Still works on Linux desktop Centos 7.6 (netcdf/4.7.0)
 - [x] Still works on Linux NCAR supercomputer SUSE 12 SP4 (netcdf/4.6.3)
---
 configure | 13 +++----------
 1 file changed, 3 insertions(+), 10 deletions(-)

diff --git a/configure b/configure
index 6279f876b3..20a71191bb 100755
--- a/configure
+++ b/configure
@@ -204,16 +204,9 @@ fi
 
 # If the user asked for classic netcdf, acquiesce to the request.
 
-if [ "`uname`" = "Linux" ] ; then
-  ans="`whereis nf-config`"
-elif [ "`uname`" = "Darwin" ] ; then
-  ans="`which nf-config`"
-else
-  ans=""
-# echo "Add in your architecture's uname and the command to find executables in the path"
-# exit 1
-fi
-if [ "$ans" = "nf-config:" -o "$ans" = "" ] ; then
+ans="`which nf-config`"
+status="$?"
+if [ "$ans" = "nf-config:" -o "$ans" = "" -o "$status" != "0" ] ; then
     export NETCDF_classic=1
     unset NETCDF4
 else

From 794988eebc5f8894cb51e761a214c7aafd591df4 Mon Sep 17 00:00:00 2001
From: Yali Wu <43388239+YaliWu0219@users.noreply.github.com>
Date: Tue, 3 Dec 2019 23:06:04 -0700
Subject: [PATCH 13/29] Bug fix for calculating effective radius of rain, snow,
 and graupel (#1027)

TYPE: bug fix

KEYWORDS: effective radius, lamda calculation

SOURCE: Yali Wu (NCAR)

DESCRIPTION OF CHANGES: Subroutine `da_cld_eff_radius` uses exponential distribution for calculating the effective radius of different hydrometeor particles.

Slope parameters should be calculated following:
```
sqrt(sqrt(piover6*rho_x*n0_x/(rho*qx)))
```
but this was incorrectly typed, so that rho is in the numerator:
```
sqrt(sqrt(piover6*rho_x*n0_x*rho/qx)))
```
where, x denotes rain, snow, and graupel.

LIST OF MODIFIED FILES:
M       var/da/da_radiance/da_cld_eff_radius.inc

TESTS CONDUCTED: Conducted tests before and after bugfix on Cheyenne. The model simulated MW radiances were slightly improved for a typhoon case, while the simulated IR radiances seemed to have no difference.
---
 var/da/da_radiance/da_cld_eff_radius.inc | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/var/da/da_radiance/da_cld_eff_radius.inc b/var/da/da_radiance/da_cld_eff_radius.inc
index 8903134a23..97ec38f4bd 100644
--- a/var/da/da_radiance/da_cld_eff_radius.inc
+++ b/var/da/da_radiance/da_cld_eff_radius.inc
@@ -142,13 +142,13 @@ subroutine da_cld_eff_radius(t,rho,qci,qrn,qsn,qgr,snow,xice,xland,method, &
 !
    piover6 = pi/6.
    if ( qrn > limit ) then
-      lamda_rain = (piover6*rho_w*n0_rain*rho/qrn)**0.25
+      lamda_rain = (piover6*rho_w*n0_rain/(rho*qrn))**0.25
    end if
    if ( qsn > limit ) then
-      lamda_snow = (piover6*rho_snow*n0_snow*rho/qsn)**0.25
+      lamda_snow = (piover6*rho_snow*n0_snow/(rho*qsn))**0.25
    end if
    if ( qgr > limit ) then
-      lamda_grau = (piover6*rho_grau*n0_grau*rho/qgr)**0.25
+      lamda_grau = (piover6*rho_grau*n0_grau/(rho*qgr))**0.25
    end if
    sum1_rain = 0.0
    sum2_rain = 0.0

From c1a4f5836b0b3028ff204ed8c29883f1e93ff432 Mon Sep 17 00:00:00 2001
From: dudhia 
Date: Tue, 17 Dec 2019 13:33:51 -0700
Subject: [PATCH 14/29] Fix for rare divide by zero issue in sfclayrev (#1029)

TYPE: bug fix

KEYWORDS: sfclayrev scheme, divide by zero

SOURCE: internal (reported by CH Liu)

DESCRIPTION OF CHANGES:
During iterative solution for z/L there are rare cases where the same bit-for-bit value is returned for slightly different inputs to function zolri2 resulting in a divide by zero. This appears to be rare.
Fix is to return when these are found equal because solution is converged already.

LIST OF MODIFIED FILES:
phys/module_sf_sfclayrev.F

TESTS CONDUCTED:
Fix works for case that stopped.
Test on standard June case is bit-for-bit as expected
Jenkins passed

RELEASE NOTE:
Fix for occasional divide-by-zero error in sfclayrev option. Thanks Changhai Liu.
---
 phys/module_sf_sfclayrev.F | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/phys/module_sf_sfclayrev.F b/phys/module_sf_sfclayrev.F
index a09fccf795..76574cc115 100644
--- a/phys/module_sf_sfclayrev.F
+++ b/phys/module_sf_sfclayrev.F
@@ -1119,6 +1119,8 @@ function zolri(ri,z,z0)
       fx1=zolri2(x1,ri,z,z0)
       fx2=zolri2(x2,ri,z,z0)
       Do While (abs(x1 - x2) > 0.01)
+! check added for potential divide by zero (2019/11)
+      if(fx1.eq.fx2)return
       if(abs(fx2).lt.abs(fx1))then
         x1=x1-fx1/(fx2-fx1)*(x2-x1)
         fx1=zolri2(x1,ri,z,z0)

From b7135f915da9c73279986abe3741ab0a12cb36a6 Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Tue, 21 Jan 2020 11:19:50 -0700
Subject: [PATCH 15/29] Fix comments in hybrid coordinate registry (#1051)

TYPE: text only

KEYWORDS: hybrid comments

SOURCE: Found by Kezhen Chong (Georgia Institute of Technology), fixed internally

DESCRIPTION OF CHANGES:
Modify the comments in registry.hyb_coord to correctly define c4f and c4h. Originally, the value
of the pressure at the model lid (ptop) was included in the description of the computation of
the C4F and C4H 1d arrays as an added term. Following is the source code showing no such term.

```
   !  c4 is a function of c3 and eta.

   DO k=1, kde
      c4f(k) = ( znw(k) - c3f(k) ) * ( p1000mb - p_top )
   ENDDO

   !  Now on half levels, just add up and divide by 2 (for c3h).  Use (eta-c3)*(p00-pt) for c4 on half levels.

   DO k=1, kde-1
      c4h(k) = ( znu(k) - c3h(k) ) * ( p1000mb - p_top )
   ENDDO
```

ISSUE:
Fixes #1050

LIST OF MODIFIED FILES:
modified:   Registry/registry.hyb_coord

TESTS CONDUCTED:
 - [x] Text only in comment in a registry file, no tests required.
---
 Registry/registry.hyb_coord | 14 +++++++-------
 1 file changed, 7 insertions(+), 7 deletions(-)

diff --git a/Registry/registry.hyb_coord b/Registry/registry.hyb_coord
index 37aa90fef5..f91a2c6abd 100644
--- a/Registry/registry.hyb_coord
+++ b/Registry/registry.hyb_coord
@@ -1,7 +1,7 @@
 #	Dry pressure, Pd
 #	Dry surface pressure = Pds
 #	Model top pressure = Pt
-#	Mass in column, Pc = Pds - Pt
+#	Dry mass in column (base + perturbation), Pcb + Pc = Pds - Pt
 #	1d column weighting term, B: BF is full levels, BH is half levels
 
 #	Total dry pressure
@@ -40,17 +40,17 @@
 
 #                                                                                                   
 
-state    real      c1h             k     misc                1         -     i02rh0{22}{23}{24}      "C1H"       "half levels, c1h = d bf / d eta, using znw"         "Dimensionless"
-state    real      c2h             k     misc                1         -     i02rh0{22}{23}{24}      "C2H"       "half levels, c2h = (1-c1h)*(p0-pt)"                 "Pa"
+state    real      c1h             k     misc                1         -     i02rh0{22}{23}{24}      "C1H"       "half levels, c1h = d bf / d eta, using znw"        "Dimensionless"
+state    real      c2h             k     misc                1         -     i02rh0{22}{23}{24}      "C2H"       "half levels, c2h = (1-c1h)*(p0-pt)"                "Pa"
 
-state    real      c1f             k     misc                1         Z     i02rh0{22}{23}{24}      "C1F"       "full levels, c1f = d bf / d eta, using znu"         "Dimensionless"
-state    real      c2f             k     misc                1         Z     i02rh0{22}{23}{24}      "C2F"       "full levels, c2f = (1-c1f)*(p0-pt)"                 "Pa"
+state    real      c1f             k     misc                1         Z     i02rh0{22}{23}{24}      "C1F"       "full levels, c1f = d bf / d eta, using znu"        "Dimensionless"
+state    real      c2f             k     misc                1         Z     i02rh0{22}{23}{24}      "C2F"       "full levels, c2f = (1-c1f)*(p0-pt)"                "Pa"
 
 state    real      c3h             k     misc                1         -     i02rh0{22}{23}{24}      "C3H"       "half levels, c3h = bh"                             "Dimensionless"
-state    real      c4h             k     misc                1         -     i02rh0{22}{23}{24}      "C4H"       "half levels, c4h = (eta-bh)*(p0-pt)+pt, using znu" "Pa"
+state    real      c4h             k     misc                1         -     i02rh0{22}{23}{24}      "C4H"       "half levels, c4h = (eta-bh)*(p0-pt), using znu"    "Pa"
 
 state    real      c3f             k     misc                1         Z     i02rh0{22}{23}{24}      "C3F"       "full levels, c3f = bf"                             "Dimensionless"
-state    real      c4f             k     misc                1         Z     i02rh0{22}{23}{24}      "C4F"       "full levels, c4f = (eta-bf)*(p0-pt)+pt, using znw" "Pa"
+state    real      c4f             k     misc                1         Z     i02rh0{22}{23}{24}      "C4F"       "full levels, c4f = (eta-bf)*(p0-pt), using znw"    "Pa"
 
 state    real      pcb            ij    dyn_em               1         -     irhdus                  "PCB"       "base state dry air mass in column"                 "Pa"
 state    real      pc             ijb   dyn_em               2         -     irhusdf=(bdy_interp:dt) "PC"        "perturbation dry air mass in column"               "Pa"

From 0ffa92749024e2f834e8a9d84833ac527e907641 Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Tue, 21 Jan 2020 11:20:44 -0700
Subject: [PATCH 16/29] HWRF fixes: build = replicated symbol; run = link in
 look-up tables (#1049)

TYPE: bug fix

KEYWORDS: HWRF, build, run

SOURCE: internal

DESCRIPTION OF CHANGES:
To get the HWRF code to build and run the regression test cases, two changes are required:

### Build
There is a replicated symbol in subroutine feedback_domain_nmm_part2: SMOOTHER. This
named symbol cannot be both a LABEL and the name of a called SUBROUTINE within
a single subprogram unit (subroutine or function). Just a quick misspelling of SMOOTHR works
wonders.

### Run
Link in (ln -sf) all of the look-up tables to the test/nmm_real directory in the last step of the build
process. Most of the run-time-required links to physics data files were not originally in place.

LIST OF MODIFIED FILES:
modified:   Makefile
modified:   external/RSL_LITE/module_dm.F

TESTS CONDUCTED:
 - [x] Without build mod (replicated symbol), code does not build with GNU
 - [x] Without run mod (linked-in look-up tables), the code does not run regression tests
 - [x] With both mods, the code builds and runs.
 - [x] Regression test is now in place for HWRF.
---
 Makefile                      | 50 ++++++++++++++++++++++++++++++++---
 external/RSL_LITE/module_dm.F |  4 +--
 2 files changed, 49 insertions(+), 5 deletions(-)

diff --git a/Makefile b/Makefile
index 246a2a7b75..43ac672d9c 100644
--- a/Makefile
+++ b/Makefile
@@ -878,9 +878,53 @@ nmm_real : nmm_wrf
 	( cd test/nmm_real ; /bin/rm -f real_nmm.exe ; ln -s ../../main/real_nmm.exe . )
 	( cd test/nmm_real ; /bin/rm -f README.namelist ; ln -s ../../run/README.namelist . )
 	( cd test/nmm_real ; /bin/rm -f ETAMPNEW_DATA.expanded_rain ETAMPNEW_DATA RRTM_DATA ;    \
-	     ln -sf ../../run/ETAMPNEW_DATA . ;                     \
-	     ln -sf ../../run/ETAMPNEW_DATA.expanded_rain . ;                     \
-	     ln -sf ../../run/RRTM_DATA . ;                         \
+             ln -sf ../../run/ETAMPNEW_DATA . ;                     \
+             ln -sf ../../run/ETAMPNEW_DATA.expanded_rain . ;       \
+             ln -sf ../../run/RRTM_DATA . ;                         \
+             ln -sf ../../run/RRTMG_LW_DATA . ;                     \
+             ln -sf ../../run/RRTMG_SW_DATA . ;                     \
+             ln -sf ../../run/CAM_ABS_DATA . ;                      \
+             ln -sf ../../run/CAM_AEROPT_DATA . ;                   \
+             ln -sf ../../run/CAMtr_volume_mixing_ratio.RCP4.5 . ;  \
+             ln -sf ../../run/CAMtr_volume_mixing_ratio.RCP6   . ;  \
+             ln -sf ../../run/CAMtr_volume_mixing_ratio.RCP8.5 CAMtr_volume_mixing_ratio ;   \
+             ln -sf ../../run/CAMtr_volume_mixing_ratio.A1B    . ;  \
+             ln -sf ../../run/CAMtr_volume_mixing_ratio.A2     . ;  \
+             ln -sf ../../run/CLM_ALB_ICE_DFS_DATA . ;              \
+             ln -sf ../../run/CLM_ALB_ICE_DRC_DATA . ;              \
+             ln -sf ../../run/CLM_ASM_ICE_DFS_DATA . ;              \
+             ln -sf ../../run/CLM_ASM_ICE_DRC_DATA . ;              \
+             ln -sf ../../run/CLM_DRDSDT0_DATA . ;                  \
+             ln -sf ../../run/CLM_EXT_ICE_DFS_DATA . ;              \
+             ln -sf ../../run/CLM_EXT_ICE_DRC_DATA . ;              \
+             ln -sf ../../run/CLM_KAPPA_DATA . ;                    \
+             ln -sf ../../run/CLM_TAU_DATA . ;                      \
+             ln -sf ../../run/ozone.formatted . ;                   \
+             ln -sf ../../run/ozone_lat.formatted . ;               \
+             ln -sf ../../run/ozone_plev.formatted . ;              \
+             ln -sf ../../run/aerosol.formatted . ;                 \
+             ln -sf ../../run/aerosol_lat.formatted . ;             \
+             ln -sf ../../run/aerosol_lon.formatted . ;             \
+             ln -sf ../../run/aerosol_plev.formatted . ;            \
+             ln -sf ../../run/capacity.asc . ;                      \
+             ln -sf ../../run/coeff_p.asc . ;                       \
+             ln -sf ../../run/coeff_q.asc . ;                       \
+             ln -sf ../../run/constants.asc . ;                     \
+             ln -sf ../../run/masses.asc . ;                        \
+             ln -sf ../../run/termvels.asc . ;                      \
+             ln -sf ../../run/kernels.asc_s_0_03_0_9 . ;            \
+             ln -sf ../../run/kernels_z.asc . ;                     \
+             ln -sf ../../run/bulkdens.asc_s_0_03_0_9 . ;           \
+             ln -sf ../../run/bulkradii.asc_s_0_03_0_9 . ;          \
+             ln -sf ../../run/CCN_ACTIVATE.BIN . ;                  \
+             ln -sf ../../run/p3_lookup_table_1.dat-v4.1 . ;        \
+             ln -sf ../../run/p3_lookup_table_2.dat-v4.1 . ;        \
+             ln -sf ../../run/HLC.TBL . ;                           \
+             ln -sf ../../run/wind-turbine-1.tbl . ;                \
+             ln -sf ../../run/ishmael-gamma-tab.bin . ;             \
+             ln -sf ../../run/ishmael-qi-qc.bin . ;                 \
+             ln -sf ../../run/ishmael-qi-qr.bin . ;                 \
+             ln -sf ../../run/BROADBAND_CLOUD_GODDARD.bin . ;       \
 	     if [ $(RWORDSIZE) -eq 8 ] ; then                       \
 	        ln -sf ../../run/ETAMPNEW_DATA_DBL ETAMPNEW_DATA ;  \
                 ln -sf ../../run/ETAMPNEW_DATA.expanded_rain_DBL ETAMPNEW_DATA.expanded_rain ;   \
diff --git a/external/RSL_LITE/module_dm.F b/external/RSL_LITE/module_dm.F
index 2bb0367817..1b121e7c03 100644
--- a/external/RSL_LITE/module_dm.F
+++ b/external/RSL_LITE/module_dm.F
@@ -6334,9 +6334,9 @@ SUBROUTINE feedback_domain_nmm_part2 ( grid, intermediate_grid, ngrid , config_f
                                 cims, cime, cjms, cjme, ckms, ckme,    &
                                 cips, cipe, cjps, cjpe, ckps, ckpe    )
 
-     smoother: if(config_flags%smooth_option/=0) then
+     smoothr: if(config_flags%smooth_option/=0) then
 #include "nest_feedbackup_smooth.inc"
-     endif smoother
+     endif smoothr
 
     CALL pop_communicators_for_domain
 END IF

From d61195ab59d772b554b239fae450e54e0fceb0fe Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Tue, 21 Jan 2020 11:22:08 -0700
Subject: [PATCH 17/29] Remove pop/push communicator on non MPI runs (#1038)
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

TYPE:bug fix

KEYWORDS: fire, pop, push, communicator

SOURCE: internal

DESCRIPTION OF CHANGES:
Problem:
WRF gets into a state where the code tries to pop or push a stack of communicators. This should
not happen when doing a Serial or OpenMP build.

Here is the example error message we get with a push on OpenMP:
```
-------------- FATAL CALLED ---------------
FATAL CALLED FROM FILE:    LINE:    5489
pop_communicators_for_domain on empty stack
-------------------------------------------
```

And here is the example error message with a pop with OpenMP:
```
-------------- FATAL CALLED ---------------
FATAL CALLED FROM FILE:    LINE:    5464
push_communicators_for_domain would excede stacksize
-------------------------------------------
```

Solution:
This problem only occurs with Serial or OpenMP builds. The communicators are only required for
distributed memory MPI jobs. Therefore, put an ifdef around the routine that handles pops
and pushes of the the communicator stack.

LIST OF MODIFIED FILES:
modified:   external/RSL_LITE/module_dm.F

TESTS CONDUCTED:
 - [x] Auto regression is HAPPY!
---
 external/RSL_LITE/module_dm.F | 12 ++++++++++++
 1 file changed, 12 insertions(+)

diff --git a/external/RSL_LITE/module_dm.F b/external/RSL_LITE/module_dm.F
index 1b121e7c03..cc46fa2ecf 100644
--- a/external/RSL_LITE/module_dm.F
+++ b/external/RSL_LITE/module_dm.F
@@ -2507,6 +2507,8 @@ END MODULE module_dm
    SUBROUTINE push_communicators_for_domain( id )
       USE module_dm
       INTEGER, INTENT(IN) :: id   ! if specified also does an instate for grid id
+!  Only required for distrbuted memory parallel runs
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
       IF ( communicator_stack_cursor .GE. max_domains ) CALL wrf_error_fatal("push_communicators_for_domain would excede stacksize")
       communicator_stack_cursor = communicator_stack_cursor + 1
 
@@ -2524,10 +2526,13 @@ SUBROUTINE push_communicators_for_domain( id )
       mytask_y_stack( communicator_stack_cursor )       =    mytask_y
 
       CALL instate_communicators_for_domain( id )
+#endif
    END SUBROUTINE push_communicators_for_domain
    SUBROUTINE pop_communicators_for_domain
       USE module_dm
       IMPLICIT NONE
+      !  Only required for distrbuted memory parallel runs
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
       IF ( communicator_stack_cursor .LT. 1 ) CALL wrf_error_fatal("pop_communicators_for_domain on empty stack")
       current_id = id_stack(communicator_stack_cursor)
       local_communicator = local_communicator_stack( communicator_stack_cursor )
@@ -2542,9 +2547,12 @@ SUBROUTINE pop_communicators_for_domain
       mytask_x = mytask_x_stack( communicator_stack_cursor )
       mytask_y = mytask_y_stack( communicator_stack_cursor )
       communicator_stack_cursor = communicator_stack_cursor - 1
+#endif
    END SUBROUTINE pop_communicators_for_domain
    SUBROUTINE instate_communicators_for_domain( id )
       USE module_dm
+!  Only required for distrbuted memory parallel runs
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
       IMPLICIT NONE
       INTEGER, INTENT(IN) :: id
       INTEGER ierr
@@ -2560,9 +2568,12 @@ SUBROUTINE instate_communicators_for_domain( id )
       ntasks_y       = ntasks_y_store( id )
       mytask_x       = mytask_x_store( id )
       mytask_y       = mytask_y_store( id )
+#endif
    END SUBROUTINE instate_communicators_for_domain
    SUBROUTINE store_communicators_for_domain( id )
       USE module_dm
+!  Only required for distrbuted memory parallel runs
+#if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
       IMPLICIT NONE
       INTEGER, INTENT(IN) :: id
       local_communicator_store( id )    =    local_communicator
@@ -2576,6 +2587,7 @@ SUBROUTINE store_communicators_for_domain( id )
       mytask_store( id )        =    mytask
       mytask_x_store( id )      =    mytask_x
       mytask_y_store( id )      =    mytask_y
+#endif
    END SUBROUTINE store_communicators_for_domain
 
 !=========================================================================

From b06371b22798bc1663fbbb3733004c335dba1466 Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Tue, 21 Jan 2020 11:23:00 -0700
Subject: [PATCH 18/29] Increase max_eta from 1001 to 10001 (#1033)

TYPE: bug fix

KEYWORDS: eta, levels

SOURCE: internal

DESCRIPTION OF CHANGES:
Problem:
The real program fails when the number of vertical levels is more than a thousand.

Solution:
There is a single PARAMETER in the frame directory that is used to allocate space for the namelist
read and the eta computation in the real program. We absolutely need a parameter for
allocating space for the namelist variables. The original value for the maximum number of eta
levels was 1001. The 10x increase in size (from 1001 to 10001) impacts only a couple of 1d
arrays, so the WRF memory footprint is not dramatically increased.

The mods to the real program are for a stand-alone program buried in the source, and therefore
do not impact the traditional processing of either the real program or the WRF model.

LIST OF MODIFIED FILES:
modified:   dyn_em/module_initialize_real.F
modified:   frame/module_driver_constants.F

TESTS CONDUCTED:
 - [x] Original version with 1100 eta levels fails with bound check on Mac.
 - [x] New mods, real on Mac with 1100 eta levels works OK.
```
Full level index =    1     Height =     0.0 m
Full level index =    2     Height =    50.0 m      Thickness =   50.0 m
Full level index =    3     Height =    73.0 m      Thickness =   23.1 m
Full level index =    4     Height =    96.1 m      Thickness =   23.1 m
Full level index =    5     Height =   119.2 m      Thickness =   23.1 m
Full level index =    6     Height =   142.2 m      Thickness =   23.0 m
Full level index =    7     Height =   165.2 m      Thickness =   23.0 m
Full level index =    8     Height =   188.3 m      Thickness =   23.0 m
Full level index =    9     Height =   211.3 m      Thickness =   23.0 m
Full level index =   10     Height =   234.3 m      Thickness =   23.0 m

Full level index = 1090     Height = 19738.8 m      Thickness =   15.9 m
Full level index = 1091     Height = 19754.7 m      Thickness =   15.9 m
Full level index = 1092     Height = 19770.7 m      Thickness =   15.9 m
Full level index = 1093     Height = 19786.6 m      Thickness =   15.9 m
Full level index = 1094     Height = 19802.5 m      Thickness =   15.9 m
Full level index = 1095     Height = 19818.4 m      Thickness =   15.9 m
Full level index = 1096     Height = 19834.4 m      Thickness =   15.9 m
Full level index = 1097     Height = 19850.3 m      Thickness =   15.9 m
Full level index = 1098     Height = 19866.2 m      Thickness =   15.9 m
Full level index = 1099     Height = 19882.2 m      Thickness =   15.9 m
Full level index = 1100     Height = 19898.3 m      Thickness =   16.1 m

d01 2000-01-25_12:00:00 real_em: SUCCESS COMPLETE REAL_EM INIT
```

RELEASE NOTE: The number of vertical levels for the WRF model was increased from 1001 to 10001. Certainly 10000 vertical levels is very large. However, 3 domains with increasing numbers of eta levels (from vertical refinement) of 250, 350, 450 eta levels would previously have exceed the 1001 maximum value.
---
 dyn_em/module_initialize_real.F |  4 +++-
 frame/module_driver_constants.F | 12 ++++--------
 2 files changed, 7 insertions(+), 9 deletions(-)

diff --git a/dyn_em/module_initialize_real.F b/dyn_em/module_initialize_real.F
index 2ee0a2c8de..0a1dea654a 100644
--- a/dyn_em/module_initialize_real.F
+++ b/dyn_em/module_initialize_real.F
@@ -7049,7 +7049,9 @@ END SUBROUTINE rh_to_mxrat1
 #if 0
 program foo
 
-integer , parameter :: max_eta = 1000
+!  Make this local variable have the same value as in 
+!  frame/module_driver_constants.F: MAX_ETA
+integer , parameter :: max_eta = 10001
 
 INTEGER :: ids , ide , jds , jde , kds , kde , &
            ims , ime , jms , jme , kms , kme , &
diff --git a/frame/module_driver_constants.F b/frame/module_driver_constants.F
index 608c284247..38b645e88d 100644
--- a/frame/module_driver_constants.F
+++ b/frame/module_driver_constants.F
@@ -45,14 +45,10 @@ MODULE module_driver_constants
 
    INTEGER , PARAMETER :: max_moves       =   50
 
-   !  The maximum number of eta levels
-   !DJW 140701 Increased from 501 to 1001 since I can imagine using more than
-   !501 total vertical levels across multiple nested domains. Now that the
-   !code is modified to allow specification of all domains eta_levels using a
-   !array of length max_eta, this will need to be larger.  I'll also add a check
-   !in module_initialize_real to ensure we don't exceed this value.
-
-   INTEGER , PARAMETER :: max_eta         =   1001
+   !  The maximum number of eta levels. With vertical refinement defining
+   !  each domain separately, the aggregated number of levels could be large.
+
+   INTEGER , PARAMETER :: max_eta         =   10001
 
    !  The maximum number of ocean levels in the 3d U Miami ocean.
 

From 0a10d8d7d99ff7a4ee6a6df227a1695a2b58f532 Mon Sep 17 00:00:00 2001
From: smileMchen 
Date: Tue, 28 Jan 2020 14:17:41 -0700
Subject: [PATCH 19/29] Update module_mp_SBM_polar_radar.F

---
 phys/module_mp_SBM_polar_radar.F | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/phys/module_mp_SBM_polar_radar.F b/phys/module_mp_SBM_polar_radar.F
index 6c77f85fd7..cefb634cf5 100644
--- a/phys/module_mp_SBM_polar_radar.F
+++ b/phys/module_mp_SBM_polar_radar.F
@@ -174,7 +174,7 @@ SUBROUTINE LOAD_TABLES(nbins)
 enddo
 
 DO ispecies=1,size(usetables)
-  if((ispecies==1) .AND. usetables(ispecies)) then ! rain
+  if((ispecies==1) .AND. (usetables(ispecies)==1) ) then ! rain
       WRITE(*,*) 'READING SCATTERING TABLES: RAIN'
       ALLOCATE(faf1(nbins,nfws(1),ntemps(1),nwavelengths),stat=istatus)
       ALLOCATE(fbf1(nbins,nfws(1),ntemps(1),nwavelengths),stat=istatus)
@@ -204,7 +204,7 @@ SUBROUTINE LOAD_TABLES(nbins)
           endif
         enddo
       enddo
-  elseif(ispecies==2 .AND. usetables(ispecies)) then ! fd
+  elseif(ispecies==2 .AND. usetables(ispecies)==1) then ! fd
       WRITE(*,*) 'READING SCATTERING TABLES: FD'
       ALLOCATE(faf1fd(nbins,nfws(2),ntemps(2),nwavelengths),stat=istatus)
       ALLOCATE(fbf1fd(nbins,nfws(2),ntemps(2),nwavelengths),stat=istatus)
@@ -236,7 +236,7 @@ SUBROUTINE LOAD_TABLES(nbins)
         enddo
        enddo
       enddo
-  elseif(ispecies==3 .AND. usetables(ispecies)) then ! ice crystals (plates, dendrites, columns)
+  elseif(ispecies==3 .AND. usetables(ispecies)==1) then ! ice crystals (plates, dendrites, columns)
       WRITE(*,*) 'READING SCATTERING TABLES: ICE CRYSTALS'
       ALLOCATE(faf2d(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
       ALLOCATE(fbf2d(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
@@ -321,7 +321,7 @@ SUBROUTINE LOAD_TABLES(nbins)
         enddo
        enddo
       enddo
-  elseif(ispecies==4 .AND. usetables(ispecies)) then ! snow (aggregates)
+  elseif(ispecies==4 .AND. usetables(ispecies)==1) then ! snow (aggregates)
       WRITE(*,*) 'READING SCATTERING TABLES: SNOW'
       ALLOCATE(faf3(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
       ALLOCATE(fbf3(nbins,nfws(3),ntemps(3),nwavelengths),stat=istatus)
@@ -353,7 +353,7 @@ SUBROUTINE LOAD_TABLES(nbins)
         enddo
        enddo
       enddo
-  elseif(ispecies==5 .AND. usetables(ispecies)) then ! graupel
+  elseif(ispecies==5 .AND. usetables(ispecies)==1) then ! graupel
       WRITE(*,*) 'READING SCATTERING TABLES: GRAUPEL'
       ALLOCATE(faf4(nbins,nfws(4),ntemps(4),nwavelengths),stat=istatus)
       ALLOCATE(fbf4(nbins,nfws(4),ntemps(4),nwavelengths),stat=istatus)
@@ -385,7 +385,7 @@ SUBROUTINE LOAD_TABLES(nbins)
         enddo
        enddo
       enddo
-  elseif(ispecies==6 .AND. usetables(ispecies)) then ! hail
+  elseif(ispecies==6 .AND. usetables(ispecies)==1) then ! hail
       WRITE(*,*) 'READING SCATTERING TABLES: HAIL'
       ALLOCATE(faf5(nbins,nfws(5),ntemps(5),nwavelengths),stat=istatus)
       ALLOCATE(fbf5(nbins,nfws(5),ntemps(5),nwavelengths),stat=istatus)

From 0c4e36bb1a9dae634409ec98748156ba8da6bb41 Mon Sep 17 00:00:00 2001
From: dudhia 
Date: Wed, 29 Jan 2020 09:37:50 -0700
Subject: [PATCH 20/29] Fix for Deng shallow combined with other subgrid cloud
 options (#1043)

TYPE: bug fix

KEYWORDS: Deng shallow, radiation-driver clouds

SOURCE: internal and Pedro Jimenez

DESCRIPTION OF CHANGES:
Line qc_save = qc must be removed from Deng shallow section of radiation driver because it may save qc that is already updated by other physics that have radiation feedback, e.g. icloud, cu or bl. Leads to error when combining Deng shallow with such options (already not recommended with cumulus scheme). qc_save was already set for all options earlier.

LIST OF MODIFIED FILES:
phys/module_radiation_driver.F

TESTS CONDUCTED:
This fix has been tested by Pedro in WRF-Solar.
No regtests yet.
Test shows impact when Deng shcu is run with sub-grid clouds from MYNN icloud_bl=1. Left fixed, right old. Higher cloud fraction which leads to reduced surface shortwave compared to corrected code.
[Note that a later bug fix will not allow this combination, but fix applies to Deng shcu with sub-grid clouds from cumulus schemes and icloud=3 too].
Screen Shot 2019-12-18 at 1 39 55 PM

RELEASE NOTE:
Deng shallow scheme fix for when combined with other sub-grid cloud schemes (e.g. non-microphysics options that have radiation feedback). This would have added these clouds to microphysics at each step instead of removing them after radiation. (provided by Pedro Jimenez).
---
 phys/module_radiation_driver.F | 1 -
 1 file changed, 1 deletion(-)

diff --git a/phys/module_radiation_driver.F b/phys/module_radiation_driver.F
index 009e2d8666..f870c411a7 100644
--- a/phys/module_radiation_driver.F
+++ b/phys/module_radiation_driver.F
@@ -1601,7 +1601,6 @@ SUBROUTINE radiation_driver (                                  &
         DO k=kts,kte
         DO i=its,ite
            cldfra(I,K,J) = max(cldfra_sh(I,K,J), cldfra(I,K,J))
-           qc_save(I,K,J)=qc(I,K,J)
            qc(I,K,J)=cw_rad(I,K,J)+qc(I,K,J)
         ENDDO
         ENDDO

From 7baed7892f0995acceed049b40445df5e0550c66 Mon Sep 17 00:00:00 2001
From: dudhia 
Date: Tue, 4 Feb 2020 14:31:50 -0700
Subject: [PATCH 21/29] WDM5, WDM6 and WDM7 minor bug fixes (#1057)

TYPE: bug fix

KEYWORDS: WDM5, WDM6, WDM7

SOURCE: Kyo-Sun Lim (Kyungpook National University) and Sooya Bae (KIAPS).

DESCRIPTION OF CHANGES:
Error correction based on Lei et al. (JGR, 2020)

Melting of snow/graupel :
-Problem: melting processes of snow/graupel mass and number concentration do not occur
at the same time.
-Correction: melting of snow/graupel changes the snow/graupel/rain mass and rain number
concentration at the same time.
-Effect: Generation of rain number concentrations would decrease.
Regeneration of CCN number concentration due to the cloud water evaporation:
-Problem: Cloud water number concentration does not add into the CCN number concentration.
-Correction: Adding the cloud water number concentration into the CCN number concentration.
Effect: CCN number concentration would increase.
ISSUE: none

LIST OF MODIFIED FILES:
module_mp_wdm5.F
module_mp_wdm6.F
module_mp_wdm7.F

TESTS CONDUCTED:
Passed Jenkins
WDM6 tested versus master. Diffs small for surface fields including rainfall after 12 hrs of June 2001 test case (shown).
Screen Shot 2020-02-04 at 12 39 13 PM

RELEASE NOTE: Melting of snow/graupel now changes the snow/graupel/rain mass and rain number concentration at the same time in all WDM schemes provided by Kyo-Sun Lim (Kyungpook National University, South Korea).
---
 phys/module_mp_wdm5.F |  2 +-
 phys/module_mp_wdm6.F | 13 ++++++++-----
 phys/module_mp_wdm7.F | 10 +++++-----
 3 files changed, 14 insertions(+), 11 deletions(-)

diff --git a/phys/module_mp_wdm5.F b/phys/module_mp_wdm5.F
index 21bb5e6c78..caafdfd77d 100644
--- a/phys/module_mp_wdm5.F
+++ b/phys/module_mp_wdm5.F
@@ -1563,8 +1563,8 @@ SUBROUTINE wdm52D(t, q, qci, qrs, ncr, den, p, delz             &
 ! (NC->NCCN)
 !----------------------------------------------------------------------
           if(pcond(i,k).eq.-qci(i,k,1)/dtcld) then
-            ncr(i,k,2) = 0.
             ncr(i,k,1) = ncr(i,k,1)+ncr(i,k,2)
+            ncr(i,k,2) = 0.
           endif
 !
           q(i,k) = q(i,k)-pcond(i,k)*dtcld
diff --git a/phys/module_mp_wdm6.F b/phys/module_mp_wdm6.F
index 0c63a7c89b..039ebfa64d 100644
--- a/phys/module_mp_wdm6.F
+++ b/phys/module_mp_wdm6.F
@@ -905,8 +905,6 @@ subroutine wdm62D(t, q, qci, qrs, ncr, den, p, delz            &
                          +precs2*work2(i,k)*coeres)/den(i,k)                  
               psmlt(i,k) = min(max(psmlt(i,k)*dtcld/mstep(i),-qrs(i,k,2)     &
                          /mstep(i)),0.)
-              qrs(i,k,2) = qrs(i,k,2) + psmlt(i,k)
-              qrs(i,k,1) = qrs(i,k,1) - psmlt(i,k)
 !-------------------------------------------------------------------
 ! nsmlt: melting of snow [LH A27]
 !       (T>T0: ->NR)
@@ -915,6 +913,9 @@ subroutine wdm62D(t, q, qci, qrs, ncr, den, p, delz            &
                 sfac = rslope(i,k,2)*n0s*n0sfac(i,k)/qrs(i,k,2)
                 ncr(i,k,3) = ncr(i,k,3) - sfac*psmlt(i,k)
               endif
+! error correction based on Lei et al., (JGR, 2020)
+              qrs(i,k,2) = qrs(i,k,2) + psmlt(i,k)
+              qrs(i,k,1) = qrs(i,k,1) - psmlt(i,k)
               t(i,k) = t(i,k) + xlf/cpm(i,k)*psmlt(i,k)
             endif
 !---------------------------------------------------------------
@@ -928,8 +929,6 @@ subroutine wdm62D(t, q, qci, qrs, ncr, den, p, delz            &
                            /den(i,k)                                          
               pgmlt(i,k) = min(max(pgmlt(i,k)*dtcld/mstep(i),                &
                           -qrs(i,k,3)/mstep(i)),0.)
-              qrs(i,k,3) = qrs(i,k,3) + pgmlt(i,k)
-              qrs(i,k,1) = qrs(i,k,1) - pgmlt(i,k)
 !-------------------------------------------------------------------
 ! ngmlt: melting of graupel [LH A28]
 !       (T>T0: ->NR)
@@ -938,6 +937,9 @@ subroutine wdm62D(t, q, qci, qrs, ncr, den, p, delz            &
                 gfac = rslope(i,k,3)*n0g/qrs(i,k,3)
                 ncr(i,k,3) = ncr(i,k,3) - gfac*pgmlt(i,k)
               endif
+! error correction based on Lei et al., (JGR, 2020)
+              qrs(i,k,3) = qrs(i,k,3) + pgmlt(i,k)
+              qrs(i,k,1) = qrs(i,k,1) - pgmlt(i,k)
               t(i,k) = t(i,k) + xlf/cpm(i,k)*pgmlt(i,k)
             endif
           endif
@@ -1982,8 +1984,9 @@ subroutine wdm62D(t, q, qci, qrs, ncr, den, p, delz            &
 ! (NC->NCCN) 
 !----------------------------------------------------------------
           if(pcond(i,k).eq.-qci(i,k,1)/dtcld) then
-            ncr(i,k,2) = 0.
             ncr(i,k,1) = ncr(i,k,1)+ncr(i,k,2)
+! error correction based on Lei et al. (JGR, 2020)
+            ncr(i,k,2) = 0.
           endif
 !
           q(i,k) = q(i,k)-pcond(i,k)*dtcld
diff --git a/phys/module_mp_wdm7.F b/phys/module_mp_wdm7.F
index cb7d178167..edb97b5e3d 100644
--- a/phys/module_mp_wdm7.F
+++ b/phys/module_mp_wdm7.F
@@ -917,8 +917,6 @@ SUBROUTINE wdm72D(t, q, qci, qrs, ncr, den, p, delz             &
                          +precs2*work2(i,k)*coeres)/den(i,k)                  
               psmlt(i,k) = min(max(psmlt(i,k)*dtcld/mstep(i),-qrs(i,k,2)     &
                          /mstep(i)),0.)
-              qrs(i,k,2) = qrs(i,k,2) + psmlt(i,k)
-              qrs(i,k,1) = qrs(i,k,1) - psmlt(i,k)
 !
 ! nsmlt: melting of snow [LH A27]
 !       (T>T0: ->NR)
@@ -927,6 +925,8 @@ SUBROUTINE wdm72D(t, q, qci, qrs, ncr, den, p, delz             &
                 sfac = rslope(i,k,2)*n0s*n0sfac(i,k)/qrs(i,k,2)
                 ncr(i,k,3) = ncr(i,k,3) - sfac*psmlt(i,k)
               endif
+              qrs(i,k,2) = qrs(i,k,2) + psmlt(i,k)
+              qrs(i,k,1) = qrs(i,k,1) - psmlt(i,k)
               t(i,k) = t(i,k) + xlf/cpm(i,k)*psmlt(i,k)
             endif
 !
@@ -940,8 +940,6 @@ SUBROUTINE wdm72D(t, q, qci, qrs, ncr, den, p, delz             &
                            /den(i,k)                                          
               pgmlt(i,k) = min(max(pgmlt(i,k)*dtcld/mstep(i),                &
                           -qrs(i,k,3)/mstep(i)),0.)
-              qrs(i,k,3) = qrs(i,k,3) + pgmlt(i,k)
-              qrs(i,k,1) = qrs(i,k,1) - pgmlt(i,k)
 !
 ! ngmlt: melting of graupel [LH A28]
 !       (T>T0: ->NR)
@@ -950,6 +948,8 @@ SUBROUTINE wdm72D(t, q, qci, qrs, ncr, den, p, delz             &
                 gfac = rslope(i,k,3)*n0g/qrs(i,k,3)
                 ncr(i,k,3) = ncr(i,k,3) - gfac*pgmlt(i,k)
               endif
+              qrs(i,k,3) = qrs(i,k,3) + pgmlt(i,k)
+              qrs(i,k,1) = qrs(i,k,1) - pgmlt(i,k)
               t(i,k) = t(i,k) + xlf/cpm(i,k)*pgmlt(i,k)
             endif
 !
@@ -2277,8 +2277,8 @@ SUBROUTINE wdm72D(t, q, qci, qrs, ncr, den, p, delz             &
 ! (NC->NCCN) 
 !
           if(pcond(i,k).eq.-qci(i,k,1)/dtcld) then
-            ncr(i,k,2) = 0.
             ncr(i,k,1) = ncr(i,k,1)+ncr(i,k,2)
+            ncr(i,k,2) = 0.
           endif
 !
           q(i,k) = q(i,k)-pcond(i,k)*dtcld

From e7cad84ca9a1341cb4a1c3d89053339447183937 Mon Sep 17 00:00:00 2001
From: dudhia 
Date: Tue, 4 Feb 2020 16:00:22 -0700
Subject: [PATCH 22/29] fix entry for KSAS (#1073)

---
 run/README.namelist | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/run/README.namelist b/run/README.namelist
index 364547bee4..699bfc0c30 100644
--- a/run/README.namelist
+++ b/run/README.namelist
@@ -787,8 +787,7 @@ Namelist variables for controlling the adaptive time step option:
                                      = 7, Zhang-McFarlane scheme from CAM5 (CESM 1_0_1)
                                      = 10, Modified Kain-Fritsch scheme with trigger function based on PDFs (ARW only)
                                      = 11, Multi-scale Kain-Fritsch scheme
-                                     = 14, A modified  GFS simplified Arakawa-Schubert scheme that enables NSAS to work 
-                                           in various model grids across gray-zone resolutions (from KIAPS,ARW only)
+                                     = 14, KIM Simplified Arakawa-Schubert scheme (KSAS) across gray-zone resolutions
                                      = 16, A newer Tiedtke scheme
                                      = 94, 2015 GFS Simplified Arakawa-Schubert scheme (HWRF) 
                                      = 95, Previous GFS Simplified Arakawa-Schubert scheme (HWRF) 

From 3d6ce72e536c188ff32f87211f0bae4131fb5a9d Mon Sep 17 00:00:00 2001
From: Ming Chen 
Date: Thu, 6 Feb 2020 11:03:01 -0700
Subject: [PATCH 23/29] Modify code for new FSBM to make it able to compile

---
 phys/module_mp_fast_sbm.F | 80 +++++++++++++++++++--------------------
 1 file changed, 40 insertions(+), 40 deletions(-)

diff --git a/phys/module_mp_fast_sbm.F b/phys/module_mp_fast_sbm.F
index adca3dfd38..60be208e4d 100644
--- a/phys/module_mp_fast_sbm.F
+++ b/phys/module_mp_fast_sbm.F
@@ -4300,7 +4300,7 @@ SUBROUTINE FAST_SBM (w,u,v,th_old,                                &
        		    else
        		    	w_stag_my = 100*w(i,k,j)
        		 	end if
-       			if(SUP_WATER > 0.0D0 .and. w_stag_my > 0.1*1.0D2 .and. K_found == .FALSE. .and. K > 2 .and. zcgs(I,K,J) < 3.0*1.0D5)then
+       			if(SUP_WATER > 0.0D0 .and. w_stag_my > 0.1*1.0D2 .and. K_found .eqv. .FALSE. .and. K > 2 .and. zcgs(I,K,J) < 3.0*1.0D5)then
        				KZ_Cloud_Base(I,J) = K ! K-level index of cloud base
        				K_found = .TRUE.
        			endif
@@ -5366,9 +5366,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
  	2060  CONTINUE
  	ENDIF
 
- 	#if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  		CALL wrf_dm_bcast_bytes( hujisbm_unit1 , IWORDSIZE )
- 	#endif
+#endif
  	IF ( hujisbm_unit1 < 0 ) THEN
      	CALL wrf_error_fatal ( 'module_mp_FAST-SBM: Table-1 -- FAST_SBM_INIT: '// 			&
  							              'Can not find unused fortran unit to read in lookup table, model stop' )
@@ -5389,7 +5389,7 @@ SUBROUTINE FAST_HUCMINIT(DT)
 #define DM_BCAST_MACRO_R8(A) CALL wrf_dm_bcast_bytes(A, size(A)*R8SIZE)
 #define DM_BCAST_MACRO_R16(A) CALL wrf_dm_bcast_bytes(A, size(A)*R16SIZE)
 
-#if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
     DM_BCAST_MACRO_R8(bin_mass)
  	  DM_BCAST_MACRO_R8(tab_colum)
  	  DM_BCAST_MACRO_R8(tab_dendr)
@@ -5422,9 +5422,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
      2061  CONTINUE
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  	CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
- #endif
+#endif
      IF ( hujisbm_unit1 < 0 ) THEN
          CALL wrf_error_fatal ( 'module_mp_FAST-SBM: Table-2 -- FAST_SBM_INIT: '// 			&
                                'Can not find unused fortran unit to read in lookup table,model stop' )
@@ -5439,13 +5439,13 @@ SUBROUTINE FAST_HUCMINIT(DT)
  	READ(hujisbm_unit1,900) RLEC,RIEC,RSEC,RGEC,RHEC
  END IF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
      DM_BCAST_MACRO_R4(RLEC)
      DM_BCAST_MACRO_R4(RIEC)
      DM_BCAST_MACRO_R4(RSEC)
      DM_BCAST_MACRO_R4(RGEC)
      DM_BCAST_MACRO_R4(RHEC)
- #endif
+#endif
 
      WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-2'
      print*,errmess
@@ -5472,9 +5472,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
      2062 CONTINUE
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
      CALL wrf_dm_bcast_bytes ( hujisbm_unit1, IWORDSIZE )
- #endif
+#endif
 
      IF ( hujisbm_unit1 < 0 ) THEN
          CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-3 -- FAST_SBM_INIT: '// 		&
@@ -5489,13 +5489,13 @@ SUBROUTINE FAST_HUCMINIT(DT)
          CLOSE(hujisbm_unit1)
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
    	DM_BCAST_MACRO_R4(XL)
      DM_BCAST_MACRO_R4(XI)
      DM_BCAST_MACRO_R4(XS)
      DM_BCAST_MACRO_R4(XG)
      DM_BCAST_MACRO_R4(XH)
- #endif
+#endif
 
       WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-3'
       print*,errmess
@@ -5523,9 +5523,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
      2063   CONTINUE
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
      CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
- #endif
+#endif
      IF ( hujisbm_unit1 < 0 ) THEN
          CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-4 -- FAST_SBM_INIT: '// 										&
                                  'Can not find unused fortran unit to read in lookup table,model stop' )
@@ -5540,13 +5540,13 @@ SUBROUTINE FAST_HUCMINIT(DT)
         CLOSE(hujisbm_unit1)
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  	DM_BCAST_MACRO_R4(VR1)
      DM_BCAST_MACRO_R4(VR2)
      DM_BCAST_MACRO_R4(VR3)
      DM_BCAST_MACRO_R4(VR4)
      DM_BCAST_MACRO_R4(VR5)
- #endif
+#endif
      WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-4'
      CALL wrf_debug(000, errmess)
  ! +----------------------------------------------------------------------+
@@ -5572,9 +5572,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
      2065     CONTINUE
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  		CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
- #endif
+#endif
 
      IF ( hujisbm_unit1 < 0 ) THEN
          CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-5 -- FAST_SBM_INIT: '// 										&
@@ -5590,11 +5590,11 @@ SUBROUTINE FAST_HUCMINIT(DT)
       CLOSE(hujisbm_unit1)
      END IF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  	  DM_BCAST_MACRO_R4(SLIC)
     DM_BCAST_MACRO_R4(TLIC)
     DM_BCAST_MACRO_R4(COEFIN)
- #endif
+#endif
      WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-5'
      CALL wrf_debug(000, errmess)
  ! +----------------------------------------------------------------------+
@@ -5619,9 +5619,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
      2066     CONTINUE
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  		CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
- #endif
+#endif
      IF ( hujisbm_unit1 < 0 ) THEN
          CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-6 -- FAST_SBM_INIT: '// 			&
                                  'Can not find unused fortran unit to read in lookup table,model stop' )
@@ -5646,11 +5646,11 @@ SUBROUTINE FAST_HUCMINIT(DT)
    		ENDDO
    	ENDDO
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  	DM_BCAST_MACRO_R4(YWLL_1000MB)
      DM_BCAST_MACRO_R4(YWLL_750MB)
      DM_BCAST_MACRO_R4(YWLL_500MB)
- #endif
+#endif
 
      WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-6'
      CALL wrf_debug(000, errmess)
@@ -5712,9 +5712,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
      2067     CONTINUE
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
      CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
- #endif
+#endif
  IF ( hujisbm_unit1 < 0 ) THEN
  	CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-7 -- FAST_SBM_INIT: '// 			&
  											'Can not find unused fortran unit to read in lookup table,model stop' )
@@ -5854,7 +5854,7 @@ SUBROUTINE FAST_HUCMINIT(DT)
   CLOSE(hujisbm_unit1)
  END IF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
 	   DM_BCAST_MACRO_R4(YWLI_300MB)
      DM_BCAST_MACRO_R4(YWLI_500MB)
      DM_BCAST_MACRO_R4(YWLI_750MB)
@@ -5887,7 +5887,7 @@ SUBROUTINE FAST_HUCMINIT(DT)
      DM_BCAST_MACRO_R4(YWSS_300MB)
      DM_BCAST_MACRO_R4(YWSS_500MB)
      DM_BCAST_MACRO_R4(YWSS_750MB)
- #endif
+#endif
 
      WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-7'
      CALL wrf_debug(000, errmess)
@@ -5914,9 +5914,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
      2068     CONTINUE
      ENDIF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
      CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
- #endif
+#endif
      IF ( hujisbm_unit1 < 0 ) THEN
          CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-8 -- FAST_SBM_INIT: '// 			&
                                  'Can not find unused fortran unit to read in lookup table,model stop' )
@@ -5930,13 +5930,13 @@ SUBROUTINE FAST_HUCMINIT(DT)
          CLOSE(hujisbm_unit1)
      END IF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  	    DM_BCAST_MACRO_R4(RO1BL)
       DM_BCAST_MACRO_R4(RO2BL)
       DM_BCAST_MACRO_R4(RO3BL)
       DM_BCAST_MACRO_R4(RO4BL)
       DM_BCAST_MACRO_R4(RO5BL)
- #endif
+#endif
      WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-8'
      CALL wrf_debug(000, errmess)
  ! +----------------------------------------------------------------------+
@@ -5956,9 +5956,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
        ENDDO
      2069     CONTINUE
      ENDIF
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  		CALL wrf_dm_bcast_bytes ( hujisbm_unit1 , IWORDSIZE )
- #endif
+#endif
      IF ( hujisbm_unit1 < 0 ) THEN
       CALL wrf_error_fatal ( 'module_mp_FAST_SBM: Table-9 -- FAST_SBM_INIT: '// 			&
                                  'Can not find unused fortran unit to read in lookup table,model stop' )
@@ -5972,9 +5972,9 @@ SUBROUTINE FAST_HUCMINIT(DT)
          CLOSE(hujisbm_unit1)
      END IF
 
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
        DM_BCAST_MACRO_R4(RADXXO)
- #endif
+#endif
      WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading Table-9'
      CALL wrf_debug(000, errmess)
  ! +-----------------------------------------------------------------------+
@@ -5985,7 +5985,7 @@ SUBROUTINE FAST_HUCMINIT(DT)
   CALL LOAD_TABLES(NKR)  ! (KS) - Loading the scattering look-up-table
 
  ! ... (KS) - Broadcating Liquid drops
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
    	DM_BCAST_MACRO_R16 ( FAF1 )
    	DM_BCAST_MACRO_R16 ( FBF1 )
    	DM_BCAST_MACRO_R16 ( FAB1 )
@@ -6020,7 +6020,7 @@ SUBROUTINE FAST_HUCMINIT(DT)
    	DM_BCAST_MACRO_R4 ( fws_hail )
  ! ### (KS) - Broadcating Usetables array
  	  CALL wrf_dm_bcast_integer ( usetables , size ( usetables ) * IWORDSIZE )
- #endif
+#endif
   WRITE(errmess, '(A,I2)') 'module_mp_WRFsbm : succesfull reading Table-10'
   call wrf_message(errmess)
  ! +-----------------------------------------------------------------------+
@@ -6087,10 +6087,10 @@ SUBROUTINE FAST_HUCMINIT(DT)
     ECOALMASSM = 0.0d0
     BRKWEIGHT = 0.0d0
  	 CALL BREAKINIT_KS(PKIJ,QKJ,ECOALMASSM,BRKWEIGHT,XL,DROPRADII,BR_MAX,JBREAK,JMAX,NKR,VR1) ! Rain Spontanous Breakup
- #if defined(DM_PARALLEL)
+#if (defined(DM_PARALLEL))
  	 	DM_BCAST_MACRO_R4 (PKIJ)
     DM_BCAST_MACRO_R4 (QKJ)
- #endif
+#endif
  	  WRITE(errmess, '(A,I2)') 'FAST_SBM_INIT : succesfull reading BREAKINIT_KS" '
     CALL wrf_debug(000, errmess)
   ! +--------------------------------------------------------------------------------------------------------------------+

From 51ed62f1ca892adef229038a0cecd6c7e250fda0 Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Sat, 8 Feb 2020 00:00:24 -0700
Subject: [PATCH 24/29] Bug fixes WRF Fire

TYPE: bug fix

KEYWORDS: Fire, fuel model, GNU

SOURCE: internal

DESCRIPTION OF CHANGES:
Problem:
1. Cannot build with GNU
2. Seg-faults with standard non-fire runs.

Solution:
2. The use of LOGICALs in the option choices for some of the fire variables
is inapropriate for eventual usage when those namelist options are part of
a Registry package statement. The WRF code assumes that the packages are
INTEGER values - not LOGICAL.
2. The number of elements in a few DATA statements needed to be increased by 1.
The "no fuel" entry is set to 14.

LIST OF MODIFIED FILES:
modified:   Registry/registry.fire
modified:   phys/module_fr_fire_phys.F
modified:   share/module_check_a_mundo.F

TESTS CONDUCTED:
 - [x] Without mods, code does not build; with mods, code builds.
 - [x] Without mods, code seg faults; with mods, non-fire code runs.
---
 Registry/registry.fire       |  6 ++++--
 phys/module_fr_fire_phys.F   | 13 +++++++------
 share/module_check_a_mundo.F | 22 ++++++++++++++++++++++
 3 files changed, 33 insertions(+), 8 deletions(-)

diff --git a/Registry/registry.fire b/Registry/registry.fire
index a3e7020ff2..e0ebcfc237 100644
--- a/Registry/registry.fire
+++ b/Registry/registry.fire
@@ -10,8 +10,8 @@
 # 
 package   fire_sfire    ifire==2                    -             state:avg_fuel_frac,bbb,betafl,burnt_area_dt,canhfx,canqfx,dzdxf,dzdyf,fcanhfx,fcanqfx,fgip,fgrnhfx,fgrnqfx,fire_area,fire_smoke,flame_length,fmc_equi,fmc_g,fmc_gc,fmep,fmc_lag,fmoist_lasttime,fmoist_nexttime,fuel_frac,fuel_time,fxlat,fxlong,fz0,grnhfx,grnhfx_fu,grnqfx,grnqfx_fu,iboros,ischap,lfn,lfn_0,lfn_1,lfn_2,lfn_hist,lfn_s0,lfn_s1,lfn_s2,lfn_s3,lfn_time,nfuel_cat,phiwc,psfc_old,q2_old,r_0,rain_old,rh_fire,ros,ros_front,rqvfrten,rthfrten,t2_old,tign_g,uah,uf,vah,vf,zsf
 
-package  fire_fmoist_run   fmoist_run==.true.       -            state:fmc_gc,fmep,fmc_equi,fmc_lag,rain_old,t2_old,psfc_old,rh_fire
-package  fire_fmoist_interp fmoist_interp==.true.   -            state:fmc_gc
+package  fire_fmoist_run   fmoisti_run==1           -             state:fmc_gc,fmep,fmc_equi,fmc_lag,rain_old,t2_old,psfc_old,rh_fire
+package  fire_fmoist_interp fmoisti_interp==1       -             state:fmc_gc
 
 # level function history support
 dimspec   ign   2           constant=1      z    i_lfn_history
@@ -90,6 +90,8 @@ state    real     fmoist_lasttime -  fire        -         -     hr   "FMOIST_LA
 state    real     fmoist_nexttime -  fire        -         -     hr   "FMOIST_NEXTTIME" "next time the moisture model will run" "s"
 rconfig logical   fmoist_run        namelist,fire  max_domains   .false.       hr   "run moisture model (on the atmospheric grid), output to fmc_gc"
 rconfig logical   fmoist_interp     namelist,fire  max_domains   .false.       hr   "interpolate moisture from the model or the input to fuels on the fire grid"
+rconfig integer   fmoisti_run       derived        max_domains   0             hr   "run moisture model (on the atmospheric grid), output to fmc_gc"
+rconfig integer   fmoisti_interp    derived        max_domains   0             hr   "interpolate moisture from the model or the input to fuels on the fire grid"
 rconfig logical   fmoist_only       namelist,fire  max_domains   .false.       hr   "only run moisture model, skip fire"
 rconfig integer   fmoist_freq       namelist,fire  max_domains    0       hr   "fmoist_freq"    "frequency to run moisture model 0: use fmoist_dt, k>0: every k timesteps" "1"
 rconfig real      fmoist_dt         namelist,fire  max_domains    600     hr   "fmoist_dt  "    "moisture model time step" "s"
diff --git a/phys/module_fr_fire_phys.F b/phys/module_fr_fire_phys.F
index 6119983378..d1dc8b4fc1 100644
--- a/phys/module_fr_fire_phys.F
+++ b/phys/module_fr_fire_phys.F
@@ -216,12 +216,13 @@ module module_fr_fire_phys
 !  DATA fmc_gw05 / 0.000, 0.023, 0.000, 0.230, 0.092, 0.000, 0.017, 0.000, 0.000, 0.092, 0.000, 0.000, 0.000, zf*0/
 
 ! fuel loading 1-h, 10-h, 100-h, 1000-h, live following Albini 1976 as reprinted in Anderson 1982 Table 1 (for proportions only)
-!                     1      2      3      4      5      6      7      8      9     10     11     12     13
-  DATA fgi_1h    / 0.74,   2.00,  3.01,  5.01,  1.00,  1.50,  1.13,  1.50,  2.92,  3.01,  1.50,  4.01,  7.01, zf*0./
-  DATA fgi_10h   / 0.00,   1.00,  0.00,  4.01,  0.50,  2.50,  1.87,  1.00,  0.41,  2.00,  4.51, 14.03, 23.04, zf*0./
-  DATA fgi_100h  / 0.00,   0.50,  0.00,  2.00,  0.00,  2.00,  1.50,  2.50,  0.15,  5.01,  5.51, 16.53, 28.05, zf*0./
-  DATA fgi_1000h / 0.0,    0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,  zf*0./
-  DATA fgi_live  / 0.00,   0.50,  0.000, 5.01,  2.00,  0.00,  0.37,  0.00,  0.00,  2.00,  0.00,  2.3,   0.00, zf*0./
+!                     1      2      3      4      5      6      7      8      9     10     11     12     13     14
+  DATA fgi_1h    / 0.74,   2.00,  3.01,  5.01,  1.00,  1.50,  1.13,  1.50,  2.92,  3.01,  1.50,  4.01,  7.01,   0.0,   zf*0./
+  DATA fgi_10h   / 0.00,   1.00,  0.00,  4.01,  0.50,  2.50,  1.87,  1.00,  0.41,  2.00,  4.51, 14.03, 23.04,   0.0,   zf*0./
+  DATA fgi_100h  / 0.00,   0.50,  0.00,  2.00,  0.00,  2.00,  1.50,  2.50,  0.15,  5.01,  5.51, 16.53, 28.05,   0.0,   zf*0./
+  DATA fgi_1000h / 0.0,    0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,   0.0,    0.0,   zf*0./
+  DATA fgi_live  / 0.00,   0.50,  0.000, 5.01,  2.00,  0.00,  0.37,  0.00,  0.00,  2.00,  0.00,  2.3,   0.00,   0.0,   zf*0./
+
 ! total fuel loading kg/m^2
   DATA fgi       / 0.166,  0.896, 0.674, 3.591, 0.784, 1.344, 1.091, 1.120, 0.780, 2.692, 2.582, 7.749, 13.024, 1.e-7, zf*0.  /
 
diff --git a/share/module_check_a_mundo.F b/share/module_check_a_mundo.F
index 806655c48a..88163094b5 100644
--- a/share/module_check_a_mundo.F
+++ b/share/module_check_a_mundo.F
@@ -2710,6 +2710,28 @@ SUBROUTINE set_physics_rconfigs
          END IF
       ENDDO
 
+!-----------------------------------------------------------------------
+! If a user selected LOGICAL fire-related switches, convert those to
+! INTEGER for the package allocation assignment required in the 
+! registry file.
+!-----------------------------------------------------------------------
+
+#if (EM_CORE == 1)
+      DO i = 1, model_config_rec % max_dom
+         IF ( .NOT. model_config_rec % grid_allowed(i) ) CYCLE
+         IF ( model_config_rec % fmoist_run(i) .EQV. .TRUE.  ) THEN
+            model_config_rec % fmoisti_run(i) = 1
+         ELSE 
+            model_config_rec % fmoisti_run(i) = 0
+         END IF
+         IF ( model_config_rec % fmoist_interp(i) .EQV. .TRUE.  ) THEN
+            model_config_rec % fmoisti_interp(i) = 1
+         ELSE 
+            model_config_rec % fmoisti_interp(i) = 0
+         END IF
+      ENDDO
+#endif
+
 !-----------------------------------------------------------------------
 ! If MYNN PBL is not used, set bl_mynn_edmf = 0 so that we don't get 
 ! additional output 

From b38b310eec38a2611b85de36ef6aa9958502e2ef Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Sat, 8 Feb 2020 17:38:46 -0700
Subject: [PATCH 25/29] Fix broken NMM from FARMS mods

TYPE: bug fix

KEYWORDS: FARMS, NMM

SOURCE: internal

DESCRIPTION OF CHANGES:
Problem:
The NMM code would not build. A few variables passed into the radiation
driver are ARW specific, so the call from the NMM core did not have:
MUT or DNW (both input from ARW), or six additional computed radiation
output fields.

Solution:
1. Make the ARW-specific and additional radiation fields OPTIONAL.
2. Use an IF(PRESENT(xxx)) before using any of the fields.

LIST OF MODIFIED FILES:
modified:   phys/module_radiation_driver.F
modified:   dyn_em/module_first_rk_step_part1.F

TESTS CONDUCTED:
1. Without mods, NMM HWRF cannot build.
2. With mods, NMM HWRF builds and runs successfully.
3. With mods, ARW still works.
---
 dyn_em/module_first_rk_step_part1.F |  3 ++
 phys/module_radiation_driver.F      | 64 +++++++++++++++++------------
 2 files changed, 40 insertions(+), 27 deletions(-)

diff --git a/dyn_em/module_first_rk_step_part1.F b/dyn_em/module_first_rk_step_part1.F
index e897a989b1..6ff0dc1de9 100644
--- a/dyn_em/module_first_rk_step_part1.F
+++ b/dyn_em/module_first_rk_step_part1.F
@@ -308,10 +308,13 @@ SUBROUTINE first_rk_step_part1 (   grid , config_flags              &
      &        ,CAM_ABS_FREQ_S=grid%cam_abs_freq_s                         &
      &        ,XTIME=grid%xtime                                                &
               ,CURR_SECS=curr_secs, ADAPT_STEP_FLAG=adapt_step_flag       &
+!dave
+#if ( EM_CORE == 1)
      &        ,mut=grid%mut,dnw=grid%dnw                                  & ! FARMS coupling
      &        ,swdown2=grid%swdown2, swddni2=grid%swddni2                 & ! FARMS coupling
      &        ,swddif2=grid%swddif2, swddir2=grid%swddir2                 & ! FARMS coupling
      &        ,swdownc2=grid%swdownc2, swddnic2=grid%swddnic2             & ! FARMS coupling
+#endif
 !BSINGH - For WRFCuP scheme
      &        ,CU_PHYSICS=config_flags%cu_physics                         & !CuP, wig 5-Oct-2006
      &        ,SHALLOWCU_FORCED_RA=config_flags%shallowcu_forced_ra       & !CuP, wig
diff --git a/phys/module_radiation_driver.F b/phys/module_radiation_driver.F
index fc3f4027e1..c28fc9f0b1 100644
--- a/phys/module_radiation_driver.F
+++ b/phys/module_radiation_driver.F
@@ -472,8 +472,8 @@ SUBROUTINE radiation_driver (                                          &
                                                            HBOTR, &
                                                            CUPPT
      ! FARMS coupling
-   REAL, DIMENSION( ims:ime , jms:jme ),  INTENT(IN) ::  MUT
-   REAL , DIMENSION( kms:kme ) , INTENT(IN   ) :: DNW
+   REAL, DIMENSION( ims:ime , jms:jme ),  INTENT(IN), OPTIONAL ::  MUT
+   REAL , DIMENSION( kms:kme ) , INTENT(IN   ), OPTIONAL :: DNW
 
    !BSINGH - For WRFCuP scheme
    REAL, DIMENSION( ims:ime, jms:jme ), OPTIONAL,                 &
@@ -615,7 +615,7 @@ SUBROUTINE radiation_driver (                                          &
 
    REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)  ::   SWDOWN
      ! PAJ: FARMS coupling
-   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT)  ::   SWDOWN2, SWDDNI2, SWDDIF2, SWDDIR2, SWDOWNC2, SWDDNIC2
+   REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT), OPTIONAL  ::   SWDOWN2, SWDDNI2, SWDDIF2, SWDDIR2, SWDOWNC2, SWDDNIC2
 
 ! ------------------------------------------------------------------------------ jararias 2013/08/10 -----------
    REAL, DIMENSION( ims:ime, jms:jme ),  INTENT(OUT) :: swddir, & ! All-sky SW broadband surface direct irradiance
@@ -2745,31 +2745,41 @@ SUBROUTINE radiation_driver (                                          &
  end if
 
    ! Coupling with FARMS
- if (swint_opt == 2) then
-    call wrf_debug(100,'SW surface irradiance calculated with FARMS')
-
-    if (aer_opt == 1) then
-      DO j=jts,jte
-        DO i=its,ite
-          aod5502d(i, j) = aodtot(i, j)
-        ENDDO
-      ENDDO
+!dave
+ if( present(mut      ) .and. &
+     present(dnw      ) .and. &
+     present(swdown2  ) .and. &
+     present(swddir2  ) .and. &
+     present(swddni2  ) .and. &
+     present(swddif2  ) .and. &
+     present(swdownc2 ) .and. &
+     present(swddnic2 ) ) then
+    if (swint_opt == 2) then
+       call wrf_debug(100,'SW surface irradiance calculated with FARMS')
+   
+       if (aer_opt == 1) then
+         DO j=jts,jte
+           DO i=its,ite
+             aod5502d(i, j) = aodtot(i, j)
+           ENDDO
+         ENDDO
+       end if
+   
+       !---------------
+       !$OMP PARALLEL DO   &
+       !$OMP PRIVATE ( ij ,i,j,k,its,ite,jts,jte)
+       do ij = 1,num_tiles
+         its = i_start(ij)
+         ite = i_end(ij)
+         jts = j_start(ij)
+         jte = j_end(ij)
+         call farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, kte, &
+              p8w, albedo, aer_opt, aerssa2d, aerasy2d, aod5502d, angexp2d,  &
+              coszen_loc, qv, qi, qs, qc, re_cloud, re_ice, re_snow,    &
+              julian, mut, dnw, swdown2, swddir2, swddni2, swddif2, swdownc2, swddnic2)
+       enddo
+       !$OMP END PARALLEL DO
     end if
-
-    !---------------
-    !$OMP PARALLEL DO   &
-    !$OMP PRIVATE ( ij ,i,j,k,its,ite,jts,jte)
-    do ij = 1,num_tiles
-      its = i_start(ij)
-      ite = i_end(ij)
-      jts = j_start(ij)
-      jte = j_end(ij)
-      call farms_driver (ims, ime, jms, jme, its, ite, jts, jte, kms, kme, kts, kte, &
-           p8w, albedo, aer_opt, aerssa2d, aerasy2d, aod5502d, angexp2d,  &
-           coszen_loc, qv, qi, qs, qc, re_cloud, re_ice, re_snow,    &
-           julian, mut, dnw, swdown2, swddir2, swddni2, swddif2, swdownc2, swddnic2)
-    enddo
-    !$OMP END PARALLEL DO
  end if
 
      accumulate_lw_select: SELECT CASE(lw_physics)

From 1a39a2615fd3d9facf90ca617517f0f57c1f1ec3 Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Mon, 10 Feb 2020 09:59:29 -0700
Subject: [PATCH 26/29] KLUGE - Option to avoid building RRTMK due to GNU
 problem

TYPE: enhancement

KEYWORDS: GNU, RRTMK

SOURCE: internal

DESCRIPTION OF CHANGES:

Problem:
The GNU compiler versions from 6.* through 8.* issue an internal compiler error on
various RRTMG-based schemes.

Solution:
A modification was introduced in the WRF build to allow the RRTMG-fast version
to skip being built (commit 17b5ac4062010642 with PR #517 "KLUGE: RRTMG FAST +
GNU > 6.3.0 is an internal compiler error"). This same strategy is now used for
the RRTMK scheme.

On a good note ... it looks like GNU verion 9.1.* and later fixes this trouble.

LIST OF MODIFIED FILES:
modified:   arch/postamble
modified:   phys/module_physics_init.F
modified:   phys/module_ra_rrtmg_lwk.F
modified:   phys/module_ra_rrtmg_swk.F
modified:   phys/module_radiation_driver.F
modified:   share/module_check_a_mundo.F

TESTS CONDUCTED:
 - [ ] Waiting to see if this fixes Ming's problem
---
 arch/postamble                 |  1 +
 phys/module_physics_init.F     | 18 +++++++---
 phys/module_ra_rrtmg_lwk.F     | 10 ++++++
 phys/module_ra_rrtmg_swk.F     | 10 ++++++
 phys/module_radiation_driver.F | 64 ++++++++++++++++++++++++----------
 share/module_check_a_mundo.F   | 16 +++++++++
 6 files changed, 97 insertions(+), 22 deletions(-)

diff --git a/arch/postamble b/arch/postamble
index a63454aca3..2684ca9e89 100644
--- a/arch/postamble
+++ b/arch/postamble
@@ -27,6 +27,7 @@ ARCHFLAGS       =    $(COREDEFS) -DIWORDSIZE=$(IWORDSIZE) -DDWORDSIZE=$(DWORDSIZ
                       -DKEEP_INT_AROUND \
                       -DLIMIT_ARGS \
                       -DBUILD_RRTMG_FAST=1 \
+                      -DBUILD_RRTMK=1 \
                       -DSHOW_ALL_VARS_USED=0 \
                       -DCONFIG_BUF_LEN=$(CONFIG_BUF_LEN) \
                       -DMAX_DOMAINS_F=$(MAX_DOMAINS) \
diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F
index f572bc749c..27797105a8 100644
--- a/phys/module_physics_init.F
+++ b/phys/module_physics_init.F
@@ -887,14 +887,18 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 #if( BUILD_RRTMG_FAST == 1)
          (config_flags%ra_lw_physics .eq. RRTMG_LWSCHEME_FAST ) .or. &
 #endif
-         (config_flags%ra_lw_physics .eq. goddardlwscheme ) .or. &
-         (config_flags%ra_lw_physics .eq. RRTMK_LWSCHEME  ) ) .and. &
+#if( BUILD_RRTMK == 1)
+         (config_flags%ra_lw_physics .eq. RRTMK_LWSCHEME  ) .or. &
+#endif
+         (config_flags%ra_lw_physics .eq. goddardlwscheme ) ) .and. &
        ( (config_flags%ra_sw_physics .eq. RRTMG_SWSCHEME ) .or. &
 #if( BUILD_RRTMG_FAST == 1)
          (config_flags%ra_sw_physics .eq. RRTMG_SWSCHEME_FAST ) .or. &
 #endif
-         (config_flags%ra_sw_physics .eq. goddardswscheme ) .or. &
-         (config_flags%ra_sw_physics .eq. RRTMK_SWSCHEME ) ) .and. &
+#if( BUILD_RRTMK == 1)
+         (config_flags%ra_sw_physics .eq. RRTMK_SWSCHEME ) .or. &
+#endif
+         (config_flags%ra_sw_physics .eq. goddardswscheme ) ) .and. &
         (config_flags%mp_physics  .eq. THOMPSON .or.        &
          config_flags%mp_physics  .eq. THOMPSONAERO .or.    &
          config_flags%mp_physics  .eq. NSSL_2MOM .or.       &
@@ -1893,8 +1897,10 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
    USE module_ra_rrtmg_swf  , ONLY : rrtmg_swinit_fast
 #endif
 #if (EM_CORE == 1)
+# if( BUILD_RRTMK == 1)
    USE module_ra_rrtmg_lwk  , ONLY : rrtmg_lwinit_k
    USE module_ra_rrtmg_swk  , ONLY : rrtmg_swinit_k
+# endif
 #endif
    USE module_ra_cam       , ONLY : camradinit
    USE module_ra_cam_support , ONLY : oznini
@@ -2103,6 +2109,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
 
             aclwalloc = .true.
 #if ( EM_CORE == 1 )
+# if( BUILD_RRTMK == 1)
         CASE (RRTMK_LWSCHEME)  
 
              CALL rrtmg_lwinit_k(                           &
@@ -2112,6 +2119,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
                            its, ite, jts, jte, kts, kte     )
 
              aclwalloc = .true.
+# endif
 #endif
 
 #if( BUILD_RRTMG_FAST == 1)
@@ -2216,6 +2224,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
              acswalloc = .true.
 
 #if ( EM_CORE == 1 )
+# if( BUILD_RRTMK == 1)
         CASE (RRTMK_SWSCHEME)
 
              CALL rrtmg_swinit_k(                           &
@@ -2225,6 +2234,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
                            its, ite, jts, jte, kts, kte     )
 
              acswalloc = .true.
+# endif
 #endif
 
 
diff --git a/phys/module_ra_rrtmg_lwk.F b/phys/module_ra_rrtmg_lwk.F
index dc4acd47c1..3a3bd72653 100644
--- a/phys/module_ra_rrtmg_lwk.F
+++ b/phys/module_ra_rrtmg_lwk.F
@@ -1,3 +1,12 @@
+#if( BUILD_RRTMK != 1)
+      MODULE module_ra_rrtmg_lwk
+      CONTAINS
+      SUBROUTINE rrtmg_lw
+         REAL :: dummy
+         dummy = 1
+      END SUBROUTINE rrtmg_lw
+      END MODULE module_ra_rrtmg_lwk
+#else
 !
 ! module module_ra_rrtmg_lw
 !
@@ -13917,3 +13926,4 @@ end subroutine reicalc
 !-------------------------------------------------------------------------------
    end module module_ra_rrtmg_lwk
 !-------------------------------------------------------------------------------
+#endif
diff --git a/phys/module_ra_rrtmg_swk.F b/phys/module_ra_rrtmg_swk.F
index f4cd3398ba..a03d9ee068 100644
--- a/phys/module_ra_rrtmg_swk.F
+++ b/phys/module_ra_rrtmg_swk.F
@@ -1,3 +1,12 @@
+#if( BUILD_RRTMK != 1)
+      MODULE module_ra_rrtmg_swk
+      CONTAINS
+      SUBROUTINE rrtmg_sw
+         REAL :: dummy
+         dummy = 1
+      END SUBROUTINE rrtmg_sw
+      END MODULE module_ra_rrtmg_swk
+#else
 !
 !-------------------------------------------------------------------------------
    module parrrsw_k
@@ -12064,3 +12073,4 @@ end subroutine sw_kgb29
 !-------------------------------------------------------------------------------
    end module module_ra_rrtmg_swk
 !-------------------------------------------------------------------------------
+#endif
diff --git a/phys/module_radiation_driver.F b/phys/module_radiation_driver.F
index fc3f4027e1..a143449f94 100644
--- a/phys/module_radiation_driver.F
+++ b/phys/module_radiation_driver.F
@@ -186,7 +186,9 @@ SUBROUTINE radiation_driver (                                          &
 #if( BUILD_RRTMG_FAST == 1)
                                        ,RRTMG_LWSCHEME_FAST, RRTMG_SWSCHEME_FAST  &
 #endif
+#if( BUILD_RRTMK == 1)
                                        ,RRTMK_LWSCHEME, RRTMK_SWSCHEME  & 
+#endif
                                        ,SWRADSCHEME, GSFCSWSCHEME       &
                                        ,GFDLSWSCHEME, CAMLWSCHEME, CAMSWSCHEME &
                                        ,HELDSUAREZ                      &
@@ -227,7 +229,9 @@ SUBROUTINE radiation_driver (                                          &
    USE module_ra_rrtmg_lwf  , ONLY : rrtmg_lwrad_fast
    USE module_ra_rrtmg_swf  , ONLY : rrtmg_swrad_fast
 #endif
+#if( BUILD_RRTMK == 1)
    USE module_ra_rrtmg_swk  , ONLY : rad_rrtmg_driver
+#endif
    USE module_ra_cam        , ONLY : camrad
    USE module_ra_gfdleta    , ONLY : etara
 #if ( HWRF == 1 )
@@ -1026,11 +1030,14 @@ SUBROUTINE radiation_driver (                                          &
               allocate(ssaaer_sw(ims:ime, kms:kme, jms:jme, 1:11))
               allocate(asyaer_sw(ims:ime, kms:kme, jms:jme, 1:11))
 
-           case(RRTMG_SWSCHEME,&
+           case(RRTMG_SWSCHEME &
 #if( BUILD_RRTMG_FAST == 1)
-                RRTMG_SWSCHEME_FAST,&
+                ,RRTMG_SWSCHEME_FAST &
+#endif
+#if( BUILD_RRTMK == 1)
+                ,RRTMK_SWSCHEME &
 #endif
-                RRTMK_SWSCHEME)
+                )
               allocate(tauaer_sw(ims:ime, kms:kme, jms:jme, 1:14))
               allocate(ssaaer_sw(ims:ime, kms:kme, jms:jme, 1:14))
               allocate(asyaer_sw(ims:ime, kms:kme, jms:jme, 1:14))
@@ -1042,11 +1049,14 @@ SUBROUTINE radiation_driver (                                          &
 ! Allocate aerosol arrays used by aer_opt = 3 option, and explicit AOD from QNWFA+QNIFA   (Trude)
    IF (PRESENT(f_qnwfa) .AND. PRESENT(f_qnifa) .AND. PRESENT(taod5503d) .AND.  PRESENT(taod5502d)) THEN
       IF (F_QNWFA .AND. aer_opt.eq.3 .AND.                              &
-                 (sw_physics.eq.RRTMG_SWSCHEME .OR.                     &
+                 (sw_physics.eq.RRTMG_SWSCHEME                          &
 #if( BUILD_RRTMG_FAST == 1)
-                  sw_physics.eq.RRTMG_SWSCHEME_FAST .OR.                &
+                  .OR. sw_physics.eq.RRTMG_SWSCHEME_FAST                &
 #endif
-                  sw_physics.eq.RRTMK_SWSCHEME )) THEN
+#if( BUILD_RRTMK == 1)
+                  .OR. sw_physics.eq.RRTMK_SWSCHEME                     &
+#endif
+                  )) THEN
          CALL wrf_debug (150, 'DEBUG-GT:  computing 3D AOD from QNWFA+QNIFA')
 
          allocate(tauaer_sw(ims:ime, kms:kme, jms:jme, 1:14))
@@ -1921,6 +1931,7 @@ SUBROUTINE radiation_driver (                                          &
                   LWDNFLX=LWDNFLX,LWDNFLXC=LWDNFLXC,                &
                   mp_physics=mp_physics                             )
 
+#if( BUILD_RRTMK == 1)
         CASE (RRTMK_LWSCHEME)
 
            IF ( PRESENT(F_QNC) .AND. PRESENT(QNC_CURR) ) THEN
@@ -1948,6 +1959,7 @@ SUBROUTINE radiation_driver (                                          &
              ELSE
                 call wrf_error_fatal('Can not call RRTMG-K. Missing QNC field.')
              ENDIF
+#endif
 
 
 #if( BUILD_RRTMG_FAST == 1)
@@ -2098,11 +2110,14 @@ SUBROUTINE radiation_driver (                                          &
      IF ( aer_opt .EQ. 2 ) THEN
      swrad_aerosol_select2: select case(sw_physics)
 
-        case(RRTMG_SWSCHEME,&
+        case(RRTMG_SWSCHEME &
 #if( BUILD_RRTMG_FAST == 1)
-             RRTMG_SWSCHEME_FAST,&
+             ,RRTMG_SWSCHEME_FAST &
+#endif
+#if( BUILD_RRTMK == 1)
+             ,RRTMK_SWSCHEME &
 #endif
-             RRTMK_SWSCHEME)
+            )
            call wrf_debug(100, 'call calc_aerosol_rrtmg_sw')
            call calc_aerosol_rrtmg_sw(ht,dz8w,p,t,qv,aer_type,aer_aod550_opt,aer_angexp_opt,    &
                                       aer_ssa_opt,aer_asy_opt,aer_aod550_val,aer_angexp_val,    &
@@ -2126,11 +2141,14 @@ SUBROUTINE radiation_driver (                                          &
 
      IF (PRESENT(f_qnwfa) .AND. PRESENT(f_qnifa)) THEN
        IF (F_QNWFA .AND. aer_opt.eq.3 .AND.                             &
-                             (sw_physics.eq.RRTMG_SWSCHEME .OR.         &
+                             (sw_physics.eq.RRTMG_SWSCHEME              &
 #if( BUILD_RRTMG_FAST == 1)
-                              sw_physics.eq.RRTMG_SWSCHEME_FAST .OR.    &
+                              .OR. sw_physics.eq.RRTMG_SWSCHEME_FAST .OR.    &
 #endif
-                              sw_physics.eq.RRTMK_SWSCHEME )) THEN
+#if( BUILD_RRTMK == 1)
+                              .OR. sw_physics.eq.RRTMK_SWSCHEME &
+#endif
+                             )) THEN
          call wrf_debug(100, 'call calc_aerosol_rrtmg_sw with 3D AOD values')
          call calc_aerosol_rrtmg_sw(ht,dz8w,p,t,qv,taer_type,taer_aod550_opt,taer_angexp_opt,  &
                                     taer_ssa_opt,taer_asy_opt,aer_aod550_val,aer_angexp_val,   &
@@ -2426,6 +2444,7 @@ SUBROUTINE radiation_driver (                                          &
              ENDDO
              ENDDO
 
+#if( BUILD_RRTMK == 1)
         CASE (RRTMK_SWSCHEME)
   
              DO j=jts,jte
@@ -2435,6 +2454,7 @@ SUBROUTINE radiation_driver (                                          &
              ENDDO
              ENDDO
              ENDDO
+#endif
 
 #if( BUILD_RRTMG_FAST == 1)
         CASE (RRTMG_SWSCHEME_FAST)
@@ -2634,7 +2654,9 @@ SUBROUTINE radiation_driver (                                          &
            .AND. (sw_physics .NE. RRTMG_SWSCHEME_FAST) &
 #endif
            .AND. (sw_physics .NE. FLGSWSCHEME) .AND. (sw_physics .NE. CAMSWSCHEME) &  ! amontornes-bcodina (2014-04-20)
+#if( BUILD_RRTMK == 1)
            .AND. (sw_physics .NE. RRTMK_SWSCHEME) &
+#endif
            .AND. (sw_physics .ne. GODDARDSWSCHEME)) THEN
         DO j=jts,jte
            DO i=its,ite
@@ -2775,11 +2797,14 @@ SUBROUTINE radiation_driver (                                          &
      accumulate_lw_select: SELECT CASE(lw_physics)
 
      CASE (CAMLWSCHEME,& 
-           RRTMG_LWSCHEME,&
+           RRTMG_LWSCHEME &
 #if( BUILD_RRTMG_FAST == 1)
-           RRTMG_LWSCHEME_FAST,&
+           ,RRTMG_LWSCHEME_FAST &
 #endif
-           RRTMK_LWSCHEME)
+#if( BUILD_RRTMK == 1)
+           ,RRTMK_LWSCHEME &
+#endif
+          )
    IF(PRESENT(LWUPTC))THEN
 !  NMM calls the driver every RADT time steps, EM calls every DT
 #if (EM_CORE == 1)
@@ -2817,11 +2842,14 @@ SUBROUTINE radiation_driver (                                          &
      accumulate_sw_select: SELECT CASE(sw_physics)
 
      CASE (CAMSWSCHEME,&
-           RRTMG_SWSCHEME,&
+           RRTMG_SWSCHEME &
 #if( BUILD_RRTMG_FAST == 1)
-           RRTMG_SWSCHEME_FAST,&
+           ,RRTMG_SWSCHEME_FAST &
+#endif
+#if( BUILD_RRTMK == 1)
+           ,RRTMK_SWSCHEME &
 #endif
-           RRTMK_SWSCHEME)
+          )
    IF(PRESENT(SWUPTC))THEN
 !  NMM calls the driver every RADT time steps, EM calls every DT
 #if (EM_CORE == 1)
diff --git a/share/module_check_a_mundo.F b/share/module_check_a_mundo.F
index 806655c48a..b08fa45d07 100644
--- a/share/module_check_a_mundo.F
+++ b/share/module_check_a_mundo.F
@@ -2229,6 +2229,22 @@ END FUNCTION bep_bem_nbui_max
       END IF
 #endif
 
+!-----------------------------------------------------------------------
+!  If the RRTMG KOREA schemes are requested, check that the code with
+!  built to use them.
+!-----------------------------------------------------------------------
+
+#if( BUILD_RRTMK != 1)
+      IF ( ( model_config_rec % ra_lw_physics(1) .EQ. RRTMK_LWSCHEME_FAST )  .OR. &
+           ( model_config_rec % ra_sw_physics(1) .EQ. RRTMK_SWSCHEME_FAST )  ) THEN
+         wrf_err_message = '--- ERROR: RRTM Korea schemes must be built with a default compile-time flag'
+         CALL wrf_message ( wrf_err_message )
+         wrf_err_message = '--- ERROR: Run ./clean -a, ./configure, ./compile scripts again'
+         CALL wrf_message ( wrf_err_message )
+         count_fatal_error = count_fatal_error + 1
+      END IF
+#endif
+
 !-----------------------------------------------------------------------
 !  Set the namelist parameter o3input to 0 for the radiation schemes other
 !  than RRTMG_LWSCHEME and RRTMG_SWSCHEME.

From 648433f64e27755c388495e65b924f3dd6294f5a Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Mon, 10 Feb 2020 11:30:24 -0700
Subject: [PATCH 27/29] KOREA -> KIAPS

---
 share/module_check_a_mundo.F | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/share/module_check_a_mundo.F b/share/module_check_a_mundo.F
index b08fa45d07..17bfef5b30 100644
--- a/share/module_check_a_mundo.F
+++ b/share/module_check_a_mundo.F
@@ -2230,14 +2230,14 @@ END FUNCTION bep_bem_nbui_max
 #endif
 
 !-----------------------------------------------------------------------
-!  If the RRTMG KOREA schemes are requested, check that the code with
+!  If the RRTMG KIAPS schemes are requested, check that the code with
 !  built to use them.
 !-----------------------------------------------------------------------
 
 #if( BUILD_RRTMK != 1)
       IF ( ( model_config_rec % ra_lw_physics(1) .EQ. RRTMK_LWSCHEME_FAST )  .OR. &
            ( model_config_rec % ra_sw_physics(1) .EQ. RRTMK_SWSCHEME_FAST )  ) THEN
-         wrf_err_message = '--- ERROR: RRTM Korea schemes must be built with a default compile-time flag'
+         wrf_err_message = '--- ERROR: RRTMG-based KIAPS schemes must be built with a default compile-time flag'
          CALL wrf_message ( wrf_err_message )
          wrf_err_message = '--- ERROR: Run ./clean -a, ./configure, ./compile scripts again'
          CALL wrf_message ( wrf_err_message )

From 4b9b973aced488059fb56d2d6c321e5284e6723c Mon Sep 17 00:00:00 2001
From: Dave Gill 
Date: Mon, 10 Feb 2020 11:49:58 -0700
Subject: [PATCH 28/29] Fix name RRTMK_LWSCHEME_FAST -> RRTMK_LWSCHEME (and SW,
 too) - thanks Wei

---
 share/module_check_a_mundo.F | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/share/module_check_a_mundo.F b/share/module_check_a_mundo.F
index 17bfef5b30..fc9c049ef6 100644
--- a/share/module_check_a_mundo.F
+++ b/share/module_check_a_mundo.F
@@ -2235,8 +2235,8 @@ END FUNCTION bep_bem_nbui_max
 !-----------------------------------------------------------------------
 
 #if( BUILD_RRTMK != 1)
-      IF ( ( model_config_rec % ra_lw_physics(1) .EQ. RRTMK_LWSCHEME_FAST )  .OR. &
-           ( model_config_rec % ra_sw_physics(1) .EQ. RRTMK_SWSCHEME_FAST )  ) THEN
+      IF ( ( model_config_rec % ra_lw_physics(1) .EQ. RRTMK_LWSCHEME )  .OR. &
+           ( model_config_rec % ra_sw_physics(1) .EQ. RRTMK_SWSCHEME )  ) THEN
          wrf_err_message = '--- ERROR: RRTMG-based KIAPS schemes must be built with a default compile-time flag'
          CALL wrf_message ( wrf_err_message )
          wrf_err_message = '--- ERROR: Run ./clean -a, ./configure, ./compile scripts again'

From d5e1d1292cc544858049fc8e51d0d300152cb3df Mon Sep 17 00:00:00 2001
From: Ming Chen 
Date: Mon, 10 Feb 2020 12:58:06 -0700
Subject: [PATCH 29/29] remove  white space in several codes

---
 dyn_em/solve_em.F                 | 236 +++++++++---------
 phys/module_diag_misc.F           |  38 +--
 phys/module_diagnostics_driver.F  |  88 +++----
 phys/module_microphysics_driver.F | 130 +++++-----
 phys/module_physics_init.F        | 390 +++++++++++++++---------------
 5 files changed, 441 insertions(+), 441 deletions(-)

diff --git a/dyn_em/solve_em.F b/dyn_em/solve_em.F
index 7866c67502..1e7ed9439e 100644
--- a/dyn_em/solve_em.F
+++ b/dyn_em/solve_em.F
@@ -117,17 +117,17 @@ SUBROUTINE solve_em ( grid , config_flags  &
    LOGICAL                         :: specified_bdy, channel_bdy
 
    REAL                            :: t_new, time_duration_of_lbcs
-
+   
    ! Changes in tendency at this timestep
    real ,DIMENSION(grid%sm31:grid%em31,grid%sm32:grid%em32,grid%sm33:grid%em33) :: h_tendency, &
                                                                                    z_tendency
-
+                                                                                   
    ! Whether advection should produce decoupled horizontal and vertical advective tendency outputs
    LOGICAL                        :: tenddec
-
+   
    ! Flag for producing diagnostic fields (e.g., radar reflectivity)
    LOGICAL                        :: diag_flag
-
+   
 #if (WRF_CHEM == 1)
    ! Index cross-referencing array for tendency accumulation
    INTEGER, DIMENSION( num_chem ) :: adv_ct_indices
@@ -142,7 +142,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! time.  Potential problem on stack-limited architectures: increases
 ! amount of data on program stack by making these automatic arrays.
 
-   INTEGER :: rc
+   INTEGER :: rc 
    INTEGER :: number_of_small_timesteps, rk_step
    INTEGER :: klevel,ijm,ijp,i,j,k,size1,size2    ! for prints/plots only
    INTEGER :: idum1, idum2, dynamics_option
@@ -189,27 +189,27 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 !
 ! solve_em is the main driver for advancing a grid a single timestep.
-! It is a mediation-layer routine -> DM and SM calls are made where
-! needed for parallel processing.
+! It is a mediation-layer routine -> DM and SM calls are made where 
+! needed for parallel processing.  
 !
 ! solve_em can integrate the equations using 3 time-integration methods
-!
+!      
 !    - 3rd order Runge-Kutta time integration (recommended)
-!
+!      
 !    - 2nd order Runge-Kutta time integration
-!
+!      
 ! The main sections of solve_em are
-!
+!     
 ! (1) Runge-Kutta (RK) loop
-!
+!     
 ! (2) Non-timesplit physics (i.e., tendencies computed for updating
 !     model state variables during the first RK sub-step (loop)
-!
+!     
 ! (3) Small (acoustic, sound) timestep loop - within the RK sub-steps
-!
+!     
 ! (4) scalar advance for moist and chem scalar variables (and TKE)
 !     within the RK sub-steps.
-!
+!     
 ! (5) time-split physics (after the RK step), currently this includes
 !     only microphyics
 !
@@ -234,7 +234,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              ipsx, ipex, jpsx, jpex, kpsx, kpex,    &
                              imsy, imey, jmsy, jmey, kmsy, kmey,    &
                              ipsy, ipey, jpsy, jpey, kpsy, kpey )
-
+ 
    CALL get_ijk_from_subgrid (  grid ,                   &
                              sids, side, sjds, sjde, skds, skde,    &
                              sims, sime, sjms, sjme, skms, skme,    &
@@ -393,7 +393,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    dts = grid%dt/float(num_sound_steps)
 
    IF (config_flags%use_adaptive_time_step) THEN
-
+  
      CALL get_wrf_debug_level( debug_level )
      IF ((config_flags%time_step < 0) .AND. (debug_level.GE.50)) THEN
 #ifdef DM_PARALLEL
@@ -456,7 +456,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP END PARALLEL DO
 
      !  Now that we have initialized the moist_old values with P_Qv for
-     !  computing a moist t_tendf after rk_step part2, fill in the halo
+     !  computing a moist t_tendf after rk_step part2, fill in the halo 
      !  and period boundaries.
 
 #if ( defined( DM_PARALLEL ) && ( ! defined( STUBMPI ) ) )
@@ -509,7 +509,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    !  each part of the timestep
 
      dtm = grid%dt
-     IF ( rk_order == 1 ) THEN
+     IF ( rk_order == 1 ) THEN   
 
        write(wrf_err_message,*)' leapfrog removed, error exit for dynamics_option = ',dynamics_option
        CALL wrf_error_fatal( wrf_err_message )
@@ -550,7 +550,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      END IF
 
 !  Ensure that polar meridional velocity is zero
-     IF (config_flags%polar) THEN
+     IF (config_flags%polar) THEN 
        !$OMP PARALLEL DO   &
        !$OMP PRIVATE ( ij )
        DO ij = 1 , grid%num_tiles
@@ -570,7 +570,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
        !$OMP END PARALLEL DO
      END IF
 !
-!  Time level t is in the *_2 variable in the first part
+!  Time level t is in the *_2 variable in the first part 
 !  of the step, and in the *_1 variable after the predictor.
 !  the latest predicted values are stored in the *_2 variables.
 !
@@ -605,15 +605,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #ifdef DM_PARALLEL
 !-----------------------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the
-!         fact that we are carrying the uncoupled variables
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
 !         as state variables in the mass coordinate model, as
 !         opposed to the coupled variables as in the height
 !         coordinate model.
 !
 !                           * * * * *
 !         *        * * *    * * * * *
-!       * + *      * + *    * * + * *
+!       * + *      * + *    * * + * * 
 !         *        * * *    * * * * *
 !                           * * * * *
 !
@@ -636,7 +636,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_A.inc"
 #endif
 
-! set boundary conditions on variables
+! set boundary conditions on variables 
 ! from big_step_prep for use in big_step_proc
 
 #ifdef DM_PARALLEL
@@ -651,7 +651,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
        CALL wrf_debug ( 200 , ' call rk_phys_bc_dry_1' )
 
-       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      &
+       CALL rk_phys_bc_dry_1( config_flags, grid%ru, grid%rv, grid%rw, grid%ww,      & 
                               grid%muu, grid%muv, grid%mut, grid%php, grid%alt, grid%p,        &
                               ids, ide, jds, jde, kds, kde,      &
                               ims, ime, jms, jme, kms, kme,      &
@@ -674,7 +674,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               grid%j_start(ij), grid%j_end(ij),        &
                               k_start, k_end                )
 
-       IF (config_flags%polar) THEN
+       IF (config_flags%polar) THEN 
 
 !-------------------------------------------------------
 ! lat-lon grid pole-point (v) specification (extrapolate v, rv to the pole)
@@ -686,14 +686,14 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               grid%i_start(ij), grid%i_end(ij), &
                               grid%j_start(ij), grid%j_end(ij), &
                               k_start, k_end                   )
-
+ 
          CALL pole_point_bc ( grid%v_2,                      &
                               ids, ide, jds, jde, kds, kde,     &
                               ims, ime, jms, jme, kms, kme,     &
                               grid%i_start(ij), grid%i_end(ij), &
                               grid%j_start(ij), grid%j_end(ij), &
                               k_start, k_end                   )
-
+ 
 !-------------------------------------------------------
 ! end lat-lon grid pole-point (v) specification
 !-------------------------------------------------------
@@ -778,8 +778,8 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              , cu_act_flag , hol , th_phy       &
                              , pi_phy , p_phy , grid%t_phy      &
                              , dz8w , p8w , t8w                 &
-                             , nba_mij, num_nba_mij             & !JDM
-                             , nba_rij, num_nba_rij             & !JDM
+                             , nba_mij, num_nba_mij             & !JDM 
+                             , nba_rij, num_nba_rij             & !JDM  
                              , ids, ide, jds, jde, kds, kde     &
                              , ims, ime, jms, jme, kms, kme     &
                              , ips, ipe, jps, jpe, kps, kpe     &
@@ -840,7 +840,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
            grid%max_vert_cfl = max_vert_cfl_tmp(ij)
          ENDIF
        END DO
-
+     
        IF (grid%max_horiz_cfl .GT. grid%max_cfl_val) THEN
          grid%max_cfl_val = grid%max_horiz_cfl
        ENDIF
@@ -854,7 +854,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP PRIVATE ( ij )
      DO ij = 1 , grid%num_tiles
 
-       IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN
+       IF ( (config_flags%specified .or. config_flags%nested) .and. ( rk_step == 1 ) ) THEN 
 
          CALL relax_bdy_dry ( config_flags,                                &
                               grid%u_save, grid%v_save, ph_save, grid%t_save,             &
@@ -899,7 +899,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                             grid%j_start(ij), grid%j_end(ij),                &
                             k_start, k_end                                  )
 
-       IF( config_flags%specified .or. config_flags%nested ) THEN
+       IF( config_flags%specified .or. config_flags%nested ) THEN 
          CALL spec_bdy_dry ( config_flags,                                    &
                              grid%ru_tend, grid%rv_tend, ph_tend, t_tend,               &
                              rw_tend, mu_tend,                                &
@@ -927,11 +927,11 @@ SUBROUTINE solve_em ( grid , config_flags  &
        ENDIF
 
 !---------------------------------------------------------------------------------------------
-! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS
+! KRS 9/12/2012: Inserted new IF block calls to spec_bdy_dry_perturb. If peturb_bdy=1, SKEBS 
 ! pattern passed in for perturbing the specified boundry conditions.  If peturb_bdy=2, user
 ! must provide pattern.  mu_2, mub, msf* also passed in for coupling needed for tendecies.
 !---------------------------------------------------------------------------------------------
-       IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN
+       IF( config_flags%specified .and. config_flags%perturb_bdy==1 ) THEN 
          CALL spec_bdy_dry_perturb ( config_flags,                                 &
                              grid%ru_tend, grid%rv_tend, t_tend,                   &
                              grid%mu_2, grid%mub, grid%c1h, grid%c2h,              &
@@ -945,7 +945,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                &
                              grid%j_start(ij), grid%j_end(ij),                &
                              k_start, k_end                                  )
-
+     
        ENDIF
 
        IF( config_flags%specified .and. config_flags%perturb_bdy==2 ) THEN
@@ -962,7 +962,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                &
                              grid%j_start(ij), grid%j_end(ij),                &
                              k_start, k_end                                  )
-
+  
        ENDIF
 
      END DO
@@ -973,15 +973,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 ! (3) Small (acoustic,sound) steps.
 !
-!    Several acoustic steps are taken each RK pass.  A small step
-!    sequence begins with calculating perturbation variables
-!    and coupling them to the column dry-air-mass mu
+!    Several acoustic steps are taken each RK pass.  A small step 
+!    sequence begins with calculating perturbation variables 
+!    and coupling them to the column dry-air-mass mu 
 !    (call to small_step_prep).  This is followed by computing
 !    coefficients for the vertically implicit part of the
-!    small timestep (call to calc_coef_w).
+!    small timestep (call to calc_coef_w).  
 !
 !    The small steps are taken
-!    in the named loop "small_steps:".  In the small_steps loop, first
+!    in the named loop "small_steps:".  In the small_steps loop, first 
 !    the horizontal momentum (u and v) are advanced (call to advance_uv),
 !    next mu and theta are advanced (call to advance_mu_t) followed by
 !    advancing w and the geopotential (call to advance_w).  Diagnostic
@@ -1001,7 +1001,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
     ! Calculate coefficients for the vertically implicit acoustic/gravity wave
     ! integration.  We only need calculate these for the first pass through -
     ! the predictor step.  They are reused as is for the corrector step.
-    ! For third-order RK, we need to recompute these after the first
+    ! For third-order RK, we need to recompute these after the first 
     ! predictor because we may have changed the small timestep -> grid%dts.
 
        CALL wrf_debug ( 200 , ' call small_step_prep ' )
@@ -1025,7 +1025,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                              grid%i_start(ij), grid%i_end(ij),                        &
                              grid%j_start(ij), grid%j_end(ij),                        &
                              k_start    , k_end                                       )
-
+ 
        CALL calc_p_rho( grid%al, grid%p, grid%ph_2,                 &
                         grid%alt, grid%t_2, grid%t_save, c2a, pm1,  &
                         grid%mu_2, grid%muts,                       &
@@ -1062,15 +1062,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #ifdef DM_PARALLEL
 !-----------------------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
-!  Note:  the small size of this halo exchange reflects the
-!         fact that we are carrying the uncoupled variables
+!  Note:  the small size of this halo exchange reflects the 
+!         fact that we are carrying the uncoupled variables 
 !         as state variables in the mass coordinate model, as
 !         opposed to the coupled variables as in the height
 !         coordinate model.
 !
 !                              * * * * *
 !            *        * * *    * * * * *
-!          * + *      * + *    * * + * *
+!          * + *      * + *    * * + * * 
 !            *        * * *    * * * * *
 !                              * * * * *
 !
@@ -1185,7 +1185,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_END(set_phys_bc2_tim)
      small_steps : DO iteration = 1 , number_of_small_timesteps
 
-       ! Boundary condition time (or communication time).
+       ! Boundary condition time (or communication time).  
 #ifdef DM_PARALLEL
 #      include "PERIOD_BDY_EM_B.inc"
 #endif
@@ -1363,7 +1363,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                 ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
 
          grid%muts = grid%mut + grid%mu_2  ! reset muts using filtered mu_2
-
+ 
        END IF
 
 !-----------------------------------------------------------
@@ -1644,7 +1644,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
        CALL wrf_debug ( 200 , ' call rk_small_finish' )
 
-      ! change time-perturbation variables back to
+      ! change time-perturbation variables back to 
       ! full perturbation variables.
       ! first get updated mu at u and v points
 
@@ -1661,7 +1661,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
        CALL small_step_finish( grid%u_2, grid%u_1, grid%v_2, grid%v_1, grid%w_2, grid%w_1,     &
                                grid%t_2, grid%t_1, grid%ph_2, grid%ph_1, grid%ww, ww1,    &
                                grid%mu_2, grid%mu_1,                       &
-                               grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs,  &
+                               grid%mut, grid%muts, grid%muu, grid%muus, grid%muv, grid%muvs,  & 
                                grid%c1h, grid%c2h, grid%c1f, grid%c2f, &
                                grid%c3h, grid%c4h, grid%c3f, grid%c4f, &
                                grid%u_save, grid%v_save, w_save,           &
@@ -1716,7 +1716,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                  ips, ipe, jps, jpe,                &
                                  grid%i_start(ij), grid%i_end(ij),  &
                                  grid%j_start(ij), grid%j_end(ij) )
-
+ 
        END IF
 
 BENCH_END(small_step_finish_tim)
@@ -1725,7 +1725,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      !$OMP END PARALLEL DO
 
 !-----------------------------------------------------------
-!  polar filter for full dynamics variables and time-averaged mass fluxes
+!  polar filter for full dynamics variables and time-averaged mass fluxes 
 !-----------------------------------------------------------
 
      IF (config_flags%polar) THEN
@@ -1758,7 +1758,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
      END IF
 
 !-----------------------------------------------------------
-!  end polar filter for full dynamics variables and time-averaged mass fluxes
+!  end polar filter for full dynamics variables and time-averaged mass fluxes 
 !-----------------------------------------------------------
 
 !-----------------------------------------------------------------------
@@ -1869,7 +1869,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #else
          WRITE(wrf_err_message,*)'cannot use pd scheme with RSL - use RSL-LITE'
          CALL wrf_error_fatal(TRIM(wrf_err_message))
-#endif
+#endif   
   endif
 #endif
 
@@ -1951,7 +1951,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                         grid%i_start(ij), grid%i_end(ij),                &
                                         grid%j_start(ij), grid%j_end(ij),                &
                                         k_start    , k_end                              )
-             END DO
+             END DO 
            ENDIF
          END DO
          !$OMP END PARALLEL DO
@@ -2013,7 +2013,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                         grid%i_start(ij), grid%i_end(ij),                &
                                         grid%j_start(ij), grid%j_end(ij),                &
                                         k_start    , k_end                              )
-             END DO
+             END DO 
            ENDIF
          END DO
          !$OMP END PARALLEL DO
@@ -2083,11 +2083,11 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!          * * * * *
-!          * * * * *
-!          * * + * *
-!          * * * * *
-!          * * * * *
+!          * * * * *            
+!          * * * * *            
+!          * * + * *            
+!          * * * * *            
+!          * * * * *            
 !
 ! ru_m         x
 ! rv_m         x
@@ -2108,7 +2108,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !    For the moist and chem variables, each one is advanced
 !    individually, using named loops "moist_variable_loop:"
 !    and "chem_variable_loop:".  Each RK substep begins by
-!    calculating the advective tendency, and, for the first RK step,
+!    calculating the advective tendency, and, for the first RK step, 
 !    3D mixing (calling rk_scalar_tend) followed by an update
 !    of the scalar (calling rk_update_scalar).
 !

@@ -2132,7 +2132,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                tenddec = .false.
 
 BENCH_START(rk_scalar_tend_tim)
-               CALL rk_scalar_tend (  im, im, config_flags, tenddec,         &
+               CALL rk_scalar_tend (  im, im, config_flags, tenddec,         & 
                            rk_step, dt_rk,                                   &
                            grid%ru_m, grid%rv_m, grid%ww_m,                  &
                            grid%muts, grid%mub, grid%mu_1,                   &
@@ -2141,10 +2141,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
                            moist_old(ims,kms,jms,im),                        &
                            moist(ims,kms,jms,im),                            &
                            moist_tend(ims,kms,jms,im),                       &
-                           advect_tend,h_tendency,z_tendency,grid%rqvften,   &
+                           advect_tend,h_tendency,z_tendency,grid%rqvften,   & 
                            grid%qv_base, .true., grid%fnm, grid%fnp,         &
                            grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,&
-                           grid%msfvy, grid%msftx,grid%msfty,                &
+                           grid%msfvy, grid%msftx,grid%msfty,                & 
                            grid%rdx, grid%rdy, grid%rdn, grid%rdnw, grid%khdif, &
                            grid%kvdif, grid%xkhh,                            &
                            grid%diff_6th_opt, grid%diff_6th_factor,          &
@@ -2160,7 +2160,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
                IF( rk_step == 1 .AND. config_flags%use_q_diabatic == 1 )THEN
                IF( im.eq.p_qv .or. im.eq.p_qc )THEN
-                   CALL q_diabatic_add  ( im, im,            &
+                   CALL q_diabatic_add  ( im, im,            & 
                            dt_rk, grid%mut,                  &
                            grid%c1h, grid%c2h,               &
                            grid%qv_diabatic,                 &
@@ -2177,10 +2177,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_END(rk_scalar_tend_tim)
 
 BENCH_START(rlx_bdy_scalar_tim)
-               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN
+               IF( ( config_flags%specified .or. config_flags%nested ) .and. rk_step == 1 ) THEN 
                  IF ( im .EQ. P_QV .OR. config_flags%nested .OR. &
                     ( config_flags%specified .AND. config_flags%have_bcs_moist ) ) THEN
-                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            &
+                   CALL relax_bdy_scalar ( moist_tend(ims,kms,jms,im),            & 
                                      moist(ims,kms,jms,im),  grid%mut,         &
                                      grid%c1h, grid%c2h,                       &
                                      moist_bxs(jms,kms,1,im),moist_bxe(jms,kms,1,im), &
@@ -2230,12 +2230,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                scalar_2=moist(ims,kms,jms,im),                         &
                                sc_tend=moist_tend(ims,kms,jms,im),                     &
                                advect_tend=advect_tend,                                &
-                               h_tendency=h_tendency, z_tendency=z_tendency,           &
+                               h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                msftx=grid%msftx,msfty=grid%msfty,                      &
                                c1=grid%c1h, c2=grid%c2h,                               &
                                mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                               config_flags=config_flags, tenddec=tenddec,             &
+                               config_flags=config_flags, tenddec=tenddec,             & 
                                ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2243,7 +2243,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                kts=k_start    , kte=k_end                              )
                IF( rk_step == rk_order .AND. config_flags%use_q_diabatic == 1 )THEN
                IF( im.eq.p_qv .or. im.eq.p_qc )THEN
-                   CALL q_diabatic_subtr( im, im,            &
+                   CALL q_diabatic_subtr( im, im,            & 
                            dt_rk,                            &
                            grid%qv_diabatic,                 &
                            grid%qc_diabatic,                 &
@@ -2300,7 +2300,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
            CALL wrf_debug ( 200 , ' call rk_scalar_tend for tke' )
            tenddec = .false.
-           CALL rk_scalar_tend ( 1, 1, config_flags, tenddec,                      &
+           CALL rk_scalar_tend ( 1, 1, config_flags, tenddec,                      & 
                             rk_step, dt_rk,                                        &
                             grid%ru_m, grid%rv_m, grid%ww_m,                       &
                             grid%muts, grid%mub, grid%mu_1,                        &
@@ -2309,7 +2309,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                             grid%tke_1,                                            &
                             grid%tke_2,                                            &
                             tke_tend(ims,kms,jms),                                 &
-                            advect_tend,h_tendency,z_tendency,grid%rqvften,        &
+                            advect_tend,h_tendency,z_tendency,grid%rqvften,        & 
                             grid%qv_base, .false., grid%fnm, grid%fnp,             &
                             grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv,     &
                             grid%msfvy, grid%msftx,grid%msfty,                     &
@@ -2340,12 +2340,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_2=grid%tke_2,                                    &
                                   sc_tend=tke_tend(ims,kms,jms),                          &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             &
+                                  config_flags=config_flags, tenddec=tenddec,             & 
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2392,7 +2392,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              CALL wrf_debug ( 200 , ' call rk_scalar_tend in chem_tile_loop_1' )
              tenddec = (( config_flags%chemdiag == USECHEMDIAG ) .and. &
                         ( adv_ct_indices(ic) >= PARAM_FIRST_SCALAR ))
-             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                &
+             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                & 
                               rk_step, dt_rk,                                    &
                               grid%ru_m, grid%rv_m, grid%ww_m,                   &
                               grid%muts, grid%mub, grid%mu_1,                    &
@@ -2401,7 +2401,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               chem_old(ims,kms,jms,ic),                          &
                               chem(ims,kms,jms,ic),                              &
                               chem_tend(ims,kms,jms,ic),                         &
-                              advect_tend,h_tendency,z_tendency,grid%rqvften,    &
+                              advect_tend,h_tendency,z_tendency,grid%rqvften,    & 
                               grid%qv_base, .false., grid%fnm, grid%fnp,         &
                               grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                               grid%msfvy, grid%msftx,grid%msfty,                 &
@@ -2421,7 +2421,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! Currently, chemistry species with specified boundaries (i.e. the mother
 ! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
 !
            IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
              IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_chem' )
@@ -2480,12 +2480,12 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   advh_t=advh_ct(ims,kms,jms,adv_ct_indices(ic)),         &
                                   advz_t=advz_ct(ims,kms,jms,adv_ct_indices(ic)),         &
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             &
+                                  config_flags=config_flags, tenddec=tenddec,             & 
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2553,7 +2553,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
              CALL wrf_debug ( 15 , ' call rk_scalar_tend in tracer_tile_loop_1' )
              tenddec = .false.
-             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                &
+             CALL rk_scalar_tend ( ic, ic, config_flags, tenddec,                & 
                               rk_step, dt_rk,                                    &
                               grid%ru_m, grid%rv_m, grid%ww_m,                   &
                               grid%muts, grid%mub, grid%mu_1,                    &
@@ -2562,7 +2562,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                               tracer_old(ims,kms,jms,ic),                        &
                               tracer(ims,kms,jms,ic),                            &
                               tracer_tend(ims,kms,jms,ic),                       &
-                              advect_tend,h_tendency,z_tendency,grid%rqvften,    &
+                              advect_tend,h_tendency,z_tendency,grid%rqvften,    & 
                               grid%qv_base, .false., grid%fnm, grid%fnp,         &
                               grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                               grid%msfvy, grid%msftx,grid%msfty,                 &
@@ -2582,7 +2582,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 ! Currently, chemistry species with specified boundaries (i.e. the mother
 ! domain)  are being over written by flow_dep_bdy_chem. So, relax_bdy and
 ! spec_bdy are only called for nests. For boundary conditions from global model or larger domain,
-! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.)
+! chem is uncoupled, and only used for one row/column on inflow (if have_bcs_chem=.true.) 
 !
            IF( ( config_flags%nested ) .and. rk_step == 1 ) THEN
              IF(ic.eq.1)CALL wrf_debug ( 10 , ' have_bcs_tracer' )
@@ -2631,15 +2631,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_1=tracer_old(ims,kms,jms,ic),                    &
                                   scalar_2=tracer(ims,kms,jms,ic),                        &
                                   sc_tend=tracer_tend(ims,kms,jms,ic),                    &
-!                                 advh_t=advh_t(ims,kms,jms,1),                           &
-!                                 advz_t=advz_t(ims,kms,jms,1),                           &
+!                                 advh_t=advh_t(ims,kms,jms,1),                           & 
+!                                 advz_t=advz_t(ims,kms,jms,1),                           & 
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             &
+                                  config_flags=config_flags, tenddec=tenddec,             & 
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2694,7 +2694,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
            CALL wrf_debug ( 200 , ' call rk_scalar_tend' )
            tenddec = .false.
-           CALL rk_scalar_tend ( is, is, config_flags, tenddec,                   &
+           CALL rk_scalar_tend ( is, is, config_flags, tenddec,                   & 
                                  rk_step, dt_rk,                                  &
                                  grid%ru_m, grid%rv_m, grid%ww_m,                 &
                                  grid%muts, grid%mub, grid%mu_1,                  &
@@ -2703,7 +2703,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                  scalar_old(ims,kms,jms,is),                      &
                                  scalar(ims,kms,jms,is),                          &
                                  scalar_tend(ims,kms,jms,is),                     &
-                                 advect_tend,h_tendency,z_tendency,grid%rqvften,  &
+                                 advect_tend,h_tendency,z_tendency,grid%rqvften,  & 
                                  grid%qv_base, .false., grid%fnm, grid%fnp,       &
                                  grid%msfux,grid%msfuy, grid%msfvx, grid%msfvx_inv, &
                                  grid%msfvy, grid%msftx,grid%msfty,               &
@@ -2772,15 +2772,15 @@ SUBROUTINE solve_em ( grid , config_flags  &
                                   scalar_1=scalar_old(ims,kms,jms,is),                    &
                                   scalar_2=scalar(ims,kms,jms,is),                        &
                                   sc_tend=scalar_tend(ims,kms,jms,is),                    &
-!                                 advh_t=advh_t(ims,kms,jms,1),                           &
-!                                 advz_t=advz_t(ims,kms,jms,1),                           &
+!                                 advh_t=advh_t(ims,kms,jms,1),                           & 
+!                                 advz_t=advz_t(ims,kms,jms,1),                           & 
                                   advect_tend=advect_tend,                                &
-                                  h_tendency=h_tendency, z_tendency=z_tendency,           &
+                                  h_tendency=h_tendency, z_tendency=z_tendency,           & 
                                   msftx=grid%msftx,msfty=grid%msfty,                      &
                                   c1=grid%c1h, c2=grid%c2h,                               &
                                   mu_old=grid%mu_1, mu_new=grid%mu_2, mu_base=grid%mub,   &
                                   rk_step=rk_step, dt=dt_rk, spec_zone=grid%spec_zone,    &
-                                  config_flags=config_flags, tenddec=tenddec,             &
+                                  config_flags=config_flags, tenddec=tenddec,             & 
                                   ids=ids, ide=ide, jds=jds, jde=jde, kds=kds, kde=kde,   &
                                   ims=ims, ime=ime, jms=jms, jme=jme, kms=kms, kme=kme,   &
                                   its=grid%i_start(ij), ite=grid%i_end(ij),               &
@@ -2810,7 +2810,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !     B = config_flags%use_aero_icbc
 !     C = config_glags%have_bcs_scalar
 
-! Test| A  | B  | C | ( A AND NOT B ) OR ( NOT A AND NOT C )
+! Test| A  | B  | C | ( A AND NOT B ) OR ( NOT A AND NOT C ) 
 ! ----+----+----+---+-----------------------------------------------
 !  1  | T  | T  | T |                 F = DO NOT CALL flow_dep_bdy
 !  2  | T  | T  | F |                 F = DO NOT CALL flow_dep_bdy
@@ -2824,7 +2824,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
 !  If this is     the special friendly fields AND are to use the aero icbc, then NO calls to flow dep: tests 1 and 2
 !  If this is     the special friendly fields AND do not use the aero icbc, then    call     flow dep: tests 3 and 4
-!  If this is not the special friendly fields AND:
+!  If this is not the special friendly fields AND: 
 !           If we        have bcs for scalars, do not call flow dep: tests 5 and 7
 !           If we do not have bcs for scalars,        call flow dep: tests 6 and 8
 
@@ -2883,7 +2883,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !  rk3 substep polar filter for scalars (moist,chem,scalar)
 !-----------------------------------------------------------
 
-       IF (config_flags%polar) THEN
+       IF (config_flags%polar) THEN 
          IF ( num_3d_m >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter moist ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_m
@@ -2929,7 +2929,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              END IF
            END DO
          END IF
-
+   
          IF ( num_3d_c >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter chem ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_c
@@ -3020,7 +3020,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
              END IF
            END DO
          END IF
-
+   
          IF ( num_3d_s >= PARAM_FIRST_SCALAR ) THEN
            CALL wrf_debug ( 200 , ' call filter scalar ' )
            DO im = PARAM_FIRST_SCALAR, num_3d_s
@@ -3075,7 +3075,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !-----------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!  here's where we need a wide comm stencil - these are the
+!  here's where we need a wide comm stencil - these are the 
 !  uncoupled variables so are used for high order calc in
 !  advection and mixong routines.
 !
@@ -3117,7 +3117,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_D2_3.inc"
        ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
 #    include "HALO_EM_D2_5.inc"
-       ELSE
+       ELSE 
          WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
          CALL wrf_error_fatal(TRIM(wrf_err_message))
        ENDIF
@@ -3162,7 +3162,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
          IF (num_3d_m >= PARAM_FIRST_SCALAR) THEN
 
            moisture_loop_bdy_1 : DO im = PARAM_FIRST_SCALAR , num_3d_m
-
+  
              CALL set_physical_bc3d( moist(ims,kms,jms,im), 'p', config_flags,   &
                                      ids, ide, jds, jde, kds, kde,             &
                                      ims, ime, jms, jme, kms, kme,             &
@@ -3406,7 +3406,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       IF (CurrTime .lt. temp_time + dtInterval) THEN
          WRITE ( message , FMT = '("solve_em: initializing avgflx at time ",A," on domain ",I3)' ) &
               & TRIM(message2), grid%id
-         CALL wrf_message(trim(message))
+         CALL wrf_message(trim(message)) 
          grid%avgflx_count = 0
 !tile-loop for zero_avgflx
    !$OMP PARALLEL DO   &
@@ -3442,7 +3442,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
               &   grid%avgflx_cfu1,grid%avgflx_cfd1,grid%avgflx_dfu1, &
               &   grid%avgflx_efu1,grid%avgflx_dfd1,grid%avgflx_efd1 )
          CALL wrf_debug(200,'In solve_em, after upd_avgflx call')
-
+         
       ENDDO
       grid%avgflx_count = grid%avgflx_count + 1
    ENDIF
@@ -3501,10 +3501,10 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !
 ! (5) time-split physics.
 !
-!     Microphysics are the only time  split physics in the WRF model
+!     Microphysics are the only time  split physics in the WRF model 
 !     at this time.  Split-physics begins with the calculation of
 !     needed diagnostic quantities (pressure, temperature, etc.)
-!     followed by a call to the microphysics driver,
+!     followed by a call to the microphysics driver, 
 !     and finishes with a clean-up, storing off of a diabatic tendency
 !     from the moist physics, and a re-calulation of the  diagnostic
 !     quantities pressure and density.
@@ -3573,7 +3573,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 BENCH_START(micro_driver_tim)
 
 !
-! WRFU_AlarmIsRinging always returned false, so using an alternate  method to find out if it is time
+! WRFU_AlarmIsRinging always returned false, so using an alternate  method to find out if it is time 
 ! to dump history/restart files so microphysics can be told to calculate things like radar reflectivity.
 !
 !     diagflag = .false.
@@ -3809,7 +3809,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
       &        ,CCN4_GS=grid%CCN4_GS,CCN5_GS=grid%CCN5_GS,CCN6_GS=grid%CCN6_GS &
       &        ,CCN7_GS=grid%CCN7_GS,NR_CU=grid%NR_CU,QR_CU=grid%QR_CU,NS_CU=grid%NS_CU &
       &        ,QS_CU=grid%QS_CU,CU_UAF=grid%CU_UAF,mskf_refl_10cm=grid%mskf_refl_10cm)
-
+                                                                          
 BENCH_END(micro_driver_tim)
 
 #if 0
@@ -3949,7 +3949,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                     ,ims=ims,ime=ime,jms=jms,jme=jme,kms=kms,kme=kme             &
                     ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe          )
          END IF
-
+ 
          CALL pxft ( grid=grid                                                 &
                   ,lineno=__LINE__                                             &
                   ,flag_uv            = 0                                      &
@@ -3974,7 +3974,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
                   ,ips=ips,ipe=ipe,jps=jps,jpe=jpe,kps=kps,kpe=kpe             &
                   ,imsx=imsx,imex=imex,jmsx=jmsx,jmex=jmex,kmsx=kmsx,kmex=kmex &
                   ,ipsx=ipsx,ipex=ipex,jpsx=jmsx,jpex=jpex,kpsx=kpsx,kpex=kpex )
-
+ 
          IF ( config_flags%coupled_filtering ) THEN
            CALL uncouple_scalars_for_filter ( FIELD=moist(ims,kms,jms,im)      &
                     ,MU=grid%mu_2 , MUB=grid%mub                                 &
@@ -4204,7 +4204,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
    ! b.c. routine for data within patch.
 
-   ! we need to do both time levels of
+   ! we need to do both time levels of 
    ! data because the time filter only works in the physical solution space.
 
    ! First, do patch communications for boundary conditions (periodicity)
@@ -4212,13 +4212,13 @@ SUBROUTINE solve_em ( grid , config_flags  &
 !-----------------------------------------------------------
 !  Stencils for patch communications  (WCS, 29 June 2001)
 !
-!  here's where we need a wide comm stencil - these are the
+!  here's where we need a wide comm stencil - these are the 
 !  uncoupled variables so are used for high order calc in
 !  advection and mixong routines.
 !
 !                              * * * * *
 !            *        * * *    * * * * *
-!          * + *      * + *    * * + * *
+!          * + *      * + *    * * + * * 
 !            *        * * *    * * * * *
 !                              * * * * *
 !
@@ -4251,7 +4251,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 #    include "HALO_EM_D3_3.inc"
    ELSE IF ( config_flags%h_mom_adv_order <= 6 ) THEN
 #    include "HALO_EM_D3_5.inc"
-   ELSE
+   ELSE 
       WRITE(wrf_err_message,*)'solve_em: invalid h_mom_adv_order = ',config_flags%h_mom_adv_order
       CALL wrf_error_fatal(TRIM(wrf_err_message))
    ENDIF
@@ -4352,7 +4352,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
 !  this code forces boundary values to specified values to avoid drift
 
-   IF( config_flags%specified .or. config_flags%nested ) THEN
+   IF( config_flags%specified .or. config_flags%nested ) THEN 
    !$OMP PARALLEL DO   &
    !$OMP PRIVATE ( ij )
    tile_bc_loop_3: DO ij = 1 , grid%num_tiles
@@ -4573,7 +4573,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
 
   CALL after_all_rk_steps ( grid, config_flags,                  &
                             moist, chem, tracer, scalar,         &
-                            th_phy, pi_phy, p_phy, rho_phy,      &
+                            th_phy, pi_phy, p_phy, rho_phy,      &   
                             p8w, t8w, dz8w,                      &
                             REAL(curr_secs,8), curr_secs2,       &
                             diag_flag,                           &
@@ -4669,7 +4669,7 @@ SUBROUTINE solve_em ( grid , config_flags  &
    CALL wrf_debug ( 200 , ' call end of solve_em' )
 
 !  Are we about to read SST input from the wrflowinput file?  That data is saved
-!  for use in fractional merging of external/coupled SST and input SST.
+!  for use in fractional merging of external/coupled SST and input SST. 
    IF ( coupler_on )   grid%just_read_auxinput4 = Is_alarm_tstep(grid%domain_clock, grid%alarms(AUXINPUT4_ALARM))
 
 !  Are we about to read the lateral boundary file?  This is a domain one action only.
diff --git a/phys/module_diag_misc.F b/phys/module_diag_misc.F
index 4ebde610e6..7bc0cc4dd8 100644
--- a/phys/module_diag_misc.F
+++ b/phys/module_diag_misc.F
@@ -166,8 +166,8 @@ SUBROUTINE diagnostic_output_calc(                                 &
                                                     ,   SNOWNCV  &
                                                     ,       HFX  &
                                                     ,        LH  &
-                                                    ,    SFCEVP  &
-                                                    ,        T2
+                                                    ,    SFCEVP  &  
+                                                    ,        T2     
 
    REAL, DIMENSION( ims:ime , jms:jme ),                         &
           INTENT(INOUT) ::                                DPSDT  &
@@ -176,7 +176,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
                                                     ,     RAINC  &
                                                     ,     MU_2M  &
                                                     ,      PK1M
-
+ 
    REAL,  INTENT(IN   ) :: DT, XTIME
    INTEGER,  INTENT(IN   ) :: SBW
    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) ::     &
@@ -278,7 +278,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
         DO i=i_start(ij),i_end(ij)
           i_rainnc(i,j) = 0
           i_rainc(i,j) = 0
-        ENDDO
+        ENDDO      
         ENDDO
       ENDIF
       DO j=j_start(ij),j_end(ij)
@@ -291,7 +291,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           rainc(i,j) = rainc(i,j) - bucket_mm
           i_rainc(i,j) =  i_rainc(i,j) + 1
         ENDIF
-      ENDDO
+      ENDDO      
       ENDDO
 
       IF (xtime .eq. 0.0 .and. bucket_J .gt. 0.0 .and. PRESENT(ACSWUPT))THEN
@@ -305,7 +305,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           i_acswupbc(i,j) = 0
           i_acswdnb(i,j) = 0
           i_acswdnbc(i,j) = 0
-        ENDDO
+        ENDDO      
         ENDDO
       ENDIF
       IF (xtime .eq. 0.0  .and. bucket_J .gt. 0.0 .and. PRESENT(ACLWUPT))THEN
@@ -319,7 +319,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           i_aclwupbc(i,j) = 0
           i_aclwdnb(i,j) = 0
           i_aclwdnbc(i,j) = 0
-        ENDDO
+        ENDDO      
         ENDDO
       ENDIF
       IF (PRESENT(ACSWUPT) .and. bucket_J .gt. 0.0)THEN
@@ -357,7 +357,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           acswdnbc(i,j) = acswdnbc(i,j) - bucket_J
           i_acswdnbc(i,j) =  i_acswdnbc(i,j) + 1
         ENDIF
-      ENDDO
+      ENDDO      
       ENDDO
       ENDIF
       IF (PRESENT(ACLWUPT) .and. bucket_J .gt. 0.0)THEN
@@ -395,7 +395,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
           aclwdnbc(i,j) = aclwdnbc(i,j) - bucket_J
           i_aclwdnbc(i,j) =  i_aclwdnbc(i,j) + 1
         ENDIF
-      ENDDO
+      ENDDO      
       ENDDO
       ENDIF
    ENDDO
@@ -427,10 +427,10 @@ SUBROUTINE diagnostic_output_calc(                                 &
          snow_acc_nc(i,j)   = snow_acc_nc(i,j) +  RAINCV(i,j)
          snow_acc_nc(i,j)   = MAX (snow_acc_nc(i,j), 0.0)
          ENDIF
-      ENDDO
-      ENDDO
+      ENDDO     
+      ENDDO     
 
-   ENDDO
+   ENDDO     
 
 !  !$OMP END PARALLEL DO
    ENDIF
@@ -580,8 +580,8 @@ SUBROUTINE diagnostic_output_calc(                                 &
 
 
 
-!+---+-----------------------------------------------------------------+
-!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+ 
+!+---+-----------------------------------------------------------------+ 
 !..Calculate a maximum hail diameter from the characteristics of the
 !.. graupel category mixing ratio and number concentration (or hail, if
 !.. available).  This diagnostic uses the actual spectral distribution
@@ -589,7 +589,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
 !.. from 0.5mm to 7.5cm.  Once a minimum number concentration of 0.01
 !.. particle per cubic meter of air is reached, from the upper size
 !.. limit, then this bin is considered the max size.
-!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+ 
 
       WRITE(outstring,*) 'GT-Diagnostics, computing max-hail diameter'
       CALL wrf_debug (100, TRIM(outstring))
@@ -1004,7 +1004,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
            idp=i
            jdp=j
          endif
-      ENDDO
+      ENDDO      
       ENDDO
 
    ENDDO
@@ -1160,7 +1160,7 @@ SUBROUTINE diagnostic_output_calc(                                 &
    END SUBROUTINE diagnostic_output_calc
 
 
-!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+ 
       REAL FUNCTION GAMMLN(XX)
 !     --- RETURNS THE VALUE LN(GAMMA(XX)) FOR XX > 0.
       IMPLICIT NONE
@@ -1185,7 +1185,7 @@ REAL FUNCTION GAMMLN(XX)
       GAMMLN=TMP+LOG(STP*SER/X)
       END FUNCTION GAMMLN
 !  (C) Copr. 1986-92 Numerical Recipes Software 2.02
-!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+ 
       REAL FUNCTION WGAMMA(y)
 
       IMPLICIT NONE
@@ -1194,7 +1194,7 @@ REAL FUNCTION WGAMMA(y)
       WGAMMA = EXP(GAMMLN(y))
 
       END FUNCTION WGAMMA
-!+---+-----------------------------------------------------------------+
+!+---+-----------------------------------------------------------------+ 
 
 
 END MODULE module_diag_misc
diff --git a/phys/module_diagnostics_driver.F b/phys/module_diagnostics_driver.F
index b268d0db2d..b44a41aaf7 100644
--- a/phys/module_diagnostics_driver.F
+++ b/phys/module_diagnostics_driver.F
@@ -16,7 +16,7 @@ MODULE module_diagnostics_driver
 
    SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                                    moist, chem, tracer, scalar,         &
-                                   th_phy, pi_phy, p_phy, rho_phy,      &
+                                   th_phy, pi_phy, p_phy, rho_phy,      & 
                                    p8w, t8w, dz8w,                      &
                                    curr_secs, curr_secs2,               &
                                    diag_flag,                           &
@@ -66,13 +66,13 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                                    model_config_rec
 
       USE module_streams
-      USE module_utility, ONLY : WRFU_Time
+      USE module_utility, ONLY : WRFU_Time 
 
       !=============================================================
       !  USE Association for the Diagnostic Packages
       !=============================================================
-
-      USE module_lightning_driver, ONLY : lightning_driver
+      
+      USE module_lightning_driver, ONLY : lightning_driver      
       USE module_diag_misc, ONLY : diagnostic_output_calc
       USE module_diag_cl, ONLY : clwrf_output_calc
       USE module_diag_pld, ONLY : pld
@@ -134,7 +134,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
       !           incrementing index
       !        k: refers to the vertical direction form bottom to top, the second dimension
       !           in all 3d arrays
-      !     The second letter:
+      !     The second letter: 
       !        d: refers to the domain size, the geophysical extent of the entire domain,
       !           not used in dimensions or looping, used to determine when we are close to
       !           the edge of the boundary
@@ -196,15 +196,15 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
 
       !  Lightning flash rate diagnostic production.
 
-      LIGHTNING: IF ( config_flags%lightning_option /= 0 ) THEN
+      LIGHTNING: IF ( config_flags%lightning_option /= 0 ) THEN 
          CALL wrf_debug ( 100 , '--> CALL DIAGNOSTICS PACKAGE: LIGHTNING_DRIVER' )
          CALL lightning_driver ( &
           ! Frequently used prognostics
             curr_secs, grid%dt, grid%dx, grid%dy,              &
             grid%xlat, grid%xlong, grid%xland, grid%ht,        &
             grid%t_phy, p_phy, grid%rho,                       &
-            grid%u_phy, grid%v_phy, grid%w_2,                  &
-            th_phy,     pi_phy,dz8w,                           &
+            grid%u_phy, grid%v_phy, grid%w_2,                  &    
+            th_phy,     pi_phy,dz8w,                           &  
             grid%z, moist,                                     &
           ! Scheme specific prognostics
             grid%ktop_deep, grid%refl_10cm,                    &
@@ -224,15 +224,15 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
           ! Scheme specific namelist inputs
             config_flags%cellcount_method,                     &
             config_flags%cldtop_adjustment,                    &
-          ! Order dependent args for domain, mem, and tile dims
+          ! Order dependent args for domain, mem, and tile dims 
             ids, ide, jds, jde, kds, kde,         &
             ims, ime, jms, jme, kms, kme,         &
             ips, ipe, jps, jpe, kps, kpe,         &
           ! Mandatory outputs for all quantitative schemes
             grid%ic_flashcount, grid%ic_flashrate,          &
             grid%cg_flashcount, grid%cg_flashrate,          &
-            grid%lpi                                        &
-      )
+            grid%lpi                                        &   
+      )    
       END IF LIGHTNING
 
 
@@ -268,7 +268,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
         !$OMP END PARALLEL DO
       END IF HAILCAST
 
-      TRADITIONAL_FIELDS: IF ( config_flags%diag_nwp2 == do_trad_fields ) THEN
+      TRADITIONAL_FIELDS: IF ( config_flags%diag_nwp2 == do_trad_fields ) THEN 
          !$OMP PARALLEL DO   &
          !$OMP PRIVATE ( ij )
          DO ij = 1 , grid%num_tiles
@@ -298,7 +298,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                ,e=grid%e                                            &
                ,sina=grid%sina                                      &
                ,cosa=grid%cosa                                      &
-               !  Input model diagnostic vraiables
+               !  Input model diagnostic vraiables 
                ,rho=grid%rho                                        &
                ,dz8w=dz8w                                           &
                ,qc=moist(:,:,:,P_QC)                                &
@@ -306,8 +306,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                ,rainnc=grid%rainnc                                  &
                ,snownc=grid%snownc                                  &
                ,graupelnc=grid%graupelnc                            &
-               ,hailnc=grid%hailnc                                  &
-               !  Terrestrial data
+               ,hailnc=grid%hailnc                                  & 
+               !  Terrestrial data                
                ,ht=grid%ht                                          &
                !  Namelist info
                ,use_theta_m=config_flags%use_theta_m                &
@@ -357,8 +357,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -376,7 +376,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag
+      ! Selection flag 
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -390,7 +390,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -432,8 +432,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -451,7 +451,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag
+      ! Selection flag 
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -465,7 +465,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -509,8 +509,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -528,7 +528,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag
+      ! Selection flag 
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -542,7 +542,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -585,8 +585,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -604,7 +604,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag
+      ! Selection flag 
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -618,7 +618,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -661,8 +661,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -680,7 +680,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag
+      ! Selection flag 
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -694,7 +694,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -768,8 +768,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,RAINCV=grid%raincv    ,RAINNCV=grid%rainncv         &
                 ,RAINC=grid%rainc    ,RAINNC=grid%rainnc             &
                 ,I_RAINC=grid%i_rainc    ,I_RAINNC=grid%i_rainnc     &
-                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &
-                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &
+                ,HFX=grid%hfx   ,SFCEVP=grid%sfcevp    ,LH=grid%lh   &    
+                ,DT=grid%dt      ,SBW=config_flags%spec_bdy_width    &    
                 ,XTIME=grid%xtime   ,T2=grid%t2                      &
            ,ACSWUPT=grid%acswupt    ,ACSWUPTC=grid%acswuptc          &
            ,ACSWDNT=grid%acswdnt    ,ACSWDNTC=grid%acswdntc          &
@@ -787,7 +787,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
          ,I_ACLWDNT=grid%i_aclwdnt  ,I_ACLWDNTC=grid%i_aclwdntc      &
          ,I_ACLWUPB=grid%i_aclwupb  ,I_ACLWUPBC=grid%i_aclwupbc      &
          ,I_ACLWDNB=grid%i_aclwdnb  ,I_ACLWDNBC=grid%i_aclwdnbc      &
-      ! Selection flag
+      ! Selection flag 
                 ,DIAG_PRINT=config_flags%diag_print                  &
                 ,BUCKET_MM=config_flags%bucket_mm                    &
                 ,BUCKET_J =config_flags%bucket_J                     &
@@ -801,7 +801,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                 ,NSSL_CNOHL=config_flags%nssl_cnohl                  &  !  gthompsn
                 ,NSSL_RHO_QH=config_flags%nssl_rho_qh                &  !  gthompsn
                 ,NSSL_RHO_QHL=config_flags%nssl_rho_qhl              &  !  gthompsn
-                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &
+                ,SNOWNCV=grid%snowncv, SNOW_ACC_NC=grid%snow_acc_nc  &    
                 ,PREC_ACC_C=grid%prec_acc_c                          &
                 ,PREC_ACC_NC=grid%prec_acc_nc                        &
                 ,PREC_ACC_DT=config_flags%prec_acc_dt                &
@@ -1109,7 +1109,7 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
                        ,TH2=grid%th2, TH2_MEAN=grid%th2_mean                  &
                        ,Q2=grid%q2, Q2_MEAN=grid%q2_mean                      &
                        ,U10=grid%u10, U10_MEAN=grid%u10_mean                  &
-                       ,V10=grid%v10, V10_MEAN=grid%v10_mean                  &
+                       ,V10=grid%v10, V10_MEAN=grid%v10_mean                  &           
                        ,HFX=grid%hfx, HFX_MEAN=grid%hfx_mean                  &
                        ,LH=grid%lh, LH_MEAN=grid%lh_mean                      &
                        ,SWDNB=grid%swdnb, SWDNB_MEAN=grid%swdnb_mean          &
@@ -1188,8 +1188,8 @@ SUBROUTINE diagnostics_driver ( grid, config_flags,                  &
            ,LWUPT_DIURN=grid%LWUPT_DIURN, LWDNT_DIURN=grid%LWDNT_DIURN        &
          ! Dimension arguments
            ,IDS=ids, IDE=ide, JDS=jds, JDE=jde, KDS=kds, KDE=kde              &
-           ,IMS=ims, IME=ime, JMS=jms, JME=jme, KMS=kms, KME=kme              &
-           ,IPS=ips, IPE=ipe, JPS=jps, JPE=jpe, KPS=kps, KPE=kpe              &
+           ,IMS=ims, IME=ime, JMS=jms, JME=jme, KMS=kms, KME=kme              & 
+           ,IPS=ips, IPE=ipe, JPS=jps, JPE=jpe, KPS=kps, KPE=kpe              &         
            ,I_START=grid%i_start, I_END=min(grid%i_end, ide-1)                &
            ,J_START=grid%j_start, J_END=min(grid%j_end, jde-1)                &
            ,NUM_TILES=grid%num_tiles                                          &
@@ -1206,7 +1206,7 @@ END SUBROUTINE diagnostics_driver
    SUBROUTINE update_phys_fields ( grid, config_flags, moist,           &
                                    ids,  ide,  jds,  jde,  kds,  kde,   &
                                    ims,  ime,  jms,  jme,  kms,  kme,   &
-                                   ips,  ipe,  jps,  jpe,  kps,  kpe    )
+                                   ips,  ipe,  jps,  jpe,  kps,  kpe    ) 
 
       USE module_domain, ONLY : domain
       USE module_configure, ONLY : grid_config_rec_type
@@ -1231,7 +1231,7 @@ SUBROUTINE update_phys_fields ( grid, config_flags, moist,           &
 
       !  Local variables
 
-      INTEGER :: i, j, k
+      INTEGER :: i, j, k 
 
       !  Moist or dry theta
 
diff --git a/phys/module_microphysics_driver.F b/phys/module_microphysics_driver.F
index ff97c99a0a..062b9c3046 100644
--- a/phys/module_microphysics_driver.F
+++ b/phys/module_microphysics_driver.F
@@ -37,7 +37,7 @@ SUBROUTINE microphysics_driver(                                          &
                       ,qme3d,prain3d,nevapr3d,rate1ord_cw2pr_st3d        &
                       ,dgnum4D,dgnumwet4D                                &
 #endif
-!======================
+!======================                                   
                       ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr   &
                       ,qic_curr,qip_curr,qid_curr &
                       ,qnic_curr,qnip_curr,qnid_curr &
@@ -53,7 +53,7 @@ SUBROUTINE microphysics_driver(                                          &
                       ,qvoli2_curr,qaoli2_curr                           & ! for Jensen ISHMAEL
                       ,qi3_curr,qni3_curr,qvoli3_curr,qaoli3_curr        & ! for Jensen ISHMAEL
                       ,effr_curr,ice_effr_curr,tot_effr_curr             &
-                      ,qic_effr_curr,qip_effr_curr,qid_effr_curr         &
+                      ,qic_effr_curr,qip_effr_curr,qid_effr_curr         &             
                       ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni      &
                       ,f_qns,f_qnr,f_qng,f_qnc,f_qnn,f_qh,f_qnh          &
                       ,            f_qzr,f_qzi,f_qzs,f_qzg,f_qzh         &
@@ -66,7 +66,7 @@ SUBROUTINE microphysics_driver(                                          &
                       ,f_qvoli2,f_qaoli2                                 & ! for Jensen ISHMAEL
                       ,f_qi3,f_qni3,f_qvoli3,f_qaoli3                    & ! for Jensen ISHMAEL
                       ,f_effr,f_ice_effr,f_tot_effr                      &
-                      ,f_qic_effr,f_qip_effr,f_qid_effr                  &
+                      ,f_qic_effr,f_qip_effr,f_qid_effr                  &                 
                       ,cu_used                                           &
                       ,qrcuten, qscuten, qicuten, qccuten                &
                       ,qt_curr,f_qt                                      &
@@ -86,7 +86,7 @@ SUBROUTINE microphysics_driver(                                          &
 #endif
 !NUWRF JJS 20110525 ^^^^^
 !                     ,ccntype                                           & ! for mp_milbrandt2mom
-                      ,u,v,w,z                                          &
+                      ,u,v,w,z                                          &   
                       ,rainnc,    rainncv                                &
                       ,snownc,    snowncv                                &
                       ,hailnc,    hailncv                                &
@@ -97,13 +97,13 @@ SUBROUTINE microphysics_driver(                                          &
 #endif
                       ,qnwfa2d, qnifa2d                                  & ! for water/ice-friendly aerosols
                       ,refl_10cm                                         & ! HM, 9/22/09, add for refl
-                      ,vmi3d                                             & ! for P3
-                      ,di3d                                              & ! for P3
-                      ,rhopo3d                                           & ! for P3
+                      ,vmi3d                                             & ! for P3 
+                      ,di3d                                              & ! for P3 
+                      ,rhopo3d                                           & ! for P3 
                       ,phii3d                                            & ! for Jensen ISHMAEL
-                      ,vmi3d_2                                           & ! for P3
-                      ,di3d_2                                            & ! for P3
-                      ,rhopo3d_2                                         & ! for P3
+                      ,vmi3d_2                                           & ! for P3 
+                      ,di3d_2                                            & ! for P3 
+                      ,rhopo3d_2                                         & ! for P3 
                       ,phii3d_2                                          & ! for Jensen ISHMAEL
                       ,vmi3d_3                                           & ! for Jensen ISHMAEL
                       ,di3d_3                                            & ! for Jensen ISHMAEL
@@ -149,8 +149,8 @@ SUBROUTINE microphysics_driver(                                          &
                     ,GSFCGCESCHEME, WDM5SCHEME, WDM6SCHEME, NSSL_2MOM, NSSL_2MOMCCN, NSSL_2MOMG  &
                     ,NSSL_1MOM,NSSL_1MOMLFO, FER_MP_HIRES_ADVECT &
                     ,WSM7SCHEME, WDM7SCHEME &
-                    ,NUWRF3ICESCHEME, NUWRF4ICESCHEME &
-                    ,MILBRANDT2MOM, P3_1CATEGORY, P3_1CATEGORY_NC, JENSEN_ISHMAEL  !, P3_2CATEGORY ,MILBRANDT3MOM
+                    ,NUWRF3ICESCHEME, NUWRF4ICESCHEME & 
+                    ,MILBRANDT2MOM, P3_1CATEGORY, P3_1CATEGORY_NC, JENSEN_ISHMAEL  !, P3_2CATEGORY ,MILBRANDT3MOM 
 #else
    USE module_state_description, ONLY :                                  &
                      KESSLERSCHEME, LINSCHEME, SBU_YLINSCHEME, WSM3SCHEME, WSM5SCHEME    &
@@ -172,7 +172,7 @@ SUBROUTINE microphysics_driver(                                          &
                     ,p_dust_1, p_dust_2, p_dust_3                       & !inline gocart
                     ,p_dust_4, p_dust_5                                 & !inline gocart
                     ,p_sulf, p_seas_1, p_seas_2                         & !inline gocart
-                    ,p_seas_3, p_seas_4
+                    ,p_seas_3, p_seas_4 
 
 #endif
 
@@ -185,9 +185,9 @@ SUBROUTINE microphysics_driver(                                          &
    USE module_model_constants
    USE module_wrf_error
    USE module_configure, only: grid_config_rec_type
-#if ( WRF_CHEM == 1 )
+#if ( WRF_CHEM == 1 )   
 !mchen   USE module_state_description, only: num_scalar               ! For CAMMGMP scheme Prognostic aerosols
-   USE module_state_description, only: num_chem               ! mchen
+   USE module_state_description, only: num_chem               ! mchen 
    USE modal_aero_data, only:  ntot_amode_cam_mam => ntot_amode ! For CAMMGMP scheme Prognostic aerosols
 #endif
 
@@ -400,7 +400,7 @@ SUBROUTINE microphysics_driver(                                          &
    INTEGER, OPTIONAL, INTENT(IN   )    :: hail, ice2 !, ccntype
 !
    INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
-   INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme,num_scalar,num_sbmradar
+   INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme,num_scalar, num_sbmradar
    INTEGER, OPTIONAL, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
    INTEGER,      INTENT(IN   )    ::                         kts,kte
    INTEGER,      INTENT(IN   )    ::     itimestep,num_tiles,spec_zone
@@ -465,17 +465,17 @@ SUBROUTINE microphysics_driver(                                          &
 
 !=================
 !Data for CAMMGMP scheme
-   REAL,INTENT(IN), OPTIONAL ::accum_mode,aitken_mode,coarse_mode
+   REAL,INTENT(IN), OPTIONAL ::accum_mode,aitken_mode,coarse_mode  
 !1D variables required for CAMMGMP scheme
    REAL , DIMENSION( kms:kme ) ,                                      &
         INTENT(IN   ) , OPTIONAL ::                                        fnm,  & !Factors for interpolation at "w" grid (interfaces)
-                                                                fnp
+                                                                fnp     
 !2D variables required for CAMMGMP scheme
    REAL, DIMENSION( ims:ime, jms:jme ),                               &
         INTENT(IN), OPTIONAL ::                                                 &
                                                                  qfx, &    !Moisture flux at surface (kg m-2 s-1)
                                                                  rliq      !Vertically-integrated reserved cloud condensate(m/s)
-
+ 
  !3D variables required for CAMMGMP scheme
  REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
       INTENT(IN), OPTIONAL ::                                                   &
@@ -484,7 +484,7 @@ SUBROUTINE microphysics_driver(                                          &
                                                                t_phy, &    !Temprature at the mid points (K)
                                                                p_hyd, &    !Hydrostatic pressure(Pa)
                                                              p8w_hyd, &    !Hydrostatic Pressure at level interface (Pa)
-                                                              z_at_w, &    !Height above sea level at layer interfaces (m)
+                                                              z_at_w, &    !Height above sea level at layer interfaces (m) 
                                                              tke_pbl, &    !Turbulence kinetic energy
                                                           turbtype3d, &    !Turbulent interface types [ no unit ]
                                                               smaw3d, &    !Normalized Galperin instability function for momentum [no units]
@@ -499,7 +499,7 @@ SUBROUTINE microphysics_driver(                                          &
  REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme,ntot_amode_cam_mam ),     &
         INTENT(IN) ::                                                 &
                                                              dgnum4D, &
-                                                          dgnumwet4D
+                                                          dgnumwet4D 
 #endif
 !In-outs
  REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
@@ -511,19 +511,19 @@ SUBROUTINE microphysics_driver(                                          &
 #if ( WRF_CHEM == 1 )
  REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem),     &
       INTENT(INOUT) ::                                                &
-                                                                 chem      !Chem array for CAMMGMP scheme Prognostic aerosols
+                                                                 chem      !Chem array for CAMMGMP scheme Prognostic aerosols      
 #endif
 !outs
 REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
       INTENT(INOUT) , OPTIONAL::                                                 &
-                                                            wsedl3d, &    !Sedimentation velocity of stratiform liquid cloud droplet (m/s)
+                                                            wsedl3d, &    !Sedimentation velocity of stratiform liquid cloud droplet (m/s) 
                                                           cldfra_mp, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                       cldfra_mp_all, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                             cldfrai, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                             cldfral, &    !Old Cloud fraction for CAMMGMP microphysics only
                                                             lradius, &    !Old Cloud fraction for CAMMGMP microphysics only
-                                                            iradius, &    !Old Cloud fraction for CAMMGMP microphysics only
-                                                        cldfra_conv
+                                                            iradius, &    !Old Cloud fraction for CAMMGMP microphysics only                                                            
+                                                        cldfra_conv 
 
 
 
@@ -635,7 +635,7 @@ SUBROUTINE microphysics_driver(                                          &
                                                       ,GRAUPELNCV &
                                                           ,HAILNC &
                                                           ,HAILNCV
-
+                                                          
 #if ( WRF_CHEM == 1)
 ! NUWRF JJS 20110525 vvvvv
 ! for inline Gocart coupling
@@ -646,7 +646,7 @@ SUBROUTINE microphysics_driver(                                          &
  REAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(OUT) :: nc_diag
  integer, intent(in) :: gsfcgce_gocart_coupling ! EMK
  REAL, PARAMETER :: frac(4)=(/ 0.01053,0.08421,0.25263,0.65263 /) !fraction for fine dust
-
+ 
 ! NUWRF JJS 20110525 ^^^^^
 #endif
 
@@ -689,7 +689,7 @@ SUBROUTINE microphysics_driver(                                          &
   INTEGER, OPTIONAL, INTENT(IN   )    :: PBL
   INTEGER,           INTENT(IN   )    :: no_src_types_cu
   REAL,              INTENT(IN   )    :: aercu_fct
-  REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), INTENT(INOUT) &
+  REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme, no_src_types_cu), INTENT(INOUT) & 
                                       :: aerocu
   REAL,    OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme), INTENT(INOUT) &
                                       :: EFCG,           &
@@ -790,7 +790,7 @@ SUBROUTINE microphysics_driver(                                          &
             ,has_reqs=has_reqs                                 &
             ,re_cloud=re_cloud                                 &
             ,re_ice=re_ice                                     &
-            ,re_snow=re_snow                                   &  ! for radiation -
+            ,re_snow=re_snow                                   &  ! for radiation -  
             ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
             ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
             ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
@@ -822,7 +822,7 @@ SUBROUTINE microphysics_driver(                                          &
 
 !-----------
        IF( PRESENT(chem_opt) .AND. PRESENT(progn) ) THEN
-
+       
        ! ERM: check whether to use built-in droplet nucleation or use qndrop from CHEM
        IF ( mp_physics==NSSL_2MOMCCN .or. mp_physics==NSSL_2MOM .or. mp_physics==NSSL_2MOMG ) THEN
          IF ( progn > 0 ) THEN
@@ -831,7 +831,7 @@ SUBROUTINE microphysics_driver(                                          &
            nssl_progn = .false. ! use NUCOND for droplet nucleation
          ENDIF
        ENDIF
-
+       
        !Add pass for dust-only wrf-chem option - RAS
        IF( (chem_opt==0 .OR. chem_opt==401) .AND. progn==1 .AND. (mp_physics==LINSCHEME  .OR. mp_physics==MORR_TWO_MOMENT)) THEN
           IF( PRESENT( QNDROP_CURR ) ) THEN
@@ -1187,25 +1187,25 @@ SUBROUTINE microphysics_driver(                                          &
              PRESENT (QI3_CURR).AND. PRESENT (QNI3_CURR) .AND. &
              PRESENT (QVOLI3_CURR).AND. PRESENT (QAOLI3_CURR)) THEN
              CALL mp_jensen_ishmael(             &
-             ITIMESTEP=itimestep,                &  !*
+             ITIMESTEP=itimestep,                &  !*                                                                         
              DT_IN=dt,                           &  !*
-             P=p,                                &  !*
+             P=p,                                &  !*                                                                         
              DZ=dz8w,                            &  !* !
-             TH=th,                              &  !*
-             QV=qv_curr,                         &  !*
-             QC=qc_curr,                         &  !*
-             QR=qr_curr,                         &  !*
+             TH=th,                              &  !*                                                                         
+             QV=qv_curr,                         &  !*                                                                         
+             QC=qc_curr,                         &  !*                                                                         
+             QR=qr_curr,                         &  !*                                                                         
              NR=qnr_curr,                        &  !* !
-             QI1=qi_curr,                        &  !*
-             NI1=qni_curr,                       &  !*
+             QI1=qi_curr,                        &  !*                                                                         
+             NI1=qni_curr,                       &  !*                                                                         
              AI1=qvoli_curr,                     &  !*
              CI1=qaoli_curr,                     &  !*
-             QI2=qi2_curr,                       &  !*
-             NI2=qni2_curr,                      &  !*
+             QI2=qi2_curr,                       &  !*                                                                         
+             NI2=qni2_curr,                      &  !*                                                                         
              AI2=qvoli2_curr,                    &  !*
              CI2=qaoli2_curr,                    &  !*
-             QI3=qi3_curr,                       &  !*
-             NI3=qni3_curr,                      &  !*
+             QI3=qi3_curr,                       &  !*                                                                         
+             NI3=qni3_curr,                      &  !*                                                                         
              AI3=qvoli3_curr,                    &  !*
              CI3=qaoli3_curr,                    &  !*
              IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde, &
@@ -1649,7 +1649,7 @@ SUBROUTINE microphysics_driver(                                          &
 #endif
              PRESENT ( W      )  .AND. &
              PRESENT (QVOLG_CURR) ) THEN
-
+             
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -1708,7 +1708,7 @@ SUBROUTINE microphysics_driver(                                          &
              PRESENT (GRAUPELNC).AND.PRESENT (GRAUPELNCV).AND. &
 #endif
              PRESENT ( W      )  ) THEN
-
+             
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -1760,7 +1760,7 @@ SUBROUTINE microphysics_driver(                                          &
              PRESENT ( W      )  .AND. &
              PRESENT (QVOLG_CURR) .AND. F_QVOLG  .AND.         &
              PRESENT (QVOLH_CURR) .AND. F_QVOLH ) THEN
-
+             
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -1838,7 +1838,7 @@ SUBROUTINE microphysics_driver(                                          &
 #endif
              PRESENT ( W      )  .AND. &
              PRESENT (QVOLG_CURR) .AND. F_QVOLG  ) THEN
-
+             
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -1916,7 +1916,7 @@ SUBROUTINE microphysics_driver(                                          &
              PRESENT (QVOLG_CURR) .AND. F_QVOLG  .AND.         &
              PRESENT (QVOLH_CURR) .AND. F_QVOLH  .AND.         &
              PRESENT( QNN_CURR )                          ) THEN
-
+             
 
          CALL nssl_2mom_driver(                          &
                      ITIMESTEP=itimestep,                &
@@ -2068,7 +2068,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,CHEM_OPT=chem_opt                                 &
                  ,GSFCGCE_GOCART_COUPLING=gsfcgce_gocart_coupling   &
 #endif
-!NUWRF JJS 20110525 ^^^^^
+!NUWRF JJS 20110525 ^^^^^         
                                                                     )
 
                do j=jts,jte
@@ -2133,7 +2133,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,F_QG=f_qg                                         &
                  ,QG=qg_curr                                        &
 !                 ,IHAIL=hail, ICE4=ice2                             & ! hardcoded in the 4ice scheme
-                                                                       ! ihail = 0, ice4=4
+                                                                       ! ihail = 0, ice4=4 
 !NUWRF JJS 20110525 vvvvv
                  ,PHYSC=physc, PHYSE=physe, PHYSD=physd             &
                  ,PHYSS=physs, PHYSM=physm, PHYSF=physf             &
@@ -2167,7 +2167,7 @@ SUBROUTINE microphysics_driver(                                          &
                         acphys_tot(i,k,j) = acphysc(i,k,j) + acphyse(i,k,j) + &
                              acphysd(i,k,j) + acphyss(i,k,j) + acphysm(i,k,j) + &
                              acphysf(i,k,j)
-
+                        
                      end do
                   end do
                end do
@@ -2285,7 +2285,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
                  ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -
+                 ,re_snow=re_snow                                   &  ! for radiation -  
 # endif
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
@@ -2328,7 +2328,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
                  ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -
+                 ,re_snow=re_snow                                   &  ! for radiation -  
 # endif
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
@@ -2372,7 +2372,7 @@ SUBROUTINE microphysics_driver(                                          &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
                  ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -
+                 ,re_snow=re_snow                                   &  ! for radiation -  
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
@@ -2464,8 +2464,8 @@ SUBROUTINE microphysics_driver(                                          &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
                  ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -
-                 ,ITIMESTEP=itimestep                               &
+                 ,re_snow=re_snow                                   &  ! for radiation -       
+                 ,ITIMESTEP=itimestep                               & 
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
@@ -2508,13 +2508,13 @@ SUBROUTINE microphysics_driver(                                          &
                  ,diagflag=diagflag                                 &  ! added for radar reflectivity
                  ,do_radar_ref=do_radar_ref                         &  ! added for radar reflectivity
                  ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv          &
-                 ,ITIMESTEP=itimestep                               &
+                 ,ITIMESTEP=itimestep                               & 
                  ,has_reqc=has_reqc                                 &  ! for radiation +
                  ,has_reqi=has_reqi                                 &
                  ,has_reqs=has_reqs                                 &
                  ,re_cloud=re_cloud                                 &
-                 ,re_ice=re_ice                                     &
-                 ,re_snow=re_snow                                   &  ! for radiation -
+                 ,re_ice=re_ice                                     & 
+                 ,re_snow=re_snow                                   &  ! for radiation -  
                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
@@ -2704,7 +2704,7 @@ SUBROUTINE microphysics_driver(                                          &
                   PRESENT( qs_curr    ) .AND.                              &
                   PRESENT( qv_curr    ) .AND. PRESENT( qc_curr     ) .AND. &
                   PRESENT( qi_curr    ) .AND. PRESENT( f_qc        ) .AND. &
-                  PRESENT( qr_curr    ) .AND. PRESENT( qndrop_curr ) .AND. &
+                  PRESENT( qr_curr    ) .AND. PRESENT( qndrop_curr ) .AND. &                  
                   PRESENT( f_qi       ) .AND. PRESENT( qnc_curr    ) .AND. &
                   PRESENT( RAINNCV    ) .AND. PRESENT( SNOWNCV     ) .AND. &
                   PRESENT( qns_curr   ) .AND. PRESENT( qnr_curr    ) .AND. &
@@ -2719,7 +2719,7 @@ SUBROUTINE microphysics_driver(                                          &
                 qi_b4mp(its:ite,kts:kte,jts:jte) = qi_curr(its:ite,kts:kte,jts:jte)
                 qs_b4mp(its:ite,kts:kte,jts:jte) = qs_curr(its:ite,kts:kte,jts:jte)
 #endif
-
+                  
                 CALL CAMMGMP(ITIMESTEP=itimestep,DT=dt,P8W=p8w_hyd,P_HYD=p_hyd    &
                      ,T_PHY=t_phy,PI_PHY=pi_phy,Z_AT_W=z_at_w,QFX=qfx             &
                      ,TKE_PBL=tke_pbl,TURBTYPE3D=turbtype3d,SMAW3D=smaw3d     &
@@ -2763,14 +2763,14 @@ SUBROUTINE microphysics_driver(                                          &
              CALL wrf_debug ( 100 , 'microphysics_driver: calling lscond' )
              IF ( PRESENT( QV_CURR ) .AND.                          &
                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV )) THEN
-
+                                          
                CALL lscond(                                         &
                   TH=th                                              &
-                 ,P=p                                               &
+                 ,P=p                                               & 
                  ,QV=qv_curr                                        &
-                 ,RHO=rho, PII=pi_phy, XLV=xlv, CP=cp               &
+                 ,RHO=rho, PII=pi_phy, XLV=xlv, CP=cp               &  
                  ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
-                 ,SVP3=svp3,SVPT0=svpt0                             &
+                 ,SVP3=svp3,SVPT0=svpt0                             & 
                  ,R_V= R_v                                          & ! added
                  ,DZ8W=dz8w                                         &
                  ,RAINNC=rainnc,RAINNCV=rainncv                     &
diff --git a/phys/module_physics_init.F b/phys/module_physics_init.F
index 4c5b0a0873..773c1ebade 100644
--- a/phys/module_physics_init.F
+++ b/phys/module_physics_init.F
@@ -49,7 +49,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          re_cloud, re_ice, re_snow,              & ! G. Thompson
                          has_reqc, has_reqi, has_reqs,           & ! G. Thompson
 #if ( EM_CORE == 1 )
-                         re_cloud_gsfc, re_ice_gsfc,             &
+                         re_cloud_gsfc, re_ice_gsfc,             & 
                          re_snow_gsfc,                           & ! Goddard
                          re_graupel_gsfc, re_hail_gsfc,          &
                          re_rain_gsfc,                           & ! Goddard
@@ -96,7 +96,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          urban_map_fbd,                          &
                          NUM_URBAN_HI,                           &
                          raincv_a,raincv_b,                      &
-                         gd_cloud,gd_cloud2,                     &
+                         gd_cloud,gd_cloud2,                     & 
                          gd_cloud_a,gd_cloud2_a,                 &
                          QC_CU,QI_CU,                            &
                          ozmixm,pin,                             &    ! Optional
@@ -117,11 +117,11 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          STMASSXY, WOODXY, STBLCPXY, FASTCPXY,            & ! Optional Noah-MP
                          GRAINXY, GDDXY,                                  & ! Optional Noah-MP
                          croptype, cropcat,                      &           ! Noah-MP Crop model
-                         iopt_crop,                                       &
+                         iopt_crop,                                       &  
                          gecros_state,                                    & ! Optional gecros crop
                          XSAIXY, LAI,                                     & ! Optional Noah-MP
                          T2MVXY, T2MBXY, CHSTARXY ,                       & ! Optional Noah-MP
-                         SMOISEQ  ,SMCWTDXY ,RECHXY, DEEPRECHXY, AREAXY,  & ! Optional Noah-MP
+                         SMOISEQ  ,SMCWTDXY ,RECHXY, DEEPRECHXY, AREAXY,  & ! Optional Noah-MP 
                          WTDDT , STEPWTD ,QRFSXY ,QSPRINGSXY ,QSLATXY,    & ! Optional Noah-MP
                          FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, & ! Optional Noah-MP
                          rechclim  ,                                       & ! Optional Noah-MP
@@ -217,7 +217,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 ! next 2 flags for Explicit lightning:
                          nssl_ipelec,                             &
                          nssl_isaund,                             &
-   ! OPTIONAL
+   ! OPTIONAL 
                          RQCNCUTEN, RQINCUTEN,                   &
                          rliq,                                   &  !BSINGH:01/31/2013 - Added rliq and is_CAMMGMP_used for CAM5 physics
                          cldfra_dp,cldfra_sh                     & !ckay for subgrid cloud
@@ -232,7 +232,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          ,ca_rad, cw_rad                        &
                          ,pblmax, wub, ltopb, clddpthb, cldtopb &
                          ,capesave, ainckfsa, radsave           &
-                         ,rainsh, rainshvb, kdcldtop, kdcldbas  &
+                         ,rainsh, rainshvb, kdcldtop, kdcldbas  & 
                          ,xtime1, PBLHAVG, TKEAVG               &
                          ,ccn_conc                             & ! RAS
                          ,QKE                                  & !for MYNN
@@ -240,18 +240,18 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                          ,TSK_mosaic,TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic                                     & ! danli mosaic
                          ,CANWAT_mosaic,SNOW_mosaic,SNOWH_mosaic,SNOWC_mosaic                                 & ! danli mosaic
                          ,ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic      & ! danli mosaic
-                         ,TR_URB2D_mosaic,TB_URB2D_mosaic                                                     & ! danli mosaic
-                         ,TG_URB2D_mosaic,TC_URB2D_mosaic                                                     & ! danli mosaic
+                         ,TR_URB2D_mosaic,TB_URB2D_mosaic                                                     & ! danli mosaic 
+                         ,TG_URB2D_mosaic,TC_URB2D_mosaic                                                     & ! danli mosaic 
                          ,QC_URB2D_mosaic                                                                     & ! danli mosaic
-                         ,TRL_URB3D_mosaic,TBL_URB3D_mosaic                                                   & ! danli mosaic
-                         ,TGL_URB3D_mosaic                                                                    & ! danli mosaic
-                         ,SH_URB2D_mosaic,LH_URB2D_mosaic                                                     & ! danli mosaic
-                         ,G_URB2D_mosaic,RN_URB2D_mosaic                                                      & ! danli mosaic
-                         ,TS_URB2D_mosaic                                                                     & ! danli mosaic
+                         ,TRL_URB3D_mosaic,TBL_URB3D_mosaic                                                   & ! danli mosaic 
+                         ,TGL_URB3D_mosaic                                                                    & ! danli mosaic 
+                         ,SH_URB2D_mosaic,LH_URB2D_mosaic                                                     & ! danli mosaic 
+                         ,G_URB2D_mosaic,RN_URB2D_mosaic                                                      & ! danli mosaic 
+                         ,TS_URB2D_mosaic                                                                     & ! danli mosaic 
                          ,TS_RUL2D_mosaic                                                                     & ! danli mosaic
 #if ( EM_CORE == 1 )
                          ,QR_CU,QS_CU,NC_CU,NI_CU,NR_CU,NS_CU,CCN_CU              & ! TWG
-                         ,alevsiz_cu,num_months,no_src_types_cu,aeromcu,aeropcu   & ! PSH/TWG 06/10/16
+                         ,alevsiz_cu,num_months,no_src_types_cu,aeromcu,aeropcu   & ! PSH/TWG 06/10/16                         
                          ,EFCG,EFCS,EFIG,EFIS,EFSG,EFSS                           & ! TWG
 #endif
                           )
@@ -307,8 +307,8 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
   !PSH/TWG 06/10/16
    INTEGER,      INTENT(IN   )    ::   alevsiz_cu, num_months, no_src_types_cu !PSH/TWG 06/10/16
    REAL,  DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months, no_src_types_cu), OPTIONAL, &
-          INTENT(INOUT) ::                                  aeromcu
-   REAL,  DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months), OPTIONAL,INTENT(INOUT)  :: aeropcu
+          INTENT(INOUT) ::                                  aeromcu 
+   REAL,  DIMENSION( ims:ime, alevsiz_cu, jms:jme, num_months), OPTIONAL,INTENT(INOUT)  :: aeropcu 
 
    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,         &
           OPTIONAL, INTENT(INOUT   ) ::                              &
@@ -347,7 +347,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                                                          XICEM, &
                                                         VEGFRA, &
                                                         ACSNOM
-   REAL,    DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::   rliq
+   REAL,    DIMENSION( ims:ime, jms:jme ), OPTIONAL, INTENT(INOUT) ::   rliq    
 
    REAL,    DIMENSION( ims:ime, jms:jme )                     , &
             OPTIONAL, INTENT(INOUT)    ::                ACHFX, &
@@ -411,7 +411,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    !BSINGH -ENDS
 #endif
 
-   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT), OPTIONAL :: RQCNCUTEN, RQINCUTEN
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT), OPTIONAL :: RQCNCUTEN, RQINCUTEN 
 
    REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
 
@@ -447,7 +447,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT), OPTIONAL :: QKE
 
   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT), OPTIONAL :: &
-                                            massflux_EDKF, entr_EDKF, detr_EDKF &
+                                            massflux_EDKF, entr_EDKF, detr_EDKF & 
                                                    ,thl_up, thv_up, rt_up       &
                                                    ,rv_up, rc_up, u_up, v_up    &
                                                    ,frac_up
@@ -515,13 +515,13 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: T2MVXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: T2MBXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: CHSTARXY
-   REAL,    OPTIONAL, DIMENSION(ims:ime,1:num_soil_layers,jms:jme) :: SMOISEQ
-   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: SMCWTDXY
+   REAL,    OPTIONAL, DIMENSION(ims:ime,1:num_soil_layers,jms:jme) :: SMOISEQ 
+   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: SMCWTDXY   
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: DEEPRECHXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: RECHXY
-   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QRFSXY
+   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QRFSXY       
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSPRINGSXY
-   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSLATXY
+   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSLATXY 
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: AREAXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: FDEPTHXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme), INTENT(IN) :: RIVERBEDXY
@@ -652,7 +652,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: HGT_URB2D !multi-layer UCM
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: MH_URB2D  !SLUCM
    REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: STDH_URB2D !SLUCM
-   REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(INOUT) :: LF_URB2D  !SLUCM
+   REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(INOUT) :: LF_URB2D  !SLUCM 
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP
@@ -674,7 +674,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                                                                              h2osno2d,       &
                                                                              snl2d,          &
                                                                              t_grnd2d
-
+ 
   real,    dimension( ims:ime,1:nlevlake, jms:jme ),INTENT(out)            :: t_lake3d,       &
                                                                              lake_icefrac3d, &
                                                                              z_lake3d,       &
@@ -701,7 +701,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 #endif
   INTEGER, INTENT(INOUT)      ::   lake_depth_flag
   INTEGER, INTENT(IN)      ::   use_lakedepth
-
+ 
 
 !CLM
    INTEGER, INTENT(IN) ::       maxpatch
@@ -753,7 +753,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 
 ! WA 12/21/09
    REAL,OPTIONAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
-          INTENT(OUT) ::    te_temf, cf3d_temf
+          INTENT(OUT) ::    te_temf, cf3d_temf    
 ! WA 2/22/11
    REAL,OPTIONAL, DIMENSION( ims:ime , jms:jme ) , &
           INTENT(OUT) ::    wm_temf
@@ -796,8 +796,8 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    INTEGER :: mfshconv
    INTEGER :: icloud_cu
    INTEGER :: iopt_run
-   INTEGER :: aercu_opt !PSH/TWG
-   REAL    :: aercu_fct !PSH/TWG
+   INTEGER :: aercu_opt !PSH/TWG 
+   REAL    :: aercu_fct !PSH/TWG 
 
 
    INTEGER :: i, j, k, itf, jtf, ktf, n
@@ -806,12 +806,12 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 !-------------------------------------------------
 ! Noah-mosaic related variables are added to declaration  (danli)
 !-------------------------------------------------
-
-  INTEGER, INTENT(IN) :: sf_surface_mosaic, NLCAT
+  
+  INTEGER, INTENT(IN) :: sf_surface_mosaic, NLCAT   
   INTEGER, INTENT(IN) :: mosaic_cat
   REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(IN) , OPTIONAL::   LANDUSEF
-  REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(INOUT) , OPTIONAL::   LANDUSEF2
-  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT), OPTIONAL :: mosaic_cat_index
+  REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(INOUT) , OPTIONAL::   LANDUSEF2 
+  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT), OPTIONAL :: mosaic_cat_index 
 
   REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT):: &
         TSK_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic
@@ -821,17 +821,17 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
         TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic
   REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::                &
         TR_URB2D_mosaic, TB_URB2D_mosaic, TG_URB2D_mosaic, TC_URB2D_mosaic,QC_URB2D_mosaic,    &
-        SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic
-
+        SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic  
+                  
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TRL_URB3D_mosaic
    REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TBL_URB3D_mosaic
-   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic
+   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic  
    LOGICAL :: IPRINT
-
+ 
 !-------------------------------------------------
-! End of Noah-mosaic
-!-------------------------------------------------
-
+! End of Noah-mosaic 
+!-------------------------------------------------  
+   
 !-----------------------------------------------------------------
 
    aercu_opt=config_flags%aercu_opt !PSH/TWG 06/10/16
@@ -1008,7 +1008,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
      !rliq can have undefined behaviour
  IF (config_flags%cu_physics == CAMZMSCHEME .or. config_flags%shcu_physics == CAMUWSHCUSCHEME ) THEN
      IF(PRESENT(rliq)) THEN
-        rliq(:,:) = 0.0
+        rliq(:,:) = 0.0 
      ENDIF
  ENDIF
    IF ( .NOT. moved ) THEN
@@ -1183,12 +1183,12 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
    cam_mam_aerosols = .FALSE.
    if(config_flags%chem_opt == CBMZ_CAM_MAM3_NOAQ .OR. config_flags%chem_opt == CBMZ_CAM_MAM3_AQ &
         .OR. config_flags%chem_opt == CBMZ_CAM_MAM7_NOAQ .OR. config_flags%chem_opt == CBMZ_CAM_MAM7_AQ) cam_mam_aerosols = .TRUE.
-
+      
 #endif
 
 
    if(       config_flags%bl_pbl_physics == CAMUWPBLSCHEME     .OR. config_flags%cu_physics == CAMZMSCHEME      &
-        .OR. config_flags%shcu_physics   == CAMUWSHCUSCHEME                                                     &
+        .OR. config_flags%shcu_physics   == CAMUWSHCUSCHEME                                                     & 
 # if (EM_CORE == 1)
         .OR. config_flags%mp_physics == CAMMGMPSCHEME                                                           &
 # endif
@@ -1238,7 +1238,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
                 config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
                 num_soil_layers,TKE_PBL,mfshconv,               &
-                massflux_EDKF, entr_EDKF, detr_EDKF, &
+                massflux_EDKF, entr_EDKF, detr_EDKF, & 
                 thl_up, thv_up, rt_up,       &
                 rv_up, rc_up, u_up, v_up,    &
                 frac_up, &
@@ -1266,12 +1266,12 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 STMASSXY, WOODXY, STBLCPXY, FASTCPXY,           &
                 GRAINXY, GDDXY,                                 & ! Noah-MP Crop model
                 croptype, cropcat,                              & ! Noah-MP Crop model
-                iopt_crop,                                      &
+                iopt_crop,                                      & 
                 gecros_state,                                   & ! Optional gecros crop
                 XSAIXY, LAI,                                    &
                 SMOISEQ, SMCWTDXY, RECHXY, DEEPRECHXY, AREAXY,  &
                 WTDDT, STEPWTD, QRFSXY ,QSPRINGSXY ,QSLATXY,   &
-                FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, &
+                FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, & 
                 rechclim  ,                                     &
                 ISICE,                                 &
                 T2MVXY,T2MBXY,CHSTARXY ,                        &
@@ -1294,7 +1294,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 XXXR_URB2D,XXXB_URB2D,XXXG_URB2D,XXXC_URB2D,    & !Optional urban
                 TRL_URB3D, TBL_URB3D, TGL_URB3D,                & !Optional urban
                 SH_URB2D, LH_URB2D, G_URB2D, RN_URB2D,          & !Optional urban
-                TS_URB2D, FRC_URB2D, UTYPE_URB2D,               &
+                TS_URB2D, FRC_URB2D, UTYPE_URB2D,               & 
                 SF_URBAN_PHYSICS,                               & !Optional urban
                 CMCR_URB2D,TGR_URB2D,TGRL_URB3D,SMR_URB3D,      & !Optional urban
                 DRELR_URB2D,DRELB_URB2D,DRELG_URB2D,            & !Optional urban
@@ -1334,7 +1334,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 TML,T0ML,HML,H0ML,HUML,HVML,TMOML,              & !Optional oml
                 is_CAMMGMP_used                                 &
                ,TSK_SAVE                                        & !Optional fractional seaice
-! CLM vraiables
+! CLM vraiables 
                ,numc,nump,snl,                                      &
                 snowdp,wtc,wtp,h2osno,t_grnd,t_veg,         &
                 h2ocan,h2ocan_col,t2m_max,t2m_min,t_ref2m,          &
@@ -1364,26 +1364,26 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
                 ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid,     &
                 Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,       &
                 SWUPsubgrid,lhsoi,lhveg,lhtran                      &
-! end of CLM vraiables
+! end of CLM vraiables 
                 ,landusef,landusef2,NLCAT                       & ! danli mosaic
                 ,sf_surface_mosaic, mosaic_cat                  & ! danli mosaic
-                ,mosaic_cat_index                               & ! danli mosaic
+                ,mosaic_cat_index                               & ! danli mosaic  
                 ,TSK_mosaic,TSLB_mosaic                         & ! danli mosaic
-                ,SMOIS_mosaic,SH2O_mosaic                       & ! danli mosaic
+                ,SMOIS_mosaic,SH2O_mosaic                       & ! danli mosaic 
                 ,CANWAT_mosaic,SNOW_mosaic                      & ! danli mosaic
                 ,SNOWH_mosaic,SNOWC_mosaic                      & ! danli mosaic
-                ,ALBEDO,ALBBCK, EMISS, EMBCK                    & ! danli mosaic
+                ,ALBEDO,ALBBCK, EMISS, EMBCK                    & ! danli mosaic          
                 ,ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic   &         ! danli mosaic
-                ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic
-                ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic
-                ,QC_URB2D_mosaic                                &  !danli mosaic
-                ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic
-                ,TGL_URB3D_mosaic                               &  !danli mosaic
-                ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic
-                ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic
-                ,TS_URB2D_mosaic                                &  !danli mosaic
-                ,TS_RUL2D_mosaic                                &  !danli mosaic
-               )
+                ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic 
+                ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic 
+                ,QC_URB2D_mosaic                                &  !danli mosaic                  
+                ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic 
+                ,TGL_URB3D_mosaic                               &  !danli mosaic 
+                ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic 
+                ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic 
+                ,TS_URB2D_mosaic                                &  !danli mosaic 
+                ,TS_RUL2D_mosaic                                &  !danli mosaic 
+               ) 
 
    CALL wrf_debug ( 200 , 'module_start: phy_init: Before call to cu_init' )
 
@@ -1538,7 +1538,7 @@ SUBROUTINE phy_init ( id, config_flags, DT, restart, zfull, zhalf,     &
 !  Initialize cloud droplet effective radius for Goddard MP and Radiation
 !  Must be (Goddard LW and SW) AND must be (Goddard 3ice OR 4ice)
 #if ( EM_CORE == 1 )
-
+    
    if ( ( ( config_flags%ra_lw_physics .EQ. GODDARDLWSCHEME )   .AND. &
           ( config_flags%ra_sw_physics .EQ. GODDARDSWSCHEME ) ) .AND. &
         ( ( config_flags%mp_physics    .EQ. NUWRF3ICESCHEME )   .OR.  &
@@ -1583,7 +1583,7 @@ SUBROUTINE landuse_init(lu_index, snowc, albedo, albbck, snoalb, mavail, emiss,
    REAL    , INTENT(IN)           :: cen_lat
    CHARACTER(LEN=*), INTENT(IN)        :: mminlu
    LOGICAL,  INTENT(IN)           :: allowed_to_read , usemonalb
-   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: lu_index, snowc, xice, snoalb
+   REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: lu_index, snowc, xice, snoalb 
    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(OUT  ) :: albedo, albbck, mavail, emiss, &
                                                                embck,                         &
                                                                znt, Z0, thc, xland, xicem
@@ -1766,7 +1766,7 @@ SUBROUTINE landuse_init(lu_index, snowc, albedo, albbck, snoalb, mavail, emiss,
           ENDIF
           IF(.NOT.usemonalb)ALBBCK(I,J)=ALBD(IS,ISN)/100.
           ALBEDO(I,J)=ALBBCK(I,J)
-          IF(SNOWC(I,J) .GT. 0.5) THEN
+          IF(SNOWC(I,J) .GT. 0.5) THEN 
              IF (usemonalb) THEN
                  ALBEDO(I,J)=SNOALB(I,J)
              ELSE
@@ -1991,12 +1991,12 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
    ENDIF
 
 !-- ww: attempt to use CAM ozone and some aerosol profiles in all rad schemes
-!   note that CAM option will still do the same.
+!   note that CAM option will still do the same. 
 !   n_ozmixm: no of months; levsiz: = 59, vertical dim
 !   Read in CAM ozone data, and interpolate data to model grid
 !   Interpolation is done on domain 1 only
 
-#if (EM_CORE==1)
+#if (EM_CORE==1) 
    IF ( config_flags%o3input .EQ. 2 .AND. id .EQ. 1 ) THEN
 #else
    IF ( config_flags%o3input .EQ. 2 ) THEN
@@ -2034,7 +2034,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
                            ims, ime, jms, jme, kms, kme,    &
                            its, ite, jts, jte, kts, kte     )
 
-
+              
         CASE (RRTMSCHEME)
              CALL rrtminit(                                 &
                            p_top, allowed_to_read ,         &
@@ -2074,7 +2074,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
 
             aclwalloc = .true.
 #if ( EM_CORE == 1 )
-        CASE (RRTMK_LWSCHEME)
+        CASE (RRTMK_LWSCHEME)  
 
              CALL rrtmg_lwinit_k(                           &
                            allowed_to_read ,                &
@@ -2238,7 +2238,7 @@ SUBROUTINE ra_init(id,STEPRA,RADT,DT,RTHRATEN,RTHRATENLW,       &
 
    END SELECT swrad_select
 
-#if ( EM_CORE == 1 )
+#if ( EM_CORE == 1 ) 
    ! test for conditionally allocated arrays when using bucket_J
 
    IF(config_flags%bucket_J .gt. 0.0)THEN
@@ -2254,7 +2254,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 RQVBLTEN,RQCBLTEN,RQIBLTEN,TSK,TMN,             &
                 config_flags,restart,UST,LOWLYR,TSLB,ZS,DZS,    &
                 num_soil_layers,TKE_PBL,mfshconv,               &
-                massflux_EDKF, entr_EDKF, detr_EDKF, &
+                massflux_EDKF, entr_EDKF, detr_EDKF, & 
                 thl_up, thv_up, rt_up,       &
                 rv_up, rc_up, u_up, v_up,    &
                 frac_up, &
@@ -2284,7 +2284,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 XSAIXY, LAI,                                    &
                 SMOISEQ, SMCWTDXY, RECHXY, DEEPRECHXY, AREAXY,  &
                 WTDDT, STEPWTD,QRFSXY ,QSPRINGSXY ,QSLATXY,     &
-                FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, &
+                FDEPTHXY, RIVERBEDXY, EQZWT, RIVERCONDXY, PEXPXY, & 
                 rechclim  ,                                     &
                 ISICE,                                 &
                 T2MVXY, T2MBXY ,CHSTARXY,                       &
@@ -2348,7 +2348,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 TML,T0ML,HML,H0ML,HUML,HVML,TMOML,              &
                 is_CAMMGMP_used                                 &
                ,TSK_SAVE                                        & !Optional fractional seaice
-! CLM vraiables
+! CLM vraiables 
                ,numc,nump,snl,                                      &
                 snowdp,wtc,wtp,h2osno,t_grnd,t_veg,         &
                 h2ocan,h2ocan_col,t2m_max,t2m_min,t_ref2m,          &
@@ -2378,25 +2378,25 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 ALBEDOsubgrid,LHsubgrid,HFXsubgrid,LWUPsubgrid,     &
                 Q2subgrid,SABVsubgrid,SABGsubgrid,NRAsubgrid,       &
                 SWUPsubgrid,lhsoi,lhveg,lhtran                      &
-! end of CLM vraiables
+! end of CLM vraiables 
                 ,landusef,landusef2,NLCAT                       & ! danli mosaic
                 ,sf_surface_mosaic, mosaic_cat                  & ! danli mosaic
-                ,mosaic_cat_index                               & ! danli mosaic
+                ,mosaic_cat_index                               & ! danli mosaic  
                 ,TSK_mosaic,TSLB_mosaic                         & ! danli mosaic
                 ,SMOIS_mosaic,SH2O_mosaic                       & ! danli mosaic
                 ,CANWAT_mosaic,SNOW_mosaic                      & ! danli mosaic
                 ,SNOWH_mosaic,SNOWC_mosaic                      & ! danli mosaic
-                ,ALBEDO,ALBBCK, EMISS, EMBCK                    & ! danli mosaic
+                ,ALBEDO,ALBBCK, EMISS, EMBCK                    & ! danli mosaic 
                 ,ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic   &         ! danli mosaic
-                ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic
-                ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic
-                ,QC_URB2D_mosaic                                &  !danli mosaic
-                ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic
-                ,TGL_URB3D_mosaic                               &  !danli mosaic
-                ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic
-                ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic
-                ,TS_URB2D_mosaic                                &  !danli mosaic
-                ,TS_RUL2D_mosaic                                &  !danli mosaic
+                ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic 
+                ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic 
+                ,QC_URB2D_mosaic                                &  !danli mosaic                  
+                ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic 
+                ,TGL_URB3D_mosaic                               &  !danli mosaic 
+                ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic 
+                ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic 
+                ,TS_URB2D_mosaic                                &  !danli mosaic 
+                ,TS_RUL2D_mosaic                                &  !danli mosaic  
                                                                 ) !Optional oml
 !--------------------------------------------------------------------
    USE module_sf_sfclay
@@ -2460,7 +2460,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                                       ims, ime, jms, jme, kms, kme, &
                                       its, ite, jts, jte, kts, kte
    INTEGER , INTENT(IN)        ::     num_soil_layers
-   INTEGER , INTENT(IN)        ::     SF_URBAN_PHYSICS
+   INTEGER , INTENT(IN)        ::     SF_URBAN_PHYSICS 
    INTEGER , INTENT(IN)        ::     IOPT_RUN
 
 !   INTEGER , INTENT(IN)        ::     LakeModel
@@ -2524,7 +2524,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
    REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT), OPTIONAL :: QKE
 
    REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT), OPTIONAL :: &
-                              massflux_EDKF, entr_EDKF, detr_EDKF &
+                              massflux_EDKF, entr_EDKF, detr_EDKF & 
                                      ,thl_up, thv_up, rt_up       &
                                      ,rv_up, rc_up, u_up, v_up    &
                                      ,frac_up
@@ -2540,7 +2540,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
    INTEGER :: k
 
    REAL, OPTIONAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
-            INTENT(OUT) :: te_temf, cf3d_temf !WA
+            INTENT(OUT) :: te_temf, cf3d_temf !WA 
    REAL, OPTIONAL, DIMENSION( ims:ime , jms:jme ) , &
             INTENT(OUT) :: wm_temf
 
@@ -2585,7 +2585,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: SMCWTDXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: DEEPRECHXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: RECHXY
-   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QRFSXY
+   REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QRFSXY  
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSPRINGSXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: QSLATXY
    REAL,    OPTIONAL, DIMENSION(ims:ime,jms:jme) :: AREAXY
@@ -2682,18 +2682,18 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: MH_URB2D !SLUCM
     REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: STDH_URB2D !SLUCM
     REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(INOUT) :: LF_URB2D !SLUCM
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_Q_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_E_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_U_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_V_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_T_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_Q_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_E_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_Q_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_E_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_U_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_V_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_T_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_Q_BEP 
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_E_BEP 
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: VL_BEP
-   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DLG_BEP
+   REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DLG_BEP 
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme,jms:jme),INTENT(INOUT) :: SF_BEP
    REAL, OPTIONAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DL_U_BEP
 ! lake varibles:
@@ -2703,7 +2703,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                                                                              h2osno2d,       &
                                                                              snl2d,          &
                                                                              t_grnd2d
-
+ 
   real,    dimension( ims:ime,1:nlevlake, jms:jme ),INTENT(out)            :: t_lake3d,       &
                                                                              lake_icefrac3d, &
                                                                              z_lake3d,       &
@@ -2720,7 +2720,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                                                                              tkdry3d,        &
                                                                              tksatu3d
   real,    dimension( ims:ime,-nlevsnow+0:nlevsoil, jms:jme ),INTENT(inout) :: zi3d
-
+ 
   logical,    dimension(ims:ime,jms:jme ),intent(out)                        :: lake2d
   REAL, OPTIONAL,    DIMENSION( ims:ime, jms:jme ), INTENT(IN)    ::  lake_depth
 #if ( EM_CORE == 1 )
@@ -2780,37 +2780,37 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 !-------------------------------------------------
 ! Noah-mosaic related variables are added to declaration  (danli)
 !-------------------------------------------------
-
-  INTEGER, INTENT(IN) :: sf_surface_mosaic, NLCAT
+  
+  INTEGER, INTENT(IN) :: sf_surface_mosaic, NLCAT   
   INTEGER, INTENT(IN) :: mosaic_cat
   REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(IN)::   LANDUSEF
   REAL, DIMENSION( ims:ime, NLCAT, jms:jme ) , INTENT(INOUT)::   LANDUSEF2
-  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT) :: mosaic_cat_index
+  INTEGER, DIMENSION( ims:ime, NLCAT, jms:jme ), INTENT(INOUT) :: mosaic_cat_index 
 
-  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSK_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic
-  REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ALBEDO,ALBBCK, EMISS, EMBCK
+  REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TSK_mosaic, CANWAT_mosaic, SNOW_mosaic,SNOWH_mosaic, SNOWC_mosaic 
+  REAL, DIMENSION( ims:ime, jms:jme ) , INTENT(INOUT)::   ALBEDO,ALBBCK, EMISS, EMBCK 
 
   REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic
-
+  
   REAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), OPTIONAL, INTENT(INOUT)::   TSLB_mosaic,SMOIS_mosaic,SH2O_mosaic
-
+  
   REAL, DIMENSION( ims:ime, 1:mosaic_cat, jms:jme ) , OPTIONAL, INTENT(INOUT)::   TR_URB2D_mosaic, TB_URB2D_mosaic, TG_URB2D_mosaic, TC_URB2D_mosaic,QC_URB2D_mosaic,  &
-                                                                                     SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic
-
+                                                                                     SH_URB2D_mosaic,LH_URB2D_mosaic,G_URB2D_mosaic,RN_URB2D_mosaic,TS_URB2D_mosaic, TS_RUL2D_mosaic  
+                    
   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TRL_URB3D_mosaic
   REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TBL_URB3D_mosaic
-  REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic
-
+  REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_soil_layers*mosaic_cat, jms:jme ), INTENT(INOUT) :: TGL_URB3D_mosaic  
+   
   REAL :: xice_threshold   ! lake input
-
+   
   LOGICAL :: IPRINT
-
-!-------------------------------------------------
-! End of Noah-mosaic related variables
+  
 !-------------------------------------------------
+! End of Noah-mosaic related variables 
+!-------------------------------------------------  
 
 #if ( EM_CORE == 1 )
-!local mynn
+!local mynn 
    INTEGER :: mynn_closure_level
 #endif
 
@@ -2819,7 +2819,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
   else if ( config_flags%fractional_seaice == 1 ) then
      xice_threshold = 0.02
   endif
-
+ 
 !-- calculate pbl time step
 
    STEPBL = nint(BLDT*60./DT)
@@ -2920,7 +2920,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 #endif
 
 #if ( EM_CORE == 1 )
-!mynn
+!mynn 
 
         CASE (MYNNSFCSCHEME)
 
@@ -2969,7 +2969,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 
 #endif
       CASE (LSMSCHEME)
-
+          
           IF(TRIM(mminlu) .EQ. 'NLCD40')THEN
             CALL wrf_message('Using NLCD40 for Noah, redefine urban categories ')
             DO j=jts,jte
@@ -2979,7 +2979,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
             ENDDO
             ENDDO
           ENDIF
-
+ 
           CALL LSMINIT(VEGFRA,SNOW,SNOWC,SNOWH,CANWAT,SMSTAV,  &
                      SMSTOT, SFCRUNOFF,UDRUNOFF,ACSNOW,        &
                      ACSNOM,IVGTYP,ISLTYP,TSLB,SMOIS,SH2O,ZS,DZS, &
@@ -2996,12 +2996,12 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
           IF ((SF_URBAN_PHYSICS.eq.1).OR.(SF_URBAN_PHYSICS.EQ.2).OR.(SF_URBAN_PHYSICS.EQ.3)) THEN
 
              IF ( PRESENT( FRC_URB2D ) .AND. PRESENT( UTYPE_URB2D )) THEN
-
+                
                 CALL urban_param_init(DZR,DZB,DZG,num_soil_layers,                   & !urban
                                 sf_urban_physics)
 !                                num_roof_layers,num_wall_layers,road_soil_layers)   !urban
-
-
+                               
+                
                 CALL urban_var_init(ISURBAN,TSK,TSLB,TMN,IVGTYP,                     & !urban
                               ims,ime,jms,jme,kms,kme,num_soil_layers,               & !urban
 !                              num_roof_layers,num_wall_layers,num_road_layers, & !urban
@@ -3047,42 +3047,42 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                 CALL wrf_error_fatal ( 'arguments not present for calling urban model' )
              ENDIF
           ENDIF
-
+          
 !danli mosaic
 
           IF (SF_surface_mosaic.eq.1) THEN
 
-CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_flags%ISICE, XLAND, XICE,config_flags%fractional_seaice,TSK,TSLB,SMOIS,SH2O,SNOW,SNOWC,SNOWH,CANWAT,  &
+CALL lsm_mosaic_init(IVGTYP,config_flags%ISWATER,config_flags%ISURBAN,config_flags%ISICE, XLAND, XICE,config_flags%fractional_seaice,TSK,TSLB,SMOIS,SH2O,SNOW,SNOWC,SNOWH,CANWAT,  &                
                   ids,ide, jds,jde, kds,kde,  &
                   ims,ime, jms,jme, kms,kme,  &
                   its,ite, jts,jte, kts,kte, restart,             &
-                  landusef,landusef2,NLCAT,num_soil_layers                  &
-                  ,sf_surface_mosaic, mosaic_cat                    &
-                  , mosaic_cat_index                              &
+                  landusef,landusef2,NLCAT,num_soil_layers                  & 
+                  ,sf_surface_mosaic, mosaic_cat                    & 
+                  , mosaic_cat_index                              &   
                   ,TSK_mosaic,TSLB_mosaic                         &
-                  ,SMOIS_mosaic,SH2O_mosaic                       &
+                  ,SMOIS_mosaic,SH2O_mosaic                       & 
                   ,CANWAT_mosaic,SNOW_mosaic                      &
                   ,SNOWH_mosaic,SNOWC_mosaic                      &
-                  ,ALBEDO,ALBBCK, EMISS, EMBCK,                    &         !danli
+                  ,ALBEDO,ALBBCK, EMISS, EMBCK,                    &         !danli  
 #if ( NMM_CORE == 1 )
                                                             Z0, &
 #else
                                                            ZNT, &
-#endif
+#endif  
                   ALBEDO_mosaic,ALBBCK_mosaic, EMISS_mosaic, EMBCK_mosaic, ZNT_mosaic, Z0_mosaic   &         !danli
-                 ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic
-                 ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic
-                 ,QC_URB2D_mosaic                                &  !danli mosaic
-                 ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic
-                 ,TGL_URB3D_mosaic                               &  !danli mosaic
-                 ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic
-                 ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic
-                 ,TS_URB2D_mosaic                                &  !danli mosaic
-                 ,TS_RUL2D_mosaic                                &  !danli mosaic
+                 ,TR_URB2D_mosaic,TB_URB2D_mosaic                &  !danli mosaic 
+                 ,TG_URB2D_mosaic,TC_URB2D_mosaic                &  !danli mosaic 
+                 ,QC_URB2D_mosaic                                &  !danli mosaic                  
+                 ,TRL_URB3D_mosaic,TBL_URB3D_mosaic              &  !danli mosaic 
+                 ,TGL_URB3D_mosaic                               &  !danli mosaic 
+                 ,SH_URB2D_mosaic,LH_URB2D_mosaic                &  !danli mosaic 
+                 ,G_URB2D_mosaic,RN_URB2D_mosaic                 &  !danli mosaic 
+                 ,TS_URB2D_mosaic                                &  !danli mosaic 
+                 ,TS_RUL2D_mosaic                                &  !danli mosaic                        
                    )
 
-          ENDIF
-
+          ENDIF               
+          
 !
 
       CASE (NOAHMPSCHEME)
@@ -3215,7 +3215,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 ! CLM Init Coupling
       CASE (CLMSCHEME)
         IF ((SF_URBAN_PHYSICS.eq.1).OR.(SF_URBAN_PHYSICS.EQ.2).OR.(SF_URBAN_PHYSICS.EQ.3)) THEN
-                CALL wrf_error_fatal ( 'CLM DOES NOT WORK WITH URBAN SCHEME' )
+                CALL wrf_error_fatal ( 'CLM DOES NOT WORK WITH URBAN SCHEME' ) 
         ENDIF
         IF ( TRIM(mminlu) .EQ. 'NLCD40' ) THEN
            CALL wrf_error_fatal ( 'CLM does not work with NLCD input. Stop' )
@@ -3296,7 +3296,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 #endif
 
      IF ( LakeModel == 1 ) THEN
-
+ 
              call  lakeini(IVGTYP,         ISLTYP,          HT,              SNOW,           & !i
                            lake_min_elev,     restart,         lakedepth_default, lake_depth,     &
                            lakedepth2d,    savedtke12d,     snowdp2d,        h2osno2d,       & !o
@@ -3312,7 +3312,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                            tkdry3d,        tksatu3d,        lake2d,          its, ite, jts, jte, &
                            ims,ime, jms,jme)
      ENDIF
-
+ 
 !-- initialize pbl scheme
 
    pbl_select: SELECT CASE(config_flags%bl_pbl_physics)
@@ -3428,17 +3428,17 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
                         ids, ide, jds, jde, kds, kde,         &
                         ims, ime, jms, jme, kms, kme,         &
                         its, ite, jts, jte, kts, kte          )
-
+           
 !          IF ( PRESENT (mfshconv) ) THEN
               if (mfshconv.EQ.1) &
-              CALL mfshconvpblinit( massflux_EDKF, entr_EDKF, detr_EDKF &
+              CALL mfshconvpblinit( massflux_EDKF, entr_EDKF, detr_EDKF & 
                                     ,thl_up, thv_up, rt_up              &
                                     ,rv_up, rc_up, u_up, v_up           &
                                     ,frac_up, restart,                  &
                                     allowed_to_read ,                   &
                                     ids, ide, jds, jde, kds, kde,       &
                                     ims, ime, jms, jme, kms, kme,       &
-                                    its, ite, jts, jte, kts, kte   )
+                                    its, ite, jts, jte, kts, kte   )  
 !          ENDIF
 
 #if (NMM_CORE != 1)
@@ -3463,14 +3463,14 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 
 #if ( EM_CORE == 1 )
 
-!mynn
-
+!mynn 
+           
         CASE (MYNNPBLSCHEME2, MYNNPBLSCHEME3)
            IF(isfc .NE. 5 .AND. isfc .NE. 1 .AND. isfc .NE. 2) CALL wrf_error_fatal &
                 ( 'module_physics_init: use mynnsfc or sfclay or myjsfc scheme for this pbl option')
            IF ((SF_URBAN_PHYSICS.eq.2).OR.(SF_URBAN_PHYSICS.EQ.3)) CALL wrf_error_fatal &
             ( 'module_physics_init: use myj (option 2) or boulac (option 8) with BEP/BEM urban scheme' )
-
+           
            SELECT CASE(config_flags%bl_pbl_physics)
 
              CASE(MYNNPBLSCHEME2)
@@ -3515,7 +3515,7 @@ SUBROUTINE bl_init(STEPBL,BLDT,DT,RUBLTEN,RVBLTEN,RTHBLTEN,  &
 
 #endif
 
-      CASE (GBMPBLSCHEME)
+      CASE (GBMPBLSCHEME) 
            if(isfc .ne. 1)CALL wrf_error_fatal &
             ( 'module_physics_init: Use sf_sfclay_physics= 1 or 91 for this pbl option' )
          CALL gbmpblinit(RUBLTEN,RVBLTEN,RTHBLTEN,RQVBLTEN,   &
@@ -3587,7 +3587,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
    USE module_cu_du, ONLY : ducuinit
 #endif
 !------------------------------------------------------------------
-   IMPLICIT NONE
+   IMPLICIT NONE 
 !------------------------------------------------------------------
    TYPE (grid_config_rec_type) ::     config_flags
    LOGICAL , INTENT(IN)        :: restart
@@ -3601,18 +3601,18 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
    LOGICAL , INTENT(IN)        :: allowed_to_read
    INTEGER , INTENT(INOUT)     :: STEPCU
 
-   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &    
             RUCUTEN, RVCUTEN, RTHCUTEN, &
             RQVCUTEN, RQCCUTEN, RQRCUTEN, RQICUTEN, RQSCUTEN
 #if ( EM_CORE == 1 )
    !BSINGH - For WRFCuP Scheme
-   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::    &    
         cldfra_cup,cldfratend_cup                               !CuP, wig 18-Sep-2006
    !BSINGH -ENDS
 #endif
 
-   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &
-                        cugd_tten,cugd_ttens,cugd_qvten,            &
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , OPTIONAL, INTENT(INOUT) ::    &    
+                        cugd_tten,cugd_ttens,cugd_qvten,            &    
                         cugd_qvtens,cugd_qcten, RQCNCUTEN, RQINCUTEN
 
    REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
@@ -3634,7 +3634,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
    REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
 
    REAL ,   DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: MASS_FLUX,   &
-                                   APR_GR,APR_W,APR_MC,APR_ST,APR_AS,    &
+                                   APR_GR,APR_W,APR_MC,APR_ST,APR_AS,    &    
                                    APR_CAPMA,APR_CAPME,APR_CAPMI
    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: LOWLYR
 
@@ -3718,7 +3718,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
                       its, ite, jts, jte, kts, kte                )
      CASE (KSASSCHEME,NSASSCHEME)
          CALL nsasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,       &
-                      RUCUTEN,RVCUTEN,                            &
+                      RUCUTEN,RVCUTEN,                            & 
                       restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
                       allowed_to_read ,                           &
                       ids, ide, jds, jde, kds, kde,               &
@@ -3751,7 +3751,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
 
      CASE (SCALESASSCHEME)
           CALL scalesasinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,  &
-                      RUCUTEN,RVCUTEN,                            &
+                      RUCUTEN,RVCUTEN,                            &   
                       restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
                       allowed_to_read ,                           &
                       ids, ide, jds, jde, kds, kde,               &
@@ -3801,7 +3801,7 @@ SUBROUTINE cu_init(DX,STEPCU,CUDT,DT,RUCUTEN,RVCUTEN,RTHCUTEN,  &
 ! Tiedtke Scheme - ZCX&YQW
       CASE (TIEDTKESCHEME)
           CALL tiedtkeinit(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQICUTEN,   &
-                      RUCUTEN,RVCUTEN,                            &
+                      RUCUTEN,RVCUTEN,                            & 
                       restart,P_QC,P_QI,PARAM_FIRST_SCALAR,       &
                       allowed_to_read ,                           &
                       ids, ide, jds, jde, kds, kde,               &
@@ -3978,7 +3978,7 @@ SUBROUTINE shcu_init(STEPCU,CUDT,DT,RUSHTEN,RVSHTEN,RTHSHTEN,   &
                      ims, ime, jms, jme, kms, kme,                  &
                      its, ite, jts, jte, kts, kte                   )
 #endif
-
+ 
    CASE DEFAULT
 
    END SELECT shcu_select
@@ -3993,7 +3993,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
                       mp_restart_state,tbpvs_state,tbpvs0_state,   & ! eta mp
                       allowed_to_read, start_of_simulation,       &
 !CAMMGMP specific variables
-                      ixcldliq, ixcldice, ixnumliq, ixnumice,     &
+                      ixcldliq, ixcldice, ixnumliq, ixnumice,     &       
                       nssl_cccn, nssl_alphah, nssl_alphahl,       &
                       nssl_ipelec, nssl_isaund,                  &
                          nssl_cnoh, nssl_cnohl,                  &
@@ -4085,7 +4085,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
      ENDDO
      ENDDO
    ENDIF
-
+   
    IF ( present( nssl_cccn ) ) THEN
      SELECT CASE(config_flags%mp_physics)
      CASE (NSSL_2MOM,NSSL_2MOMCCN)
@@ -4097,7 +4097,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
      CASE DEFAULT
        nssl_ipelec_tmp = 0.0
      END SELECT
-
+     
      nssl_params(1)  = nssl_cccn
      nssl_params(2)  = nssl_alphah
      nssl_params(3)  = nssl_alphahl
@@ -4153,7 +4153,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
                           ids, ide, jds, jde, kds, kde,           &
                           ims, ime, jms, jme, kms, kme,           &
                           its, ite, jts, jte, kts, kte            )
-#endif
+#endif 
      CASE (THOMPSON)
          IF(start_of_simulation.or.restart.or.config_flags%cycling)     &
             CALL thompson_init(HGT=z_at_q,                              &
@@ -4227,7 +4227,7 @@ SUBROUTINE mp_init(RAINNC,SNOWNC,GRAUPELNC,config_flags,restart,warm_rain,
      CASE (CAMMGMPSCHEME) ! CAM5's microphysics
           CALL CAMMGMP_INIT(ixcldliq, ixcldice, ixnumliq, ixnumice &
              ,config_flags%chem_opt                          &
-             ,ids, ide, jds, jde, kds, kde                   &
+             ,ids, ide, jds, jde, kds, kde                   & 
              ,ims, ime, jms, jme, kms, kme                   &
              ,its, ite, jts, jte, kts, kte                   )
 #endif
@@ -4419,7 +4419,7 @@ SUBROUTINE fdob_init(obs_nudge_opt, maxdom, inest, parid,       &
    INTEGER , INTENT(IN)    :: no_pbl_nudge_q(maxdom)   ! flags for no moisture nudging in pbl
    INTEGER , INTENT(IN)    :: sfc_scheme_horiz ! horizontal spreading scheme for surf obs (wrf or orig mm5)
    INTEGER , INTENT(IN)    :: sfc_scheme_vert  ! vertical   spreading scheme for surf obs (orig or regime vif)
-   REAL    , INTENT(IN)    :: maxsnd_gap       ! max allowed pressure gap in soundings for interp (centibars)
+   REAL    , INTENT(IN)    :: maxsnd_gap       ! max allowed pressure gap in soundings for interp (centibars) 
    REAL    , INTENT(IN)    :: sfcfact      ! scale factor applied to time window for surface obs
    REAL    , INTENT(IN)    :: sfcfacr      ! scale fac applied to horiz rad of infl for sfc obs
    REAL    , INTENT(IN)    :: dpsmx        ! max pressure change allowed within horiz. infl. range
@@ -4579,7 +4579,7 @@ END SUBROUTINE z2sigma
 
 !--------------------------------------------------------------------
    SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
-!  Purpose: To initialize a set of variables and arrays required by
+!  Purpose: To initialize a set of variables and arrays required by 
 !           the CAM Parameterizations ported to WRF
 !
 !  Called by: Phy_init
@@ -4593,7 +4593,7 @@ SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
      USE constituents,               ONLY : cnst_add
      USE module_cam_support,         ONLY : pcnst =>pcnst_runtime, pcnst_mp
      USE modal_aero_initialize_data_phys, ONLY : modal_aero_initialize_phys
-
+     
      implicit none
 
      TYPE (grid_config_rec_type)              :: config_flags
@@ -4602,12 +4602,12 @@ SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
 
      !Local variables
      !Following variable declarations are from CAM's stratiform.F90 module
-     integer, parameter  :: ncnstmax = 4                    ! Number of constituents
+     integer, parameter  :: ncnstmax = 4                    ! Number of constituents     
      integer             :: mm
-     character(len=8), dimension(ncnstmax), parameter :: cnst_names = &
+     character(len=8), dimension(ncnstmax), parameter :: cnst_names = & 
           (/'CLDLIQ', 'CLDICE','NUMLIQ','NUMICE'/)         ! Constituent names
      !Variables with dummy values
-     integer  :: dumind
+     integer  :: dumind 
      real(r8) :: one
 
      !set dynamic (runtime)pcnst
@@ -4641,34 +4641,34 @@ SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
      ENDIF
 
 
-     !For assisting decoupled microphysics (MP) CAM MAM simulations (simulations, where MAM package is coupled with
+     !For assisting decoupled microphysics (MP) CAM MAM simulations (simulations, where MAM package is coupled with 
      !radiation but uncoupled with MP- i.e. MP runs with 'prescribed' aerosols) 'pcnst_mp' is defined.'pcnst_mp' will
      !only be used in the CAMMGMP driver and its supporting modules (ndrop and microp_aero)
      pcnst_mp = pcnst
      if(.NOT.config_flags%CAM_MP_MAM_cpled)pcnst_mp = 12
 #endif
 
-     ! Initialize the saturation vapor pressure look-up table...
+     ! Initialize the saturation vapor pressure look-up table...      
      call esinti(epsilo, latvap, latice, rh2o, cpair, tmelt)
-
+     
      IF(.NOT.CAM_INITIALIZED) THEN
-
+        
         !Allocate module level CAM arrays
-        call ALLOCATE_CAM_ARRAYS()
-
+        call ALLOCATE_CAM_ARRAYS()     
+        
         !-------------------------------------------------------------------------------------!
         !Calls to add constituents (these calls are imported from in initindx.F90 in CAM)     !
         !                                                                                     !
         ! Register water vapor.                                                               !
         ! ** This must be the first call to cnst_add so that water vapor is constituent 1.**  !
         !-------------------------------------------------------------------------------------!
-
+        
         call cnst_add('Q', mwh2o, cpwv, 1.E-12_r8, mm, &
              longname='Specific humidity', readiv=.true. )
-
-
+        
+        
         !Following add constituent calls are imported from the stratiform.F90 in CAM
-
+        
         call cnst_add(cnst_names(1), mwdry, cpair, 0._r8, ixcldliq, &
              longname='Grid box averaged cloud liquid amount')
         call cnst_add(cnst_names(2), mwdry, cpair, 0._r8, ixcldice, &
@@ -4700,17 +4700,17 @@ SUBROUTINE CAM_INIT (ixcldliq, ixcldice, ixnumliq, ixnumice,config_flags)
                 longname='Grid box averaged coarse mode2 mass')
            call cnst_add('COARSE_NUM' , one, cpair, 0._r8, dumind, &
                 longname='Grid box averaged coarse mode number')
-
+           
         ENDIF
 #endif
-
+        
         CAM_INITIALIZED = .TRUE.
      ENDIF
-
+     
 #if ( EM_CORE == 1 )
      IF(config_flags%mp_physics == CAMMGMPSCHEME)THEN
 #if ( WRF_CHEM != 1 )
-        !Aerosols must be initialized after adding the constituents otherwise the code may crash in WRF-Chem simulations
+        !Aerosols must be initialized after adding the constituents otherwise the code may crash in WRF-Chem simulations     
         CALL modal_aero_initialize_phys
 #else
         if(config_flags%chem_opt==0) then
@@ -4734,7 +4734,7 @@ SUBROUTINE ALLOCATE_CAM_ARRAYS ()
    USE constituents,         ONLY : cnst_name,cnst_longname,cnst_cp,&
         cnst_cv,cnst_mw,cnst_type,cnst_rgas,qmin,qmincg,            &
         cnst_fixed_ubc,apcnst,bpcnst,hadvnam,vadvnam,dcconnam,      &
-        fixcnam,tendnam,ptendnam,dmetendnam,sflxnam,tottnam
+        fixcnam,tendnam,ptendnam,dmetendnam,sflxnam,tottnam  
 
    USE module_cam_support,   ONLY : pcnst =>pcnst_runtime, pcnst_mp
 
@@ -4758,7 +4758,7 @@ SUBROUTINE ALLOCATE_CAM_ARRAYS ()
    !Allocate module_cam_mp_modal_aero_data_phys.F arrays
    Allocate(cnst_name_cw(pcnst),cnst_name_cw_mp(pcnst_mp),          &
         species_class(pcnst),qneg3_worst_thresh_amode(pcnst)        )
-
+   
  END SUBROUTINE ALLOCATE_CAM_ARRAYS
 
 subroutine aerosol_in(aerodm,pina,alevsiz,no_months,no_src_types,XLAT,XLONG,   &
@@ -4766,14 +4766,14 @@ subroutine aerosol_in(aerodm,pina,alevsiz,no_months,no_src_types,XLAT,XLONG,   &
                      ims, ime, jms, jme, kms, kme,                  &
                      its, ite, jts, jte, kts, kte)
 !
-! Adaped from oznini in CAM
+! Adaped from oznini in CAM 
 ! It should be replaced by monthly climatology that varies latitudinally and vertically
 !
    IMPLICIT NONE
 
    INTEGER,      INTENT(IN   )    ::   ids,ide, jds,jde, kds,kde, &
                                        ims,ime, jms,jme, kms,kme, &
-                                       its,ite, jts,jte, kts,kte
+                                       its,ite, jts,jte, kts,kte   
 
    INTEGER,      INTENT(IN   )    ::   alevsiz, no_months, no_src_types
 
@@ -4786,7 +4786,7 @@ subroutine aerosol_in(aerodm,pina,alevsiz,no_months,no_src_types,XLAT,XLONG,   &
 
 ! Local
 !  Data from Ryan Torn, computed from EC 6 types of aerosol data:
-!    organic carbon, sea salt, dust, black carbon, sulfalte
+!    organic carbon, sea salt, dust, black carbon, sulfalte 
 !    and stratospheric aerosol (volcanic ashes)
 !  The data dimensions are 46 x 72 x 12 (pressure levels), and in unit of AOD per Pa
 
@@ -5077,7 +5077,7 @@ subroutine aerosol_in_cu(aeromcu,alevsiz,no_months,no_src_types,XLAT,XLONG,aerop
              END IF
           END IF
 
-          ! Read aerosol information
+          ! Read aerosol information 
           OPEN(UNIT=iunit, FILE='CESM_RCP4.5_Aerosol_Data.dat', FORM='unformatted', &
                STATUS='old', IOSTAT=istatus)
             IF (istatus == 0) THEN